Actual source code: zmprintf.c

      1: #include <petsc/private/ftnimpl.h>

      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

     17: #if defined(__cplusplus)
     18: extern "C" {
     19: #endif

     21: PETSC_EXTERN void petscsynchronizedflush_(MPI_Fint *comm, FILE **file, int *ierr)
     22: {
     23:   FILE *f = *file;
     24:   if (!f) f = PETSC_STDOUT; /* support for PETSC_STDOUT in Fortran */
     25:   *ierr = PetscSynchronizedFlush(MPI_Comm_f2c(*(comm)), f);
     26: }

     28: static PetscErrorCode PetscFixSlashN(const char *in, char *out[])
     29: {
     30:   size_t i, len;

     32:   PetscFunctionBegin;
     33:   PetscCall(PetscStrallocpy(in, out));
     34:   PetscCall(PetscStrlen(*out, &len));
     35:   for (i = 0; i < len - 1; i++) {
     36:     if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
     37:       (*out)[i]     = ' ';
     38:       (*out)[i + 1] = '\n';
     39:     }
     40:   }
     41:   PetscFunctionReturn(PETSC_SUCCESS);
     42: }

     44: PETSC_EXTERN void petscfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
     45: {
     46:   char *c1, *tmp;

     48:   FIXCHAR(fname, len1, c1);
     49:   *ierr = PetscFixSlashN(c1, &tmp);
     50:   if (*ierr) return;
     51:   FREECHAR(fname, c1);
     52:   *ierr = PetscFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), *file, "%s", tmp);
     53:   if (*ierr) return;
     54:   *ierr = PetscFree(tmp);
     55: }

     57: PETSC_EXTERN void petscprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
     58: {
     59:   char *c1, *tmp;

     61:   FIXCHAR(fname, len1, c1);
     62:   *ierr = PetscFixSlashN(c1, &tmp);
     63:   if (*ierr) return;
     64:   FREECHAR(fname, c1);
     65:   *ierr = PetscPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), "%s", tmp);
     66:   if (*ierr) return;
     67:   *ierr = PetscFree(tmp);
     68: }

     70: PETSC_EXTERN void petscsynchronizedfprintf_(MPI_Comm *comm, FILE **file, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
     71: {
     72:   char *c1, *tmp;

     74:   FIXCHAR(fname, len1, c1);
     75:   *ierr = PetscFixSlashN(c1, &tmp);
     76:   if (*ierr) return;
     77:   FREECHAR(fname, c1);
     78:   *ierr = PetscSynchronizedFPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), *file, "%s", tmp);
     79:   if (*ierr) return;
     80:   *ierr = PetscFree(tmp);
     81: }

     83: PETSC_EXTERN void petscsynchronizedprintf_(MPI_Comm *comm, char *fname, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
     84: {
     85:   char *c1, *tmp;

     87:   FIXCHAR(fname, len1, c1);
     88:   *ierr = PetscFixSlashN(c1, &tmp);
     89:   if (*ierr) return;
     90:   FREECHAR(fname, c1);
     91:   *ierr = PetscSynchronizedPrintf(MPI_Comm_f2c(*(MPI_Fint *)&*comm), "%s", tmp);
     92:   if (*ierr) return;
     93:   *ierr = PetscFree(tmp);
     94: }
     95: #if defined(__cplusplus)
     96: }
     97: #endif