Actual source code: zfilevf.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define petscviewerasciiprintf_             PETSCVIEWERASCIIPRINTF
  6:   #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
  7: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  8:   #define petscviewerasciiprintf_             petscviewerasciiprintf
  9:   #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
 10: #endif

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

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

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

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

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

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