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 size_t i,len; 31 32 PetscFunctionBegin; 33 PetscCall(PetscStrallocpy(in,out)); 34 PetscCall(PetscStrlen(*out,&len)); 35 for (i=0; i<len-1; i++) { 36 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 37 } 38 PetscFunctionReturn(0); 39 } 40 41 PETSC_EXTERN void petscfprintf_(MPI_Comm *comm,FILE **file,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 42 { 43 char *c1,*tmp; 44 45 FIXCHAR(fname,len1,c1); 46 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 47 FREECHAR(fname,c1); 48 *ierr = PetscFPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),*file,"%s",tmp);if (*ierr) return; 49 *ierr = PetscFree(tmp); 50 } 51 52 PETSC_EXTERN void petscprintf_(MPI_Comm *comm,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 53 { 54 char *c1,*tmp; 55 56 FIXCHAR(fname,len1,c1); 57 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 58 FREECHAR(fname,c1); 59 *ierr = PetscPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),"%s",tmp);if (*ierr) return; 60 *ierr = PetscFree(tmp); 61 } 62 63 PETSC_EXTERN void petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 64 { 65 char *c1,*tmp; 66 67 FIXCHAR(fname,len1,c1); 68 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 69 FREECHAR(fname,c1); 70 *ierr = PetscSynchronizedFPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),*file,"%s",tmp);if (*ierr) return; 71 *ierr = PetscFree(tmp); 72 } 73 74 PETSC_EXTERN void petscsynchronizedprintf_(MPI_Comm *comm,char* fname,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 75 { 76 char *c1,*tmp; 77 78 FIXCHAR(fname,len1,c1); 79 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 80 FREECHAR(fname,c1); 81 *ierr = PetscSynchronizedPrintf(MPI_Comm_f2c(*(MPI_Fint*)&*comm),"%s",tmp);if (*ierr) return; 82 *ierr = PetscFree(tmp); 83 } 84 #if defined(__cplusplus) 85 } 86 #endif 87