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: if (a[n] != 0) { \
86: *PetscMalloc((n+1)*sizeof(char),&b); \
87: if(*ierr) return; \
88: *PetscStrncpy(b,a,n); \
89: if(*ierr) return; \
90: b[n] = 0; \
91: } else b = a;\
92: } \
93: }
95: #define FREECHAR(a,b) if (a != b) PetscFreeVoid(b);
97: #define FIXRETURNCHAR(a,n) \
98: { \
99: int __i; \
100: for (__i=0; __i<n && a[__i] != 0; __i++) ; \
101: for (; __i<n; __i++) a[__i] = ' ' ; \
102: }
104: #endif
106: #define FORTRANNULL(a) (((void*)a) == PETSC_NULL_Fortran)
107: #define FORTRANNULLINTEGER(a) (((void*)a) == PETSC_NULL_INTEGER_Fortran)
108: #define FORTRANNULLSCALAR(a) (((void*)a) == PETSC_NULL_SCALAR_Fortran)
109: #define FORTRANNULLDOUBLE(a) (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
110: #define FORTRANNULLREAL(a) (((void*)a) == PETSC_NULL_REAL_Fortran)
111: #define FORTRANNULLOBJECT(a) (((void*)a) == PETSC_NULL_OBJECT_Fortran)
112: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)
115: #define CHKFORTRANNULLINTEGER(a) \
116: if (FORTRANNULL(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
117: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
118: "Use PETSC_NULL_INTEGER"); *1; return; } \
119: else if (FORTRANNULLINTEGER(a)) { a = PETSC_NULL; }
121: #define CHKFORTRANNULLSCALAR(a) \
122: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
123: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
124: "Use PETSC_NULL_SCALAR"); *1; return; } \
125: else if (FORTRANNULLSCALAR(a)) { a = PETSC_NULL; }
127: #define CHKFORTRANNULLDOUBLE(a) \
128: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a) || FORTRANNULLOBJECT(a)) { \
129: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
130: "Use PETSC_NULL_DOUBLE"); *1; return; } \
131: else if (FORTRANNULLDOUBLE(a)) { a = PETSC_NULL; }
133: #define CHKFORTRANNULLREAL(a) \
134: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLOBJECT(a)) { \
135: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
136: "Use PETSC_NULL_REAL"); *1; return; } \
137: else if (FORTRANNULLREAL(a)) { a = PETSC_NULL; }
139: #define CHKFORTRANNULLOBJECT(a) \
140: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a)) { \
141: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
142: "Use PETSC_NULL_OBJECT"); *1; return; } \
143: else if (FORTRANNULLOBJECT(a)) { a = PETSC_NULL; }
147: #define CHKFORTRANNULLOBJECTDEREFERENCE(a) \
148: if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a)) { \
149: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
150: "Use PETSC_NULL_OBJECT"); *1; return; } \
151: else if (FORTRANNULLOBJECT(a)) { *((void***)&a) = &PETSCNULLPOINTERADDRESS; }
152:
153: /*
154: These are used to support the default viewers that are
155: created at run time, in C using the , trick.
157: The numbers here must match the numbers in include/finclude/petsc.h
158: */
159: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN -4
160: #define PETSC_VIEWER_DRAW_SELF_FORTRAN -5
161: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN -6
162: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN -7
163: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN -8
164: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN -9
165: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN -10
166: #define PETSC_VIEWER_STDERR_SELF_FORTRAN -11
167: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN -12
168: #define PETSC_VIEWER_BINARY_SELF_FORTRAN -13
169: #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN -14
170: #define PETSC_VIEWER_MATLAB_SELF_FORTRAN -15
172: #if defined (PETSC_USE_SOCKET_VIEWER)
173: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v) \
174: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { \
175: v = PETSC_VIEWER_SOCKET_WORLD; \
176: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { \
177: v = PETSC_VIEWER_SOCKET_SELF
178: #else
179: #define PetscPatchDefaultViewers_Fortran_Socket(vin,v)
180: #endif
182: #define PetscPatchDefaultViewers_Fortran(vin,v) \
183: { \
184: if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \
185: v = PETSC_VIEWER_DRAW_WORLD; \
186: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \
187: v = PETSC_VIEWER_DRAW_SELF; \
188: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \
189: v = PETSC_VIEWER_STDOUT_WORLD; \
190: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \
191: v = PETSC_VIEWER_STDOUT_SELF; \
192: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \
193: v = PETSC_VIEWER_STDERR_WORLD; \
194: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \
195: v = PETSC_VIEWER_STDERR_SELF; \
196: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \
197: v = PETSC_VIEWER_BINARY_WORLD; \
198: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \
199: v = PETSC_VIEWER_BINARY_SELF; \
200: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \
201: v = PETSC_VIEWER_BINARY_WORLD; \
202: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \
203: v = PETSC_VIEWER_BINARY_SELF; \
204: PetscPatchDefaultViewers_Fortran_Socket(vin,v); \
205: } else { \
206: v = *vin; \
207: } \
208: }