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

  3: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  4:   #define chkmemfortran_                     CHKMEMFORTRAN
  5:   #define petscoffsetfortran_                PETSCOFFSETFORTRAN
  6:   #define petscobjectstateincrease_          PETSCOBJECTSTATEINCREASE
  7:   #define petsccienabledportableerroroutput_ PETSCCIENABLEDPORTABLEERROROUTPUT
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define chkmemfortran_                     chkmemfortran
 10:   #define petscoffsetfortran_                petscoffsetfortran
 11:   #define petscobjectstateincrease_          petscobjectstateincrease
 12:   #define petsccienabledportableerroroutput_ petsccienabledportableerroroutput
 13: #endif

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

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

 25: PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr)
 26: {
 27:   *ierr  = PETSC_SUCCESS;
 28:   *shift = y - x;
 29: }

 31: /*
 32:         This version does not do a malloc
 33: */
 34: static char FIXCHARSTRING[1024];

 36: #define FIXCHARNOMALLOC(a, n, b) \
 37:   do { \
 38:     if (a == PETSC_NULL_CHARACTER_Fortran) { \
 39:       b = a = NULL; \
 40:     } else { \
 41:       while ((n > 0) && (a[n - 1] == ' ')) n--; \
 42:       if (a[n] != 0) { \
 43:         b     = FIXCHARSTRING; \
 44:         *ierr = PetscStrncpy(b, a, n + 1); \
 45:         if (*ierr) return; \
 46:       } else b = a; \
 47:     } \
 48:   } while (0)

 50: PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
 51: {
 52:   char *c1;

 54:   FIXCHARNOMALLOC(file, len, c1);
 55:   *ierr = PetscMallocValidate(*line, "Userfunction", c1);
 56: }