2: /* This file contains info for the use of PETSc Fortran interface stubs */
3: #if !defined(_FORTRANIMPL_H)
4: #define _FORTRANIMPL_H 6: #include <petsc/private/petscimpl.h> 8: /* PETSC_STDCALL is defined on some Microsoft Windows systems and is used for functions compiled by the Fortran compiler */
9: #if !defined(PETSC_STDCALL)
10: #define PETSC_STDCALL 11: #endif
12: PETSC_EXTERN PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint,MPI_Datatype*);
14: PETSC_EXTERN PetscErrorCode PetscScalarAddressToFortran(PetscObject,PetscInt,PetscScalar*,PetscScalar*,PetscInt,size_t*);
15: PETSC_EXTERN PetscErrorCode PetscScalarAddressFromFortran(PetscObject,PetscScalar*,size_t,PetscInt,PetscScalar **);
16: PETSC_EXTERN size_t PetscIntAddressToFortran(const PetscInt*,const PetscInt*);
17: PETSC_EXTERN PetscInt *PetscIntAddressFromFortran(const PetscInt*,size_t);
18: PETSC_EXTERN char *PETSC_NULL_CHARACTER_Fortran;
19: PETSC_EXTERN void *PETSC_NULL_INTEGER_Fortran;
20: PETSC_EXTERN void *PETSC_NULL_SCALAR_Fortran;
21: PETSC_EXTERN void *PETSC_NULL_DOUBLE_Fortran;
22: PETSC_EXTERN void *PETSC_NULL_REAL_Fortran;
23: PETSC_EXTERN void *PETSC_NULL_BOOL_Fortran;
24: PETSC_EXTERN void (*PETSC_NULL_FUNCTION_Fortran)(void);
25: /* ----------------------------------------------------------------------*/
26: /*
27: PETSc object C pointers are stored directly as
28: Fortran integer*4 or *8 depending on the size of pointers.
29: */
32: /* --------------------------------------------------------------------*/
33: /*
34: This lets us map the str-len argument either, immediately following
35: the char argument (DVF on Win32) or at the end of the argument list
36: (general unix compilers)
37: */
38: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
39: #define PETSC_MIXED_LEN(len) ,int len 40: #define PETSC_END_LEN(len) 41: #define PETSC_MIXED_LEN_CALL(len) ,len 42: #define PETSC_END_LEN_CALL(len) 43: #define PETSC_MIXED_LEN_PROTO ,int 44: #define PETSC_END_LEN_PROTO 45: #else
46: #define PETSC_MIXED_LEN(len) 47: #define PETSC_END_LEN(len) ,int len 48: #define PETSC_MIXED_LEN_CALL(len) 49: #define PETSC_END_LEN_CALL(len) ,len 50: #define PETSC_MIXED_LEN_PROTO 51: #define PETSC_END_LEN_PROTO ,int 52: #endif
54: /* --------------------------------------------------------------------*/
55: /*
56: Since Fortran does not null terminate strings we need to insure the string is null terminated before passing it
57: to C. This may require a memory allocation which is then freed with FREECHAR().
58: */
59: #define FIXCHAR(a,n,b) \ 60: {\ 61: if (a == PETSC_NULL_CHARACTER_Fortran) { \ 62: b = a = 0; \ 63: } else { \ 64: while((n > 0) && (a[n-1] == ' ')) n--; \ 65: *PetscMalloc1(n+1,&b); \ 66: if (*ierr) return; \ 67: *PetscStrncpy(b,a,n+1); \ 68: if (*ierr) return; \ 69: } \ 70: } 71: #define FREECHAR(a,b) if (a != b) *PetscFree(b); 73: /*
74: Fortran expects any unneeded characters at the end of its strings to be filled with the blank character.
75: */
76: #define FIXRETURNCHAR(flg,a,n) \ 77: if (flg) { \ 78: int __i; \ 79: for (__i=0; __i<n && a[__i] != 0; __i++) {}; \ 80: for (; __i<n; __i++) a[__i] = ' ' ; \ 81: } 83: /*
84: The cast through PETSC_UINTPTR_T is so that compilers that warn about casting to/from void * to void(*)(void)
85: will not complain about these comparisons. It is not know if this works for all compilers
86: */
87: #define FORTRANNULLINTEGER(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_INTEGER_Fortran) 88: #define FORTRANNULLSCALAR(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_SCALAR_Fortran) 89: #define FORTRANNULLDOUBLE(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_DOUBLE_Fortran) 90: #define FORTRANNULLREAL(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_REAL_Fortran) 91: #define FORTRANNULLBOOL(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_BOOL_Fortran) 92: #define FORTRANNULLCHARACTER(a) (((void*)(PETSC_UINTPTR_T)a) == PETSC_NULL_CHARACTER_Fortran) 93: #define FORTRANNULLFUNCTION(a) (((void(*)(void))(PETSC_UINTPTR_T)a) == PETSC_NULL_FUNCTION_Fortran) 94: #define FORTRANNULLOBJECT(a) (*(void**)(PETSC_UINTPTR_T)a == (void*)-1) 96: #define CHKFORTRANNULLINTEGER(a) \ 97: if (FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \ 98: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \ 99: "Use PETSC_NULL_INTEGER"); *1; return; } \100: else if (FORTRANNULLINTEGER(a)) { a = NULL; }102: #define CHKFORTRANNULLSCALAR(a) \103: if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \104: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \105: "Use PETSC_NULL_SCALAR"); *1; return; } \106: else if (FORTRANNULLSCALAR(a)) { a = NULL; }108: #define CHKFORTRANNULLDOUBLE(a) \109: if (FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \110: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \111: "Use PETSC_NULL_DOUBLE"); *1; return; } \112: else if (FORTRANNULLDOUBLE(a)) { a = NULL; }114: #define CHKFORTRANNULLREAL(a) \115: if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \116: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \117: "Use PETSC_NULL_REAL"); *1; return; } \118: else if (FORTRANNULLREAL(a)) { a = NULL; }120: /*
121: The next two macros can generate false positives for Valgrind if the object passed
122: in has never been set before because the location (void**)a has never had a value
123: set to it. To prevent the false positive in the Fortran code one can initialize the
124: object with a = tXXX(0); for example a = tVec(0)
125: */
126: #define CHKFORTRANNULLOBJECT(a) \127: if (FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \128: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \129: "Use PETSC_NULL_XXX where XXX is the name of a particular object class"); *1; return; } \130: else if (*(void**)a == (void*)-1) { a = NULL; }132: PETSC_EXTERN void *PETSCNULLPOINTERADDRESS;
134: #define CHKFORTRANNULLOBJECTDEREFERENCE(a) \135: if (FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLBOOL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \136: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \137: "Use PETSC_NULL_XXX where XXX is the name of a particular object class"); *1; return; } \138: else if (*(void**)a == (void*)-1) { *((void***)&a) = &PETSCNULLPOINTERADDRESS; }141: #define CHKFORTRANNULLBOOL(a) \142: if (FORTRANNULLSCALAR(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLFUNCTION(a) || FORTRANNULLCHARACTER(a)) { \143: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \144: "Use PETSC_NULL_BOOL"); *1; return; } \145: else if (FORTRANNULLBOOL(a)) { a = NULL; }147: #define CHKFORTRANNULLFUNCTION(a) \148: if (FORTRANNULLOBJECT(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLBOOL(a) || FORTRANNULLCHARACTER(a)) { \149: PetscError(PETSC_COMM_SELF,__LINE__,"fortran_interface_unknown_file",__FILE__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL, \150: "Use PETSC_NULL_FUNCTION"); *1; return; } \151: else if (FORTRANNULLFUNCTION(a)) { a = NULL; }155: /*
156: Variable type where we stash PETSc object pointers in Fortran.
157: */
158: typedef PETSC_UINTPTR_T PetscFortranAddr;
160: /*
161: These are used to support the default viewers that are
162: created at run time, in C using the , trick.
164: The numbers here must match the numbers in include/petsc/finclude/petscsys.h
165: */
166: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN 4167: #define PETSC_VIEWER_DRAW_SELF_FORTRAN 5168: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN 6169: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN 7170: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN 8171: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN 9172: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN 10173: #define PETSC_VIEWER_STDERR_SELF_FORTRAN 11174: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN 12175: #define PETSC_VIEWER_BINARY_SELF_FORTRAN 13176: #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN 14177: #define PETSC_VIEWER_MATLAB_SELF_FORTRAN 15179: #if defined (PETSC_USE_SOCKET_VIEWER)
180: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v) \181: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { \182: v = PETSC_VIEWER_SOCKET_WORLD; \183: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { \184: v = PETSC_VIEWER_SOCKET_SELF185: #else
186: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v)187: #endif
189: #define PetscPatchDefaultViewers_Fortran(vin,v) \190: { \191: CHKFORTRANNULLOBJECTDEREFERENCE(vin);\192: if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \193: v = PETSC_VIEWER_DRAW_WORLD; \194: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \195: v = PETSC_VIEWER_DRAW_SELF; \196: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \197: v = PETSC_VIEWER_STDOUT_WORLD; \198: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \199: v = PETSC_VIEWER_STDOUT_SELF; \200: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \201: v = PETSC_VIEWER_STDERR_WORLD; \202: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \203: v = PETSC_VIEWER_STDERR_SELF; \204: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \205: v = PETSC_VIEWER_BINARY_WORLD; \206: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \207: v = PETSC_VIEWER_BINARY_SELF; \208: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \209: v = PETSC_VIEWER_BINARY_WORLD; \210: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \211: v = PETSC_VIEWER_BINARY_SELF; \212: PetscPatchDefaultViewers_Fortran_Socket(vin,v); \213: } else { \214: v = *vin; \215: } \216: }218: /*
219: Allocates enough space to store Fortran function pointers in PETSc object
220: that are needed by the Fortran interface.
221: */
222: #define PetscObjectAllocateFortranPointers(obj,N) do { \223: if (!((PetscObject)(obj))->fortran_func_pointers) { \224: *PetscMalloc((N)*sizeof(void(*)(void)),&((PetscObject)(obj))->fortran_func_pointers);if (*ierr) return; \225: *PetscMemzero(((PetscObject)(obj))->fortran_func_pointers,(N)*sizeof(void(*)(void)));if (*ierr) return; \226: ((PetscObject)obj)->num_fortran_func_pointers = (N); \227: } \228: } while (0)230: /* Entire function body, _ctx is a "special" variable that can be passed along */
231: #define PetscObjectUseFortranCallback_Private(obj,cid,types,args,cbclass) { \233: void (PETSC_STDCALL *func) types,*_ctx; \235: PetscObjectGetFortranCallback((PetscObject)(obj),(cbclass),(cid),(PetscVoidFunction*)&func,&_ctx); \236: if (func) {(*func)args;} \237: return(0); \238: }239: #define PetscObjectUseFortranCallback(obj,cid,types,args) PetscObjectUseFortranCallback_Private(obj,cid,types,args,PETSC_FORTRAN_CALLBACK_CLASS)240: #define PetscObjectUseFortranCallbackSubType(obj,cid,types,args) PetscObjectUseFortranCallback_Private(obj,cid,types,args,PETSC_FORTRAN_CALLBACK_SUBTYPE)242: /* Disable deprecation warnings while building Fortran wrappers */
243: #undef PETSC_DEPRECATED244: #define PETSC_DEPRECATED(arg)246: #endif