1 2 #include <petsc/private/fortranimpl.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define chkmemfortran_ CHKMEMFORTRAN 6 #define petscoffsetfortran_ PETSCOFFSETFORTRAN 7 #define petscobjectstateincrease_ PETSCOBJECTSTATEINCREASE 8 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define petscoffsetfortran_ petscoffsetfortran 10 #define chkmemfortran_ chkmemfortran 11 #define flush__ flush_ 12 #define petscobjectstateincrease_ petscobjectstateincrease 13 #endif 14 15 PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 16 { 17 *ierr = PetscObjectStateIncrease(*obj); 18 } 19 20 #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 21 void flush__(int unit) { } 22 #endif 23 24 PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr) 25 { 26 *ierr = PETSC_SUCCESS; 27 *shift = y - x; 28 } 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 = 0; \ 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 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