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 #define petscobjectstatedecrease_ PETSCOBJECTSTATEDECREASE 9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 10 #define petscoffsetfortran_ petscoffsetfortran 11 #define chkmemfortran_ chkmemfortran 12 #define flush__ flush_ 13 #define petscobjectstateincrease_ petscobjectstateincrease 14 #define petscobjectstatedecrease_ petscobjectstatedecrease 15 #endif 16 17 PETSC_EXTERN void PETSC_STDCALL petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 18 { 19 *ierr = PetscObjectStateIncrease(*obj); 20 } 21 PETSC_EXTERN void PETSC_STDCALL petscobjectstatedecrease_(PetscObject *obj, PetscErrorCode *ierr) 22 { 23 *ierr = PetscObjectStateDecrease(*obj); 24 } 25 26 27 #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 28 void flush__(int unit) 29 { 30 } 31 #endif 32 33 34 PETSC_EXTERN void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 35 { 36 *ierr = 0; 37 *shift = y - x; 38 } 39 40 /* ---------------------------------------------------------------------------------*/ 41 /* 42 This version does not do a malloc 43 */ 44 static char FIXCHARSTRING[1024]; 45 46 #define CHAR char* 47 #define FIXCHARNOMALLOC(a,n,b) \ 48 {\ 49 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 50 b = a = 0; \ 51 } else { \ 52 while ((n > 0) && (a[n-1] == ' ')) n--; \ 53 if (a[n] != 0) { \ 54 b = FIXCHARSTRING; \ 55 *ierr = PetscStrncpy(b,a,n); \ 56 if (*ierr) return; \ 57 b[n] = 0; \ 58 } else b = a;\ 59 } \ 60 } 61 62 PETSC_EXTERN void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 63 { 64 char *c1; 65 66 FIXCHARNOMALLOC(file,len,c1); 67 *ierr = PetscMallocValidate(*line,"Userfunction",c1," "); 68 } 69 70 71 72