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);if (*ierr) return; 31 FREECHAR(name,c1); 32 } 33 34 PETSC_EXTERN void petscviewerfilegetname_(PetscViewer *viewer, char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 35 { 36 const char *c1; 37 38 *ierr = PetscViewerGetType(*viewer, &c1);if (*ierr) return; 39 *ierr = PetscStrncpy(name, c1, len);if (*ierr) return; 40 FIXRETURNCHAR(PETSC_TRUE, name, len); 41 } 42 43 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 44 { 45 PetscInt i; 46 size_t len; 47 48 PetscFunctionBegin; 49 PetscCall(PetscStrallocpy(in,out)); 50 PetscCall(PetscStrlen(*out,&len)); 51 for (i=0; i<(int)len-1; i++) { 52 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 53 } 54 PetscFunctionReturn(0); 55 } 56 57 PETSC_EXTERN void petscviewerasciiprintf_(PetscViewer *viewer,char* str,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 58 { 59 char *c1, *tmp; 60 PetscViewer v; 61 62 PetscPatchDefaultViewers_Fortran(viewer,v); 63 FIXCHAR(str,len1,c1); 64 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 65 FREECHAR(str,c1); 66 *ierr = PetscViewerASCIIPrintf(v,"%s",tmp);if (*ierr) return; 67 *ierr = PetscFree(tmp); 68 } 69 70 PETSC_EXTERN void petscviewerasciipushtab_(PetscViewer *viewer,PetscErrorCode *ierr) 71 { 72 PetscViewer v; 73 PetscPatchDefaultViewers_Fortran(viewer,v); 74 *ierr = PetscViewerASCIIPushTab(v); 75 } 76 77 PETSC_EXTERN void petscviewerasciipoptab_(PetscViewer *viewer,PetscErrorCode *ierr) 78 { 79 PetscViewer v; 80 PetscPatchDefaultViewers_Fortran(viewer,v); 81 *ierr = PetscViewerASCIIPopTab(v); 82 } 83 84 PETSC_EXTERN void petscviewerasciisynchronizedprintf_(PetscViewer *viewer,char* str,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len1) 85 { 86 char *c1, *tmp; 87 PetscViewer v; 88 89 PetscPatchDefaultViewers_Fortran(viewer,v); 90 FIXCHAR(str,len1,c1); 91 *ierr = PetscFixSlashN(c1,&tmp);if (*ierr) return; 92 FREECHAR(str,c1); 93 *ierr = PetscViewerASCIISynchronizedPrintf(v,"%s",tmp);if (*ierr) return; 94 *ierr = PetscFree(tmp); 95 } 96 97 PETSC_EXTERN void petscviewerasciipushsynchronized_(PetscViewer *viewer,PetscErrorCode *ierr) 98 { 99 PetscViewer v; 100 101 PetscPatchDefaultViewers_Fortran(viewer,v); 102 *ierr = PetscViewerASCIIPushSynchronized(v); 103 } 104 105 PETSC_EXTERN void petscviewerasciipopsynchronized_(PetscViewer *viewer,PetscErrorCode *ierr) 106 { 107 PetscViewer v; 108 109 PetscPatchDefaultViewers_Fortran(viewer,v); 110 *ierr = PetscViewerASCIIPopSynchronized(v); 111 } 112