1ae4341f3SSatish Balay 2*b45d2f2cSJed Brown #include <petsc-private/fortranimpl.h> 3ae4341f3SSatish Balay 4ae4341f3SSatish Balay #ifdef PETSC_HAVE_FORTRAN_CAPS 5ae4341f3SSatish Balay #define chkmemfortran_ CHKMEMFORTRAN 6ae4341f3SSatish Balay #define petscoffsetfortran_ PETSCOFFSETFORTRAN 745d5e9f8SBarry Smith #define petscobjectstateincrease_ PETSCOBJECTSTATEINCREASE 845d5e9f8SBarry Smith #define petscobjectstatedecrease_ PETSCOBJECTSTATEDECREASE 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 1445d5e9f8SBarry Smith #define petscobjectstatedecrease_ petscobjectstatedecrease 15ae4341f3SSatish Balay #endif 16ae4341f3SSatish Balay 1745d5e9f8SBarry Smith 18ae4341f3SSatish Balay EXTERN_C_BEGIN 19ae4341f3SSatish Balay 2045d5e9f8SBarry Smith void PETSC_STDCALL petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr ) 2145d5e9f8SBarry Smith { 2245d5e9f8SBarry Smith *ierr = PetscObjectStateIncrease(*obj); 2345d5e9f8SBarry Smith } 2445d5e9f8SBarry Smith void PETSC_STDCALL petscobjectstatedecrease_(PetscObject *obj, PetscErrorCode *ierr ){ 2545d5e9f8SBarry Smith *ierr = PetscObjectStateDecrease(*obj); 2645d5e9f8SBarry Smith } 2745d5e9f8SBarry Smith 2845d5e9f8SBarry Smith 29bf34bf42SBarry Smith #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 30bf34bf42SBarry Smith void flush__(int unit) 31bf34bf42SBarry Smith { 32bf34bf42SBarry Smith } 33bf34bf42SBarry Smith #endif 34bf34bf42SBarry Smith 35bf34bf42SBarry Smith 36c74decddSSatish Balay void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 37ae4341f3SSatish Balay { 38ae4341f3SSatish Balay *ierr = 0; 39ae4341f3SSatish Balay *shift = y - x; 40ae4341f3SSatish Balay } 41ae4341f3SSatish Balay 42ae4341f3SSatish Balay /* ---------------------------------------------------------------------------------*/ 43ae4341f3SSatish Balay /* 44ae4341f3SSatish Balay This version does not do a malloc 45ae4341f3SSatish Balay */ 46ae4341f3SSatish Balay static char FIXCHARSTRING[1024]; 47ae4341f3SSatish Balay 48ae4341f3SSatish Balay #define CHAR char* 49ae4341f3SSatish Balay #define FIXCHARNOMALLOC(a,n,b) \ 50ae4341f3SSatish Balay {\ 51ae4341f3SSatish Balay if (a == PETSC_NULL_CHARACTER_Fortran) { \ 52ae4341f3SSatish Balay b = a = 0; \ 53ae4341f3SSatish Balay } else { \ 54ae4341f3SSatish Balay while((n > 0) && (a[n-1] == ' ')) n--; \ 55ae4341f3SSatish Balay if (a[n] != 0) { \ 56ae4341f3SSatish Balay b = FIXCHARSTRING; \ 57ae4341f3SSatish Balay *ierr = PetscStrncpy(b,a,n); \ 58ae4341f3SSatish Balay if (*ierr) return; \ 59ae4341f3SSatish Balay b[n] = 0; \ 60ae4341f3SSatish Balay } else b = a;\ 61ae4341f3SSatish Balay } \ 62ae4341f3SSatish Balay } 63ae4341f3SSatish Balay 64ae4341f3SSatish Balay void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 65ae4341f3SSatish Balay { 66ae4341f3SSatish Balay char *c1; 67ae4341f3SSatish Balay 68ae4341f3SSatish Balay FIXCHARNOMALLOC(file,len,c1); 69ae4341f3SSatish Balay *ierr = PetscMallocValidate(*line,"Userfunction",c1," "); 70ae4341f3SSatish Balay } 71ae4341f3SSatish Balay 72ae4341f3SSatish Balay 73ae4341f3SSatish Balay EXTERN_C_END 74ae4341f3SSatish Balay 75ae4341f3SSatish Balay 76