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