Actual source code: zmprintf.c

  1: #include <petsc/private/fortranimpl.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