1af0996ceSBarry Smith #include <petsc/private/fortranimpl.h> 2ae4341f3SSatish Balay 3519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS) 4ae4341f3SSatish Balay #define chkmemfortran_ CHKMEMFORTRAN 5ae4341f3SSatish Balay #define petscoffsetfortran_ PETSCOFFSETFORTRAN 645d5e9f8SBarry Smith #define petscobjectstateincrease_ PETSCOBJECTSTATEINCREASE 7*0764c050SBarry Smith #define petsccienabledportableerroroutput_ PETSCCIENABLEDPORTABLEERROROUTPUT 8ae4341f3SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9ae4341f3SSatish Balay #define petscoffsetfortran_ petscoffsetfortran 10ae4341f3SSatish Balay #define chkmemfortran_ chkmemfortran 11bf34bf42SBarry Smith #define flush__ flush_ 1245d5e9f8SBarry Smith #define petscobjectstateincrease_ petscobjectstateincrease 13*0764c050SBarry Smith #define petsccienabledportableerroroutput_ petsccienabledportableerroroutput 14ae4341f3SSatish Balay #endif 15ae4341f3SSatish Balay 16*0764c050SBarry Smith PETSC_EXTERN void petsccienabledportableerroroutput_(PetscMPIInt *cienabled) 17*0764c050SBarry Smith { 18*0764c050SBarry Smith *cienabled = PetscCIEnabledPortableErrorOutput ? 1 : 0; 19*0764c050SBarry Smith } 20*0764c050SBarry Smith 2119caf8f3SSatish Balay PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr) 2245d5e9f8SBarry Smith { 2345d5e9f8SBarry Smith *ierr = PetscObjectStateIncrease(*obj); 2445d5e9f8SBarry Smith } 2545d5e9f8SBarry Smith 26bf34bf42SBarry Smith #if defined(PETSC_MISSING_FORTRAN_FLUSH_) 275975b3b6SBarry Smith void flush__(int unit) { } 28bf34bf42SBarry Smith #endif 29bf34bf42SBarry Smith 3019caf8f3SSatish Balay PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x, PetscScalar *y, size_t *shift, PetscErrorCode *ierr) 31ae4341f3SSatish Balay { 323ba16761SJacob Faibussowitsch *ierr = PETSC_SUCCESS; 33ae4341f3SSatish Balay *shift = y - x; 34ae4341f3SSatish Balay } 35ae4341f3SSatish Balay 36ae4341f3SSatish Balay /* ---------------------------------------------------------------------------------*/ 37ae4341f3SSatish Balay /* 38ae4341f3SSatish Balay This version does not do a malloc 39ae4341f3SSatish Balay */ 40ae4341f3SSatish Balay static char FIXCHARSTRING[1024]; 41ae4341f3SSatish Balay 42ae4341f3SSatish Balay #define FIXCHARNOMALLOC(a, n, b) \ 43a8f51744SPierre Jolivet do { \ 44ae4341f3SSatish Balay if (a == PETSC_NULL_CHARACTER_Fortran) { \ 45dfef5ea7SSatish Balay b = a = NULL; \ 46ae4341f3SSatish Balay } else { \ 47ae4341f3SSatish Balay while ((n > 0) && (a[n - 1] == ' ')) n--; \ 48ae4341f3SSatish Balay if (a[n] != 0) { \ 49ae4341f3SSatish Balay b = FIXCHARSTRING; \ 5089d949e2SBarry Smith *ierr = PetscStrncpy(b, a, n + 1); \ 51ae4341f3SSatish Balay if (*ierr) return; \ 52ae4341f3SSatish Balay } else b = a; \ 53ae4341f3SSatish Balay } \ 54a8f51744SPierre Jolivet } while (0) 55ae4341f3SSatish Balay 5619caf8f3SSatish Balay PETSC_EXTERN void chkmemfortran_(int *line, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 57ae4341f3SSatish Balay { 58ae4341f3SSatish Balay char *c1; 59ae4341f3SSatish Balay 60ae4341f3SSatish Balay FIXCHARNOMALLOC(file, len, c1); 61efca3c55SSatish Balay *ierr = PetscMallocValidate(*line, "Userfunction", c1); 62ae4341f3SSatish Balay } 63