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