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: }