xref: /petsc/src/sys/memory/ftn-custom/zmtrf.c (revision 0700a8246d308f50502909ba325e6169d3ee27eb)
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 static PetscErrorCode PetscFixSlashN(const char *in, char **out)
21 {
22   PetscErrorCode ierr;
23   PetscInt       i;
24   size_t         len;
25 
26   PetscFunctionBegin;
27   ierr = PetscStrallocpy(in,out);CHKERRQ(ierr);
28   ierr = PetscStrlen(*out,&len);CHKERRQ(ierr);
29   for (i=0; i<(int)len-1; i++) {
30     if ((*out)[i] == '\\' && (*out)[i+1] == 'n') {(*out)[i] = ' '; (*out)[i+1] = '\n';}
31   }
32   PetscFunctionReturn(0);
33 }
34 
35 void PETSC_STDCALL  petscmallocdump_(PetscErrorCode *ierr)
36 {
37   *ierr = PetscMallocDump(stdout);
38 }
39 void PETSC_STDCALL petscmallocdumplog_(PetscErrorCode *ierr)
40 {
41   *ierr = PetscMallocDumpLog(stdout);
42 }
43 
44 void PETSC_STDCALL petscmallocvalidate_(PetscErrorCode *ierr)
45 {
46   *ierr = PetscMallocValidate(0,"Unknown Fortran",0,0);
47 }
48 
49 void PETSC_STDCALL petscmemorysetgetmaximumusage_(PetscErrorCode *ierr)
50 {
51   *ierr = PetscMemorySetGetMaximumUsage();
52 }
53 
54 void PETSC_STDCALL petscmemoryshowusage_(PetscViewer *vin, CHAR message PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len))
55 {
56   PetscViewer v;
57   char *msg, *tmp;
58 
59   FIXCHAR(message,len,msg);
60   *ierr = PetscFixSlashN(msg,&tmp);if (*ierr) return;
61   PetscPatchDefaultViewers_Fortran(vin,v);
62   *ierr = PetscMemoryShowUsage(v,tmp);
63   FREECHAR(message,msg);
64 }
65 
66 EXTERN_C_END
67