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 PETSC_STDCALL 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 { 23 } 24 #endif 25 26 27 PETSC_EXTERN void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 28 { 29 *ierr = 0; 30 *shift = y - x; 31 } 32 33 /* ---------------------------------------------------------------------------------*/ 34 /* 35 This version does not do a malloc 36 */ 37 static char FIXCHARSTRING[1024]; 38 39 #define CHAR char* 40 #define FIXCHARNOMALLOC(a,n,b) \ 41 {\ 42 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 43 b = a = 0; \ 44 } else { \ 45 while ((n > 0) && (a[n-1] == ' ')) n--; \ 46 if (a[n] != 0) { \ 47 b = FIXCHARSTRING; \ 48 *ierr = PetscStrncpy(b,a,n); \ 49 if (*ierr) return; \ 50 b[n] = 0; \ 51 } else b = a;\ 52 } \ 53 } 54 55 PETSC_EXTERN void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 56 { 57 char *c1; 58 59 FIXCHARNOMALLOC(file,len,c1); 60 *ierr = PetscMallocValidate(*line,"Userfunction",c1); 61 } 62 63 64 65