Actual source code: zmtrf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscsys.h>
3: #include <petscviewer.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define petscmallocdump_ PETSCMALLOCDUMP
7: #define petscmallocview_ PETSCMALLOCVIEW
8: #define petscmallocvalidate_ PETSCMALLOCVALIDATE
9: #define petscmemoryview_ PETSCMEMORYVIEW
10: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
11: #define petscmallocdump_ petscmallocdump
12: #define petscmallocview_ petscmallocview
13: #define petscmallocvalidate_ petscmallocvalidate
14: #define petscmemoryview_ petscmemoryview
15: #endif
17: static PetscErrorCode PetscFixSlashN(const char *in, char **out)
18: {
19: PetscInt i;
20: size_t len;
22: PetscFunctionBegin;
23: PetscCall(PetscStrallocpy(in, out));
24: PetscCall(PetscStrlen(*out, &len));
25: for (i = 0; i < (int)len - 1; i++) {
26: if ((*out)[i] == '\\' && (*out)[i + 1] == 'n') {
27: (*out)[i] = ' ';
28: (*out)[i + 1] = '\n';
29: }
30: }
31: PetscFunctionReturn(PETSC_SUCCESS);
32: }
34: PETSC_EXTERN void petscmallocdump_(PetscErrorCode *ierr)
35: {
36: *ierr = PetscMallocDump(stdout);
37: }
38: PETSC_EXTERN void petscmallocview_(PetscErrorCode *ierr)
39: {
40: *ierr = PetscMallocView(stdout);
41: }
43: PETSC_EXTERN void petscmallocvalidate_(PetscErrorCode *ierr)
44: {
45: *ierr = PetscMallocValidate(0, "Unknown Fortran", NULL);
46: }
48: PETSC_EXTERN void petscmemoryview_(PetscViewer *vin, char *message, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
49: {
50: PetscViewer v;
51: char *msg, *tmp;
53: FIXCHAR(message, len, msg);
54: *ierr = PetscFixSlashN(msg, &tmp);
55: if (*ierr) return;
56: FREECHAR(message, msg);
57: PetscPatchDefaultViewers_Fortran(vin, v);
58: *ierr = PetscMemoryView(v, tmp);
59: if (*ierr) return;
60: *ierr = PetscFree(tmp);
61: }