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