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