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