Actual source code: zfilevf.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define petscviewerfilesetname_             PETSCVIEWERFILESETNAME
  6:   #define petscviewerfilegetname_             PETSCVIEWERFILEGETNAME
  7:   #define petscviewerasciiprintf_             PETSCVIEWERASCIIPRINTF
  8:   #define petscviewerasciipushtab_            PETSCVIEWERASCIIPUSHTAB
  9:   #define petscviewerasciipoptab_             PETSCVIEWERASCIIPOPTAB
 10:   #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF
 11:   #define petscviewerasciipushsynchronized_   PETSCVIEWERASCIIPUSHSYNCHRONIZED
 12:   #define petscviewerasciipopsynchronized_    PETSCVIEWERASCIIPOPSYNCHRONIZED
 13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 14:   #define petscviewerfilesetname_             petscviewerfilesetname
 15:   #define petscviewerfilegetname_             petscviewerfilegetname
 16:   #define petscviewerasciiprintf_             petscviewerasciiprintf
 17:   #define petscviewerasciipushtab_            petscviewerasciipushtab
 18:   #define petscviewerasciipoptab_             petscviewerasciipoptab
 19:   #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf
 20:   #define petscviewerasciipushsynchronized_   petscviewerasciipushsynchronized
 21:   #define petscviewerasciipopsynchronized_    petscviewerasciipopsynchronized
 22: #endif

 24: PETSC_EXTERN void petscviewerfilesetname_(PetscViewer *viewer, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
 25: {
 26:   char       *c1;
 27:   PetscViewer v;
 28:   PetscPatchDefaultViewers_Fortran(viewer, v);
 29:   FIXCHAR(name, len, c1);
 30:   *ierr = PetscViewerFileSetName(v, c1);
 31:   if (*ierr) return;
 32:   FREECHAR(name, c1);
 33: }

 35: PETSC_EXTERN void petscviewerfilegetname_(PetscViewer *viewer, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
 36: {
 37:   const char *c1;

 39:   *ierr = PetscViewerGetType(*viewer, &c1);
 40:   if (*ierr) return;
 41:   *ierr = PetscStrncpy(name, c1, len);
 42:   if (*ierr) return;
 43:   FIXRETURNCHAR(PETSC_TRUE, name, len);
 44: }

 46: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
 47: {
 48:   PetscInt i;
 49:   size_t   len;

 51:   PetscFunctionBegin;
 52:   PetscCall(PetscStrallocpy(in, out));
 53:   PetscCall(PetscStrlen(*out, &len));
 54:   for (i = 0; i < (int)len - 1; i++) {
 55:     if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
 56:       (*out)[i]     = ' ';
 57:       (*out)[i + 1] = '\n';
 58:     }
 59:   }
 60:   PetscFunctionReturn(PETSC_SUCCESS);
 61: }

 63: PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
 64: {
 65:   char       *c1, *tmp;
 66:   PetscViewer v;

 68:   PetscPatchDefaultViewers_Fortran(viewer, v);
 69:   FIXCHAR(str, len1, c1);
 70:   *ierr = PetscFixSlashN(c1, &tmp);
 71:   if (*ierr) return;
 72:   FREECHAR(str, c1);
 73:   *ierr = PetscViewerASCIIPrintf(v, "%s", tmp);
 74:   if (*ierr) return;
 75:   *ierr = PetscFree(tmp);
 76: }

 78: PETSC_EXTERN void petscviewerasciipushtab_(PetscViewer *viewer, PetscErrorCode *ierr)
 79: {
 80:   PetscViewer v;
 81:   PetscPatchDefaultViewers_Fortran(viewer, v);
 82:   *ierr = PetscViewerASCIIPushTab(v);
 83: }

 85: PETSC_EXTERN void petscviewerasciipoptab_(PetscViewer *viewer, PetscErrorCode *ierr)
 86: {
 87:   PetscViewer v;
 88:   PetscPatchDefaultViewers_Fortran(viewer, v);
 89:   *ierr = PetscViewerASCIIPopTab(v);
 90: }

 92: PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1)
 93: {
 94:   char       *c1, *tmp;
 95:   PetscViewer v;

 97:   PetscPatchDefaultViewers_Fortran(viewer, v);
 98:   FIXCHAR(str, len1, c1);
 99:   *ierr = PetscFixSlashN(c1, &tmp);
100:   if (*ierr) return;
101:   FREECHAR(str, c1);
102:   *ierr = PetscViewerASCIISynchronizedPrintf(v, "%s", tmp);
103:   if (*ierr) return;
104:   *ierr = PetscFree(tmp);
105: }

107: PETSC_EXTERN void petscviewerasciipushsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr)
108: {
109:   PetscViewer v;

111:   PetscPatchDefaultViewers_Fortran(viewer, v);
112:   *ierr = PetscViewerASCIIPushSynchronized(v);
113: }

115: PETSC_EXTERN void petscviewerasciipopsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr)
116: {
117:   PetscViewer v;

119:   PetscPatchDefaultViewers_Fortran(viewer, v);
120:   *ierr = PetscViewerASCIIPopSynchronized(v);
121: }