Actual source code: zfilevf.c

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

  4: #if PetscDefined(HAVE_FORTRAN_CAPS)
  5:   #define petscviewerasciiprintf_             PETSCVIEWERASCIIPRINTF
  6:   #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
  7: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
  8:   #define petscviewerasciiprintf_             petscviewerasciiprintf
  9:   #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
 10: #endif

 12: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
 13: {
 14:   size_t len;

 16:   PetscFunctionBegin;
 17:   PetscCall(PetscStrallocpy(in, out));
 18:   PetscCall(PetscStrlen(*out, &len));
 19:   for (PetscInt i = 0; i < (int)len - 1; i++) {
 20:     if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
 21:       (*out)[i]     = ' ';
 22:       (*out)[i + 1] = '\n';
 23:     }
 24:   }
 25:   PetscFunctionReturn(PETSC_SUCCESS);
 26: }

 28: PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
 29: {
 30:   char       *c1, *tmp;
 31:   PetscViewer v;

 33:   PetscPatchDefaultViewers_Fortran(viewer, v);
 34:   FIXCHAR(str, len1, c1);
 35:   *ierr = PetscFixSlashN(c1, &tmp);
 36:   if (*ierr) return;
 37:   FREECHAR(str, c1);
 38:   *ierr = PetscViewerASCIIPrintf(v, "%s", tmp);
 39:   if (*ierr) return;
 40:   *ierr = PetscFree(tmp);
 41: }

 43: PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
 44: {
 45:   char       *c1, *tmp;
 46:   PetscViewer v;

 48:   PetscPatchDefaultViewers_Fortran(viewer, v);
 49:   FIXCHAR(str, len1, c1);
 50:   *ierr = PetscFixSlashN(c1, &tmp);
 51:   if (*ierr) return;
 52:   FREECHAR(str, c1);
 53:   *ierr = PetscViewerASCIISynchronizedPrintf(v, "%s", tmp);
 54:   if (*ierr) return;
 55:   *ierr = PetscFree(tmp);
 56: }