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