1 #include <petsc/private/fortranimpl.h> 2 #include <petscsys.h> 3 #include <petscviewer.h> 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define petscmallocdump_ PETSCMALLOCDUMP 7 #define petscmallocview_ PETSCMALLOCVIEW 8 #define petscmallocvalidate_ PETSCMALLOCVALIDATE 9 #define petscmemoryview_ PETSCMEMORYVIEW 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define petscmallocdump_ petscmallocdump 12 #define petscmallocview_ petscmallocview 13 #define petscmallocvalidate_ petscmallocvalidate 14 #define petscmemoryview_ petscmemoryview 15 #endif 16 17 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 18 { 19 PetscInt i; 20 size_t len; 21 22 PetscFunctionBegin; 23 PetscCall(PetscStrallocpy(in,out)); 24 PetscCall(PetscStrlen(*out,&len)); 25 for (i=0; i<(int)len-1; i++) { 26 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 27 } 28 PetscFunctionReturn(0); 29 } 30 31 PETSC_EXTERN void petscmallocdump_(PetscErrorCode *ierr) 32 { 33 *ierr = PetscMallocDump(stdout); 34 } 35 PETSC_EXTERN void petscmallocview_(PetscErrorCode *ierr) 36 { 37 *ierr = PetscMallocView(stdout); 38 } 39 40 PETSC_EXTERN void petscmallocvalidate_(PetscErrorCode *ierr) 41 { 42 *ierr = PetscMallocValidate(0,"Unknown Fortran",0); 43 } 44 45 PETSC_EXTERN void petscmemoryview_(PetscViewer *vin, char* message, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 46 { 47 PetscViewer v; 48 char *msg, *tmp; 49 50 FIXCHAR(message,len,msg); 51 *ierr = PetscFixSlashN(msg,&tmp);if (*ierr) return; 52 FREECHAR(message,msg); 53 PetscPatchDefaultViewers_Fortran(vin,v); 54 *ierr = PetscMemoryView(v,tmp);if (*ierr) return; 55 *ierr = PetscFree(tmp); 56 } 57