1 #include <petsc/private/fortranimpl.h> 2 3 #if defined(PETSC_HAVE_FORTRAN_CAPS) 4 #define petscfprintf_ PETSCFPRINTF 5 #define petscprintf_ PETSCPRINTF 6 #define petscsynchronizedfprintf_ PETSCSYNCHRONIZEDFPRINTF 7 #define petscsynchronizedprintf_ PETSCSYNCHRONIZEDPRINTF 8 #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH 9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 10 #define petscfprintf_ petscfprintf 11 #define petscprintf_ petscprintf 12 #define petscsynchronizedfprintf_ petscsynchronizedfprintf 13 #define petscsynchronizedprintf_ petscsynchronizedprintf 14 #define petscsynchronizedflush_ petscsynchronizedflush 15 #endif 16 17 #if defined(__cplusplus) 18 extern "C" { 19 #endif 20 21 PETSC_EXTERN void petscsynchronizedflush_(MPI_Fint * comm, FILE **file,int *ierr) 22 { 23 FILE *f = *file; 24 if (!f) f = PETSC_STDOUT; /* support for PETSC_STDOUT in Fortran */ 25 *ierr = PetscSynchronizedFlush(MPI_Comm_f2c( *(comm)),f); 26 } 27 28 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 29 { 30 PetscErrorCode ierr; 31 size_t i,len; 32 33 PetscFunctionBegin; 34 ierr = PetscStrallocpy(in,out);CHKERRQ(ierr); 35 ierr = PetscStrlen(*out,&len);CHKERRQ(ierr); 36 for (i=0; i<len-1; i++) { 37 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 38 } 39 PetscFunctionReturn(0); 40 } 41 42 PETSC_EXTERN void petscfprintf_(MPI_Comm *comm,FILE **file,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 43 { 44 char *c1,*tmp; 45 46 FIXCHAR(fname,len1,c1); 47 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 48 FREECHAR(fname,c1); 49 *ierr = PetscFPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),*file,"%s",tmp);if (*ierr) return; 50 *ierr = PetscFree(tmp); 51 } 52 53 PETSC_EXTERN void petscprintf_(MPI_Comm *comm,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 54 { 55 char *c1,*tmp; 56 57 FIXCHAR(fname,len1,c1); 58 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 59 FREECHAR(fname,c1); 60 *ierr = PetscPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),"%s",tmp);if (*ierr) return; 61 *ierr = PetscFree(tmp); 62 } 63 64 PETSC_EXTERN void petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 65 { 66 char *c1,*tmp; 67 68 FIXCHAR(fname,len1,c1); 69 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 70 FREECHAR(fname,c1); 71 *ierr = PetscSynchronizedFPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),*file,"%s",tmp);if (*ierr) return; 72 *ierr = PetscFree(tmp); 73 } 74 75 PETSC_EXTERN void petscsynchronizedprintf_(MPI_Comm *comm,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 76 { 77 char *c1,*tmp; 78 79 FIXCHAR(fname,len1,c1); 80 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 81 FREECHAR(fname,c1); 82 *ierr = PetscSynchronizedPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),"%s",tmp);if (*ierr) return; 83 *ierr = PetscFree(tmp); 84 } 85 #if defined(__cplusplus) 86 } 87 #endif 88 89