1 #include "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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define petscfprintf_ petscfprintf 10 #define petscprintf_ petscprintf 11 #define petscsynchronizedfprintf_ petscsynchronizedfprintf 12 #define petscsynchronizedprintf_ petscsynchronizedprintf 13 #endif 14 15 EXTERN_C_BEGIN 16 17 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 18 { 19 PetscErrorCode ierr; 20 PetscInt i; 21 size_t len; 22 23 PetscFunctionBegin; 24 ierr = PetscStrallocpy(in,out);CHKERRQ(ierr); 25 ierr = PetscStrlen(*out,&len);CHKERRQ(ierr); 26 for (i=0; i<(int)len-1; i++) { 27 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 28 } 29 PetscFunctionReturn(0); 30 } 31 32 void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 33 { 34 char *c1,*tmp; 35 36 FIXCHAR(fname,len1,c1); 37 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 38 *ierr = PetscFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm),*file,tmp);if (*ierr) return; 39 *ierr = PetscStrfree(tmp);if (*ierr) return; 40 FREECHAR(fname,c1); 41 } 42 43 void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 44 { 45 char *c1,*tmp; 46 47 FIXCHAR(fname,len1,c1); 48 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 49 *ierr = PetscPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm),tmp);if (*ierr) return; 50 *ierr = PetscStrfree(tmp);if (*ierr) return; 51 FREECHAR(fname,c1); 52 } 53 54 void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 55 { 56 char *c1,*tmp; 57 58 FIXCHAR(fname,len1,c1); 59 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 60 *ierr = PetscSynchronizedFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm),*file,tmp);if (*ierr) return; 61 *ierr = PetscStrfree(tmp);if (*ierr) return; 62 FREECHAR(fname,c1); 63 } 64 65 void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 66 { 67 char *c1,*tmp; 68 69 FIXCHAR(fname,len1,c1); 70 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 71 *ierr = PetscSynchronizedPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm),tmp);if (*ierr) return; 72 *ierr = PetscStrfree(tmp);if (*ierr) return; 73 FREECHAR(fname,c1); 74 } 75 76 EXTERN_C_END 77