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 petscobjectcomposefunction_ PETSCOBJECTCOMPOSEFUNCTION 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 petscobjectcomposefunction_ petscobjectcomposefunction 15 #endif 16 17 PETSC_EXTERN void PETSC_STDCALL petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 18 { 19 *ierr = PetscObjectStateIncrease(*obj); 20 } 21 22 #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 23 void flush__(int unit) 24 { 25 } 26 #endif 27 28 29 PETSC_EXTERN void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 30 { 31 *ierr = 0; 32 *shift = y - x; 33 } 34 35 /* ---------------------------------------------------------------------------------*/ 36 /* 37 This version does not do a malloc 38 */ 39 static char FIXCHARSTRING[1024]; 40 41 #define FIXCHARNOMALLOC(a,n,b) \ 42 {\ 43 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 44 b = a = 0; \ 45 } else { \ 46 while ((n > 0) && (a[n-1] == ' ')) n--; \ 47 if (a[n] != 0) { \ 48 b = FIXCHARSTRING; \ 49 *ierr = PetscStrncpy(b,a,n+1); \ 50 if (*ierr) return; \ 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 PETSC_EXTERN void PETSC_STDCALL petscobjectcomposefunction_(PetscObject *obj, char* name PETSC_MIXED_LEN(len), void (*fptr)(void), PetscErrorCode *ierr PETSC_END_LEN(len)) 64 { 65 char *c1; 66 67 FIXCHARNOMALLOC(name,len,c1); 68 *ierr = PetscObjectComposeFunction(*obj,name,**fptr); 69 } 70 71