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: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
8: #define petscoffsetfortran_ petscoffsetfortran
9: #define chkmemfortran_ chkmemfortran
10: #define flush__ flush_
11: #define petscobjectstateincrease_ petscobjectstateincrease
12: #endif
14: PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr)
15: {
16: *ierr = PetscObjectStateIncrease(*obj);
17: }
19: #if defined(PETSC_MISSING_FORTRAN_FLUSH_)
20: void flush__(int unit) { }
21: #endif
23: PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr)
24: {
25: *ierr = PETSC_SUCCESS;
26: *shift = y - x;
27: }
29: /* ---------------------------------------------------------------------------------*/
30: /*
31: This version does not do a malloc
32: */
33: static char FIXCHARSTRING[1024];
35: #define FIXCHARNOMALLOC(a, n, b) \
36: do { \
37: if (a == PETSC_NULL_CHARACTER_Fortran) { \
38: b = a = NULL; \
39: } else { \
40: while ((n > 0) && (a[n - 1] == ' ')) n--; \
41: if (a[n] != 0) { \
42: b = FIXCHARSTRING; \
43: *ierr = PetscStrncpy(b, a, n + 1); \
44: if (*ierr) return; \
45: } else b = a; \
46: } \
47: } while (0)
49: PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
50: {
51: char *c1;
53: FIXCHARNOMALLOC(file, len, c1);
54: *ierr = PetscMallocValidate(*line, "Userfunction", c1);
55: }