1 #include <private/fortranimpl.h> 2 #include <petscsys.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define petscmallocdump_ PETSCMALLOCDUMP 6 #define petscmallocdumplog_ PETSCMALLOCDUMPLOG 7 #define petscmallocvalidate_ PETSCMALLOCVALIDATE 8 #define petscmemoryshowusage_ PETSCMEMORYSHOWUSAGE 9 #define petscmemorysetgetmaximumusage_ PETSCMEMORYSETGETMAXIMUMUSAGE 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define petscmallocdump_ petscmallocdump 12 #define petscmallocdumplog_ petscmallocdumplog 13 #define petscmallocvalidate_ petscmallocvalidate 14 #define petscmemoryshowusage_ petscmemoryshowusage 15 #define petscmemorysetgetmaximumusage_ petscmemorysetgetmaximumusage 16 #endif 17 18 EXTERN_C_BEGIN 19 20 #undef __FUNCT__ 21 #define __FUNCT__ "PetscFixSlashN" 22 static PetscErrorCode PetscFixSlashN(const char *in, char **out) 23 { 24 PetscErrorCode ierr; 25 PetscInt i; 26 size_t len; 27 28 PetscFunctionBegin; 29 ierr = PetscStrallocpy(in,out);CHKERRQ(ierr); 30 ierr = PetscStrlen(*out,&len);CHKERRQ(ierr); 31 for (i=0; i<(int)len-1; i++) { 32 if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';} 33 } 34 PetscFunctionReturn(0); 35 } 36 37 void PETSC_STDCALL petscmallocdump_(PetscErrorCode *ierr) 38 { 39 *ierr = PetscMallocDump(stdout); 40 } 41 void PETSC_STDCALL petscmallocdumplog_(PetscErrorCode *ierr) 42 { 43 *ierr = PetscMallocDumpLog(stdout); 44 } 45 46 void PETSC_STDCALL petscmallocvalidate_(PetscErrorCode *ierr) 47 { 48 *ierr = PetscMallocValidate(0,"Unknown Fortran",0,0); 49 } 50 51 void PETSC_STDCALL petscmemorysetgetmaximumusage_(PetscErrorCode *ierr) 52 { 53 *ierr = PetscMemorySetGetMaximumUsage(); 54 } 55 56 void PETSC_STDCALL petscmemoryshowusage_(PetscViewer *vin, CHAR message PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 57 { 58 PetscViewer v; 59 char *msg, *tmp; 60 61 FIXCHAR(message,len,msg); 62 *ierr = PetscFixSlashN(msg,&tmp);if (*ierr) return; 63 PetscPatchDefaultViewers_Fortran(vin,v); 64 *ierr = PetscMemoryShowUsage(v,tmp); 65 FREECHAR(message,msg); 66 } 67 68 EXTERN_C_END 69