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
petsccienabledportableerroroutput_(PetscMPIInt * cienabled)15 PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled)
16 {
17 *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0;
18 }
19
petscobjectstateincrease_(PetscObject * obj,PetscErrorCode * ierr)20 PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr)
21 {
22 *ierr = PetscObjectStateIncrease(*obj);
23 }
24
petscoffsetfortran_(PetscScalar * x,PetscScalar * y,size_t * shift,PetscErrorCode * ierr)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 This version does not do a malloc
33 */
34 static char FIXCHARSTRING[1024];
35
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)
49
chkmemfortran_(int * line,char * file,PetscErrorCode * ierr,PETSC_FORTRAN_CHARLEN_T len)50 PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
51 {
52 char *c1;
53
54 FIXCHARNOMALLOC(file, len, c1);
55 *ierr = PetscMallocValidate(*line, "Userfunction", c1);
56 }
57