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