xref: /petsc/src/sys/ftn-custom/zsys.c (revision 19caf8f3c08b1f0ca9f5469bde385c134aa76c82)
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
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
13ae4341f3SSatish Balay #endif
14ae4341f3SSatish Balay 
15*19caf8f3SSatish Balay PETSC_EXTERN void petscobjectstateincrease_(PetscObject *obj, PetscErrorCode *ierr)
1645d5e9f8SBarry Smith {
1745d5e9f8SBarry Smith   *ierr = PetscObjectStateIncrease(*obj);
1845d5e9f8SBarry Smith }
1945d5e9f8SBarry Smith 
20bf34bf42SBarry Smith #if defined(PETSC_MISSING_FORTRAN_FLUSH_)
21bf34bf42SBarry Smith void flush__(int unit)
22bf34bf42SBarry Smith {
23bf34bf42SBarry Smith }
24bf34bf42SBarry Smith #endif
25bf34bf42SBarry Smith 
26bf34bf42SBarry Smith 
27*19caf8f3SSatish Balay PETSC_EXTERN void petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr)
28ae4341f3SSatish Balay {
29ae4341f3SSatish Balay   *ierr  = 0;
30ae4341f3SSatish Balay   *shift = y - x;
31ae4341f3SSatish Balay }
32ae4341f3SSatish Balay 
33ae4341f3SSatish Balay /* ---------------------------------------------------------------------------------*/
34ae4341f3SSatish Balay /*
35ae4341f3SSatish Balay         This version does not do a malloc
36ae4341f3SSatish Balay */
37ae4341f3SSatish Balay static char FIXCHARSTRING[1024];
38ae4341f3SSatish Balay 
39ae4341f3SSatish Balay #define FIXCHARNOMALLOC(a,n,b) \
40ae4341f3SSatish Balay {\
41ae4341f3SSatish Balay   if (a == PETSC_NULL_CHARACTER_Fortran) { \
42ae4341f3SSatish Balay     b = a = 0; \
43ae4341f3SSatish Balay   } else { \
44ae4341f3SSatish Balay     while ((n > 0) && (a[n-1] == ' ')) n--; \
45ae4341f3SSatish Balay     if (a[n] != 0) { \
46ae4341f3SSatish Balay       b = FIXCHARSTRING; \
4789d949e2SBarry Smith       *ierr = PetscStrncpy(b,a,n+1); \
48ae4341f3SSatish Balay       if (*ierr) return; \
49ae4341f3SSatish Balay     } else b = a;\
50ae4341f3SSatish Balay   } \
51ae4341f3SSatish Balay }
52ae4341f3SSatish Balay 
53*19caf8f3SSatish Balay PETSC_EXTERN void chkmemfortran_(int *line,char* file,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
54ae4341f3SSatish Balay {
55ae4341f3SSatish Balay   char *c1;
56ae4341f3SSatish Balay 
57ae4341f3SSatish Balay   FIXCHARNOMALLOC(file,len,c1);
58efca3c55SSatish Balay   *ierr = PetscMallocValidate(*line,"Userfunction",c1);
59ae4341f3SSatish Balay }
60ae4341f3SSatish Balay 
61ae4341f3SSatish Balay 
623920c838SMartin Diehl 
63