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