1: #include <petsc/private/ftnimpl.h>

  3: #if PetscDefined(HAVE_FORTRAN_CAPS)
  4:   #define chkmemfortran_                     CHKMEMFORTRAN
  5:   #define petscobjectstateincrease_          PETSCOBJECTSTATEINCREASE
  6:   #define petsccienabledportableerroroutput_ PETSCCIENABLEDPORTABLEERROROUTPUT
  7: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
  8:   #define chkmemfortran_                     chkmemfortran
  9:   #define petscobjectstateincrease_          petscobjectstateincrease
 10:   #define petsccienabledportableerroroutput_ petsccienabledportableerroroutput
 11: #endif

 13: PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled)
 14: {
 15:   *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0;
 16: }

 18: PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr)
 19: {
 20:   *ierr = PetscObjectStateIncrease(*obj);
 21: }

 23: /*
 24:         This version does not do a malloc
 25: */
 26: static char FIXCHARSTRING[1024];

 28: #define FIXCHARNOMALLOC(a, n, b) \
 29:   do { \
 30:     if (a == PETSC_NULL_CHARACTER_Fortran) { \
 31:       b = a = NULL; \
 32:     } else { \
 33:       while (((n) > 0) && ((a)[(n) - 1] == ' ')) (n)--; \
 34:       if ((a)[n] != 0) { \
 35:         b     = FIXCHARSTRING; \
 36:         *ierr = PetscStrncpy(b, a, (n) + 1); \
 37:         if (*ierr) return; \
 38:       } else b = a; \
 39:     } \
 40:   } while (0)

 42: PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
 43: {
 44:   char *c1;

 46:   FIXCHARNOMALLOC(file, len, c1);
 47:   *ierr = PetscMallocValidate(*line, "Userfunction", c1);
 48: }