1ae4341f3SSatish Balay 2af0996ceSBarry Smith #include <petsc/private/fortranimpl.h> 3ae4341f3SSatish Balay 4519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS) 5ae4341f3SSatish Balay #define chkmemfortran_ CHKMEMFORTRAN 6ae4341f3SSatish Balay #define petscoffsetfortran_ PETSCOFFSETFORTRAN 745d5e9f8SBarry Smith #define petscobjectstateincrease_ PETSCOBJECTSTATEINCREASE 8*1ea3a486SMartin Diehl #define petscobjectcomposefunction_ PETSCOBJECTCOMPOSEFUNCTION 9ae4341f3SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 10ae4341f3SSatish Balay #define petscoffsetfortran_ petscoffsetfortran 11ae4341f3SSatish Balay #define chkmemfortran_ chkmemfortran 12bf34bf42SBarry Smith #define flush__ flush_ 1345d5e9f8SBarry Smith #define petscobjectstateincrease_ petscobjectstateincrease 14*1ea3a486SMartin Diehl #define petscobjectcomposefunction_ petscobjectcomposefunction 15ae4341f3SSatish Balay #endif 16ae4341f3SSatish Balay 178cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 1845d5e9f8SBarry Smith { 1945d5e9f8SBarry Smith *ierr = PetscObjectStateIncrease(*obj); 2045d5e9f8SBarry Smith } 2145d5e9f8SBarry Smith 22bf34bf42SBarry Smith #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 23bf34bf42SBarry Smith void flush__(int unit) 24bf34bf42SBarry Smith { 25bf34bf42SBarry Smith } 26bf34bf42SBarry Smith #endif 27bf34bf42SBarry Smith 28bf34bf42SBarry Smith 298cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 30ae4341f3SSatish Balay { 31ae4341f3SSatish Balay *ierr = 0; 32ae4341f3SSatish Balay *shift = y - x; 33ae4341f3SSatish Balay } 34ae4341f3SSatish Balay 35ae4341f3SSatish Balay /* ---------------------------------------------------------------------------------*/ 36ae4341f3SSatish Balay /* 37ae4341f3SSatish Balay This version does not do a malloc 38ae4341f3SSatish Balay */ 39ae4341f3SSatish Balay static char FIXCHARSTRING[1024]; 40ae4341f3SSatish Balay 41ae4341f3SSatish Balay #define FIXCHARNOMALLOC(a,n,b) \ 42ae4341f3SSatish Balay {\ 43ae4341f3SSatish Balay if (a == PETSC_NULL_CHARACTER_Fortran) { \ 44ae4341f3SSatish Balay b = a = 0; \ 45ae4341f3SSatish Balay } else { \ 46ae4341f3SSatish Balay while ((n > 0) && (a[n-1] == ' ')) n--; \ 47ae4341f3SSatish Balay if (a[n] != 0) { \ 48ae4341f3SSatish Balay b = FIXCHARSTRING; \ 4989d949e2SBarry Smith *ierr = PetscStrncpy(b,a,n+1); \ 50ae4341f3SSatish Balay if (*ierr) return; \ 51ae4341f3SSatish Balay } else b = a;\ 52ae4341f3SSatish Balay } \ 53ae4341f3SSatish Balay } 54ae4341f3SSatish Balay 55390e1bf2SBarry Smith PETSC_EXTERN void PETSC_STDCALL chkmemfortran_(int *line,char* file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 56ae4341f3SSatish Balay { 57ae4341f3SSatish Balay char *c1; 58ae4341f3SSatish Balay 59ae4341f3SSatish Balay FIXCHARNOMALLOC(file,len,c1); 60efca3c55SSatish Balay *ierr = PetscMallocValidate(*line,"Userfunction",c1); 61ae4341f3SSatish Balay } 62ae4341f3SSatish Balay 63*1ea3a486SMartin Diehl PETSC_EXTERN void PETSC_STDCALL petscobjectcomposefunction_(PetscObject *obj, char* name PETSC_MIXED_LEN(len), void (*fptr)(void), PetscErrorCode *ierr PETSC_END_LEN(len)) 64*1ea3a486SMartin Diehl { 65*1ea3a486SMartin Diehl char *c1; 66ae4341f3SSatish Balay 67*1ea3a486SMartin Diehl FIXCHARNOMALLOC(name,len,c1); 68*1ea3a486SMartin Diehl *ierr = PetscObjectComposeFunction(*obj,name,**fptr); 69*1ea3a486SMartin Diehl } 70ae4341f3SSatish Balay 71