Actual source code: zpetsc.h
2: /* This file contains info for the use of PETSc Fortran interface stubs */
4: #include petsc.h
5: #include "petscfix.h"
7: EXTERN PetscErrorCode PetscScalarAddressToFortran(PetscObject,PetscInt,PetscScalar*,PetscScalar*,PetscInt,size_t*);
8: EXTERN PetscErrorCode PetscScalarAddressFromFortran(PetscObject,PetscScalar*,size_t,PetscInt,PetscScalar **);
9: EXTERN size_t PetscIntAddressToFortran(PetscInt*,PetscInt*);
10: EXTERN PetscInt *PetscIntAddressFromFortran(PetscInt*,size_t);
21: /* ----------------------------------------------------------------------*/
22: /*
23: We store each PETSc object C pointer directly as a
24: Fortran integer*4 or *8 depending on the size of pointers.
25: */
26: #define PetscFInt long
28: #define PetscToPointer(a) (*(long *)(a))
29: #define PetscFromPointer(a) (long)(a)
31: /* ----------------------------------------------------------------------*/
32: #define PetscToPointerComm(a) MPI_Comm_f2c(*(MPI_Fint *)(&a))
33: #define PetscFromPointerComm(a) MPI_Comm_c2f(a)
35: /* --------------------------------------------------------------------*/
36: /*
37: This lets us map the str-len argument either, immediately following
38: the char argument (DVF on Win32) or at the end of the argument list
39: (general unix compilers)
40: */
41: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
42: #define PETSC_MIXED_LEN(len) ,int len
43: #define PETSC_END_LEN(len)
44: #else
45: #define PETSC_MIXED_LEN(len)
46: #define PETSC_END_LEN(len) ,int len
47: #endif
49: /* --------------------------------------------------------------------*/
50: /*
51: This defines the mappings from Fortran character strings
52: to C character strings on the Cray T3D.
53: */
54: #if defined(PETSC_USES_CPTOFCD)
55: #include <fortran.h>
57: #define CHAR _fcd
58: #define FIXCHAR(a,n,b) \
59: { \
60: b = _fcdtocp(a); \
61: n = _fcdlen (a); \
62: if (b == PETSC_NULL_CHARACTER_Fortran) { \
63: b = 0; \
64: } else { \
65: while((n > 0) && (b[n-1] == ' ')) n--; \
66: *PetscMalloc((n+1)*sizeof(char),&b); \
67: if(*ierr) return; \
68: *PetscStrncpy(b,_fcdtocp(a),n); \
69: if(*ierr) return; \
70: b[n] = 0; \
71: } \
72: }
73: #define FREECHAR(a,b) if (b) PetscFreeVoid(b);
74: #define FIXRETURNCHAR(a,n)
76: #else
78: #define CHAR char*
79: #define FIXCHAR(a,n,b) \
80: {\
81: if (a == PETSC_NULL_CHARACTER_Fortran) { \
82: b = a = 0; \
83: } else { \
84: while((n > 0) && (a[n-1] == ' ')) n--; \
85: *PetscMalloc((n+1)*sizeof(char),&b); \
86: if(*ierr) return; \
87: *PetscStrncpy(b,a,n); \
88: if(*ierr) return; \
89: b[n] = 0; \
90: } \
91: }
93: #define FREECHAR(a,b) if (a != b) PetscFreeVoid(b);
95: #define FIXRETURNCHAR(a,n) \
96: { \
97: int __i; \
98: for (__i=0; __i<n && a[__i] != 0; __i++) ; \
99: for (; __i<n; __i++) a[__i] = ' ' ; \
100: }
102: #endif
104: #define FORTRANNULL(a) (((void*)a) == PETSC_NULL_Fortran)
105: #define FORTRANNULLINTEGER(a) (((void*)a) == PETSC_NULL_INTEGER_Fortran)
106: #define FORTRANNULLSCALAR(a) (((void*)a) == PETSC_NULL_SCALAR_Fortran)
107: #define FORTRANNULLDOUBLE(a) (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
108: #define FORTRANNULLREAL(a) (((void*)a) == PETSC_NULL_REAL_Fortran)
109: #define FORTRANNULLOBJECT(a) (((void*)a) == PETSC_NULL_OBJECT_Fortran)
110: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)
113: #define CHKFORTRANNULLINTEGER(a) \
114: if (FORTRANNULL(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
115: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
116: "Use PETSC_NULL_INTEGER"); *1; return; } \
117: else if (FORTRANNULLINTEGER(a)) { a = PETSC_NULL; }
119: #define CHKFORTRANNULLSCALAR(a) \
120: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
121: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
122: "Use PETSC_NULL_SCALAR"); *1; return; } \
123: else if (FORTRANNULLSCALAR(a)) { a = PETSC_NULL; }
125: #define CHKFORTRANNULLDOUBLE(a) \
126: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
127: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
128: "Use PETSC_NULL_DOUBLE"); *1; return; } \
129: else if (FORTRANNULLDOUBLE(a)) { a = PETSC_NULL; }
131: #define CHKFORTRANNULLREAL(a) \
132: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLOBJECT(a)) { \
133: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
134: "Use PETSC_NULL_REAL"); *1; return; } \
135: else if (FORTRANNULLREAL(a)) { a = PETSC_NULL; }
137: #define CHKFORTRANNULLOBJECT(a) \
138: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a)) { \
139: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
140: "Use PETSC_NULL_OBJECT"); *1; return; } \
141: else if (FORTRANNULLOBJECT(a)) { a = PETSC_NULL; }
145: #define CHKFORTRANNULLOBJECTDEREFERENCE(a) \
146: if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a)) { \
147: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
148: "Use PETSC_NULL_OBJECT"); *1; return; } \
149: else if (FORTRANNULLOBJECT(a)) { *((void***)&a) = &PETSCNULLPOINTERADDRESS; }
150:
151: /*
152: These are used to support the default viewers that are
153: created at run time, in C using the , trick.
155: The numbers here must match the numbers in include/finclude/petsc.h
156: */
157: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN -4
158: #define PETSC_VIEWER_DRAW_SELF_FORTRAN -5
159: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN -6
160: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN -7
161: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN -8
162: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN -9
163: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN -10
164: #define PETSC_VIEWER_STDERR_SELF_FORTRAN -11
165: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN -12
166: #define PETSC_VIEWER_BINARY_SELF_FORTRAN -13
167: #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN -14
168: #define PETSC_VIEWER_MATLAB_SELF_FORTRAN -15
170: #if defined (PETSC_USE_SOCKET_VIEWER)
171: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v) \
172: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { \
173: v = PETSC_VIEWER_SOCKET_WORLD; \
174: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { \
175: v = PETSC_VIEWER_SOCKET_SELF
176: #else
177: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v)
178: #endif
180: #define PetscPatchDefaultViewers_Fortran(vin,v) \
181: { \
182: if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \
183: v = PETSC_VIEWER_DRAW_WORLD; \
184: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \
185: v = PETSC_VIEWER_DRAW_SELF; \
186: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \
187: v = PETSC_VIEWER_STDOUT_WORLD; \
188: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \
189: v = PETSC_VIEWER_STDOUT_SELF; \
190: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \
191: v = PETSC_VIEWER_STDERR_WORLD; \
192: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \
193: v = PETSC_VIEWER_STDERR_SELF; \
194: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \
195: v = PETSC_VIEWER_BINARY_WORLD; \
196: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \
197: v = PETSC_VIEWER_BINARY_SELF; \
198: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \
199: v = PETSC_VIEWER_BINARY_WORLD; \
200: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \
201: v = PETSC_VIEWER_BINARY_SELF; \
202: PetscPatchDefaultViewers_Fortran_Socket(vin,v); \
203: } else { \
204: v = *vin; \
205: } \
206: }