1 #include <petsc/private/fortranimpl.h> 2 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 13 14 PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 15 { 16 *ierr = PetscObjectStateIncrease(*obj); 17 } 18 19 #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 20 void flush__(int unit) { } 21 #endif 22 23 PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr) 24 { 25 *ierr = PETSC_SUCCESS; 26 *shift = y - x; 27 } 28 29 /* ---------------------------------------------------------------------------------*/ 30 /* 31 This version does not do a malloc 32 */ 33 static char FIXCHARSTRING[1024]; 34 35 #define FIXCHARNOMALLOC(a, n, b) \ 36 do { \ 37 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 38 b = a = 0; \ 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) 48 49 PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 50 { 51 char *c1; 52 53 FIXCHARNOMALLOC(file, len, c1); 54 *ierr = PetscMallocValidate(*line, "Userfunction", c1); 55 } 56