1 #include <petsc/private/ftnimpl.h> 2 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 14 15 PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled) 16 { 17 *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0; 18 } 19 20 PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 21 { 22 *ierr = PetscObjectStateIncrease(*obj); 23 } 24 25 PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr) 26 { 27 *ierr = PETSC_SUCCESS; 28 *shift = y - x; 29 } 30 31 /* ---------------------------------------------------------------------------------*/ 32 /* 33 This version does not do a malloc 34 */ 35 static char FIXCHARSTRING[1024]; 36 37 #define FIXCHARNOMALLOC(a, n, b) \ 38 do { \ 39 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 40 b = a = NULL; \ 41 } else { \ 42 while ((n > 0) && (a[n - 1] == ' ')) n--; \ 43 if (a[n] != 0) { \ 44 b = FIXCHARSTRING; \ 45 *ierr = PetscStrncpy(b, a, n + 1); \ 46 if (*ierr) return; \ 47 } else b = a; \ 48 } \ 49 } while (0) 50 51 PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 52 { 53 char *c1; 54 55 FIXCHARNOMALLOC(file, len, c1); 56 *ierr = PetscMallocValidate(*line, "Userfunction", c1); 57 } 58