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