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,PetscScalar*,PetscScalar*,PetscInt,size_t*);
8: EXTERN PetscErrorCode PetscScalarAddressFromFortran(PetscObject,PetscScalar*,PetscInt,PetscInt,PetscScalar **);
9: EXTERN size_t PetscIntAddressToFortran(PetscInt*,PetscInt*);
10: EXTERN PetscInt *PetscIntAddressFromFortran(PetscInt*,PetscInt);
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)
30: #define PetscRmPointer(a)
32: /* ----------------------------------------------------------------------*/
33: #define PetscToPointerComm(a) MPI_Comm_f2c(*(MPI_Fint *)(&a))
34: #define PetscFromPointerComm(a) MPI_Comm_c2f(a)
36: /* --------------------------------------------------------------------*/
37: /*
38: This lets us map the str-len argument either, immediately following
39: the char argument (DVF on Win32) or at the end of the argument list
40: (general unix compilers)
41: */
42: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
43: #define PETSC_MIXED_LEN(len) ,int len
44: #define PETSC_END_LEN(len)
45: #else
46: #define PETSC_MIXED_LEN(len)
47: #define PETSC_END_LEN(len) ,int len
48: #endif
50: /* --------------------------------------------------------------------*/
51: /*
52: This defines the mappings from Fortran character strings
53: to C character strings on the Cray T3D.
54: */
55: #if defined(PETSC_USES_CPTOFCD)
56: #include <fortran.h>
58: #define CHAR _fcd
59: #define FIXCHAR(a,n,b) \
60: { \
61: b = _fcdtocp(a); \
62: n = _fcdlen (a); \
63: if (b == PETSC_NULL_CHARACTER_Fortran) { \
64: b = 0; \
65: } else { \
66: while((n > 0) && (b[n-1] == ' ')) n--; \
67: *PetscMalloc((n+1)*sizeof(char),&b); \
68: if(*ierr) return; \
69: *PetscStrncpy(b,_fcdtocp(a),n); \
70: if(*ierr) return; \
71: b[n] = 0; \
72: } \
73: }
74: #define FREECHAR(a,b) if (b) PetscFree(b);
75: #define FIXRETURNCHAR(a,n)
77: #else
79: #define CHAR char*
80: #define FIXCHAR(a,n,b) \
81: {\
82: if (a == PETSC_NULL_CHARACTER_Fortran) { \
83: b = a = 0; \
84: } else { \
85: while((n > 0) && (a[n-1] == ' ')) n--; \
86: if (a[n] != 0) { \
87: *PetscMalloc((n+1)*sizeof(char),&b); \
88: if(*ierr) return; \
89: *PetscStrncpy(b,a,n); \
90: if(*ierr) return; \
91: b[n] = 0; \
92: } else b = a;\
93: } \
94: }
96: #define FREECHAR(a,b) if (a != b) PetscFree(b);
98: #define FIXRETURNCHAR(a,n) \
99: { \
100: int __i; \
101: for (__i=0; __i<n && a[__i] != 0; __i++) ; \
102: for (; __i<n; __i++) a[__i] = ' ' ; \
103: }
105: #endif
107: #define FORTRANNULL(a) (((void*)a) == PETSC_NULL_Fortran)
108: #define FORTRANNULLINTEGER(a) (((void*)a) == PETSC_NULL_INTEGER_Fortran)
109: #define FORTRANNULLSCALAR(a) (((void*)a) == PETSC_NULL_SCALAR_Fortran)
110: #define FORTRANNULLDOUBLE(a) (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
111: #define FORTRANNULLREAL(a) (((void*)a) == PETSC_NULL_REAL_Fortran)
113: #define FORTRANNULLOBJECT FORTRANNULLINTEGER
115: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)
119: #define CHKFORTRANNULLINTEGER(a) \
120: if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a)) { \
121: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
122: "Use PETSC_NULL_INTEGER"); *1; return; } \
123: else if (FORTRANNULLINTEGER(a)) { a = PETSC_NULL; }
125: #define CHKFORTRANNULLSCALAR(a) \
126: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a)) { \
127: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
128: "Use PETSC_NULL_SCALAR"); *1; return; } \
129: else if (FORTRANNULLSCALAR(a)) { a = PETSC_NULL; }
131: #define CHKFORTRANNULLDOUBLE(a) \
132: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a)) { \
133: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
134: "Use PETSC_NULL_DOUBLE"); *1; return; } \
135: else if (FORTRANNULLDOUBLE(a)) { a = PETSC_NULL; }
137: #define CHKFORTRANNULLREAL(a) \
138: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a)) { \
139: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
140: "Use PETSC_NULL_REAL"); *1; return; } \
141: else if (FORTRANNULLREAL(a)) { a = PETSC_NULL; }
143: #define CHKFORTRANNULLOBJECT(a) \
144: if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a) || FORTRANNULLINTEGER(a)) { \
145: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1, \
146: "Use PETSC_NULL_OBJECT"); *1; return; } \
147: else if (FORTRANNULLOBJECT(a)) { a = PETSC_NULL; }
148:
149: /*
150: These are used to support the default viewers that are
151: created at run time, in C using the , trick.
153: The numbers here must match the numbers in include/finclude/petsc.h
154: */
155: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN -4
156: #define PETSC_VIEWER_DRAW_SELF_FORTRAN -5
157: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN -6
158: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN -7
159: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN -8
160: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN -9
161: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN -10
162: #define PETSC_VIEWER_STDERR_SELF_FORTRAN -11
163: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN -12
164: #define PETSC_VIEWER_BINARY_SELF_FORTRAN -13
165: #define PETSC_VIEWER_MATLAB_WORLD_FORTRAN -14
166: #define PETSC_VIEWER_MATLAB_SELF_FORTRAN -15
168: #define PetscPatchDefaultViewers_Fortran(vin,v) \
169: { \
170: if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { \
171: v = PETSC_VIEWER_DRAW_WORLD; \
172: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { \
173: v = PETSC_VIEWER_DRAW_SELF; \
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 if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { \
179: v = PETSC_VIEWER_STDOUT_WORLD; \
180: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { \
181: v = PETSC_VIEWER_STDOUT_SELF; \
182: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { \
183: v = PETSC_VIEWER_STDERR_WORLD; \
184: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { \
185: v = PETSC_VIEWER_STDERR_SELF; \
186: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { \
187: v = PETSC_VIEWER_BINARY_WORLD; \
188: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { \
189: v = PETSC_VIEWER_BINARY_SELF; \
190: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_WORLD_FORTRAN) { \
191: v = PETSC_VIEWER_BINARY_WORLD; \
192: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_MATLAB_SELF_FORTRAN) { \
193: v = PETSC_VIEWER_BINARY_SELF; \
194: } else { \
195: v = *vin; \
196: } \
197: }