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 #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 15 16 PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled) 17 { 18 *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0; 19 } 20 21 PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 22 { 23 *ierr = PetscObjectStateIncrease(*obj); 24 } 25 26 #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 27 void flush__(int unit) { } 28 #endif 29 30 PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr) 31 { 32 *ierr = PETSC_SUCCESS; 33 *shift = y - x; 34 } 35 36 /* ---------------------------------------------------------------------------------*/ 37 /* 38 This version does not do a malloc 39 */ 40 static char FIXCHARSTRING[1024]; 41 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) 55 56 PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 57 { 58 char *c1; 59 60 FIXCHARNOMALLOC(file, len, c1); 61 *ierr = PetscMallocValidate(*line, "Userfunction", c1); 62 } 63