Actual source code: zsys.c
1: #include <petsc/private/fortranimpl.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 petscoffsetfortran_ petscoffsetfortran
10: #define chkmemfortran_ chkmemfortran
11: #define flush__ flush_
12: #define petscobjectstateincrease_ petscobjectstateincrease
13: #define petsccienabledportableerroroutput_ petsccienabledportableerroroutput
14: #endif
16: PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled)
17: {
18: *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0;
19: }
21: PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr)
22: {
23: *ierr = PetscObjectStateIncrease(*obj);
24: }
26: #if defined(PETSC_MISSING_FORTRAN_FLUSH_)
27: void flush__(int unit) { }
28: #endif
30: PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr)
31: {
32: *ierr = PETSC_SUCCESS;
33: *shift = y - x;
34: }
36: /* ---------------------------------------------------------------------------------*/
37: /*
38: This version does not do a malloc
39: */
40: static char FIXCHARSTRING[1024];
42: #define FIXCHARNOMALLOC(a, n, b) \
43: do { \
44: if (a == PETSC_NULL_CHARACTER_Fortran) { \
45: b = a = NULL; \
46: } else { \
47: while ((n > 0) && (a[n - 1] == ' ')) n--; \
48: if (a[n] != 0) { \
49: b = FIXCHARSTRING; \
50: *ierr = PetscStrncpy(b, a, n + 1); \
51: if (*ierr) return; \
52: } else b = a; \
53: } \
54: } while (0)
56: PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
57: {
58: char *c1;
60: FIXCHARNOMALLOC(file, len, c1);
61: *ierr = PetscMallocValidate(*line, "Userfunction", c1);
62: }