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