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: }