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