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 petscmallocdumplog_ PETSCMALLOCDUMPLOG 8 #define petscmallocvalidate_ PETSCMALLOCVALIDATE 9 #define petscmemoryview_ PETSCMEMORYVIEW 10 #define petscmemorysetgetmaximumusage_ PETSCMEMORYSETGETMAXIMUMUSAGE 11 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 12 #define petscmallocdump_ petscmallocdump 13 #define petscmallocdumplog_ petscmallocdumplog 14 #define petscmallocvalidate_ petscmallocvalidate 15 #define petscmemoryview_ petscmemoryview 16 #define petscmemorysetgetmaximumusage_ petscmemorysetgetmaximumusage 17 #endif 18 19 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 20 { 21 PetscErrorCode ierr; 22 PetscInt i; 23 size_t len; 24 25 PetscFunctionBegin; 26 ierr = PetscStrallocpy(in,out);CHKERRQ(ierr); 27 ierr = PetscStrlen(*out,&len);CHKERRQ(ierr); 28 for (i=0; i<(int)len-1; i++) { 29 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 30 } 31 PetscFunctionReturn(0); 32 } 33 34 PETSC_EXTERN void PETSC_STDCALL petscmallocdump_(PetscErrorCode *ierr) 35 { 36 *ierr = PetscMallocDump(stdout); 37 } 38 PETSC_EXTERN void PETSC_STDCALL petscmallocdumplog_(PetscErrorCode *ierr) 39 { 40 *ierr = PetscMallocDumpLog(stdout); 41 } 42 43 PETSC_EXTERN void PETSC_STDCALL petscmallocvalidate_(PetscErrorCode *ierr) 44 { 45 *ierr = PetscMallocValidate(0,"Unknown Fortran",0); 46 } 47 48 PETSC_EXTERN void PETSC_STDCALL petscmemorysetgetmaximumusage_(PetscErrorCode *ierr) 49 { 50 *ierr = PetscMemorySetGetMaximumUsage(); 51 } 52 53 PETSC_EXTERN void PETSC_STDCALL petscmemoryview_(PetscViewer *vin, char* message PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 54 { 55 PetscViewer v; 56 char *msg, *tmp; 57 58 FIXCHAR(message,len,msg); 59 *ierr = PetscFixSlashN(msg,&tmp);if (*ierr) return; 60 FREECHAR(message,msg); 61 PetscPatchDefaultViewers_Fortran(vin,v); 62 *ierr = PetscMemoryView(v,tmp);if (*ierr) return; 63 *ierr = PetscFree(tmp); 64 } 65 66