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