1 #include <petsc/private/fortranimpl.h> 2 #include <petscviewer.h> 3 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 23 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 } 34 35 PETSC_EXTERN void petscviewerfilegetname_(PetscViewer *viewer, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 36 { 37 const char *c1; 38 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 } 45 46 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 47 { 48 PetscInt i; 49 size_t len; 50 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 } 62 63 PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1) 64 { 65 char *c1, *tmp; 66 PetscViewer v; 67 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 } 77 78 PETSC_EXTERN void petscviewerasciipushtab_(PetscViewer *viewer, PetscErrorCode *ierr) 79 { 80 PetscViewer v; 81 PetscPatchDefaultViewers_Fortran(viewer, v); 82 *ierr = PetscViewerASCIIPushTab(v); 83 } 84 85 PETSC_EXTERN void petscviewerasciipoptab_(PetscViewer *viewer, PetscErrorCode *ierr) 86 { 87 PetscViewer v; 88 PetscPatchDefaultViewers_Fortran(viewer, v); 89 *ierr = PetscViewerASCIIPopTab(v); 90 } 91 92 PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer, char *str, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1) 93 { 94 char *c1, *tmp; 95 PetscViewer v; 96 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 } 106 107 PETSC_EXTERN void petscviewerasciipushsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr) 108 { 109 PetscViewer v; 110 111 PetscPatchDefaultViewers_Fortran(viewer, v); 112 *ierr = PetscViewerASCIIPushSynchronized(v); 113 } 114 115 PETSC_EXTERN void petscviewerasciipopsynchronized_(PetscViewer *viewer, PetscErrorCode *ierr) 116 { 117 PetscViewer v; 118 119 PetscPatchDefaultViewers_Fortran(viewer, v); 120 *ierr = PetscViewerASCIIPopSynchronized(v); 121 } 122