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