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