Actual source code: zpetsc.h
1: /*$Id: zpetsc.h,v 1.67 2001/09/10 03:41:06 bsmith Exp $*/
3: /* This file contains info for the use of PETSc Fortran interface stubs */
5: #include petsc.h
6: #include "petscfix.h"
8: EXTERN int PetscScalarAddressToFortran(PetscObject,PetscScalar*,PetscScalar*,int,long*);
9: EXTERN int PetscScalarAddressFromFortran(PetscObject,PetscScalar*,long,int,PetscScalar **);
10: EXTERN long PetscIntAddressToFortran(int*,int*);
11: EXTERN int *PetscIntAddressFromFortran(int*,long);
12: extern char *PETSC_NULL_CHARACTER_Fortran;
13: extern void *PETSC_NULL_INTEGER_Fortran;
14: extern void *PETSC_NULL_Fortran;
15: extern void *PETSC_NULL_SCALAR_Fortran;
16: extern void *PETSC_NULL_DOUBLE_Fortran;
17: extern void *PETSC_NULL_REAL_Fortran;
18: EXTERN_C_BEGIN
19: extern void (*PETSC_NULL_FUNCTION_Fortran)(void);
20: EXTERN_C_END
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_USE_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);
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) PetscFree(b);
97: #endif
99: #define FORTRANNULL(a) (((void*)a) == PETSC_NULL_Fortran)
100: #define FORTRANNULLINTEGER(a) (((void*)a) == PETSC_NULL_INTEGER_Fortran)
101: #define FORTRANNULLSCALAR(a) (((void*)a) == PETSC_NULL_SCALAR_Fortran)
102: #define FORTRANNULLDOUBLE(a) (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
103: #define FORTRANNULLREAL(a) (((void*)a) == PETSC_NULL_REAL_Fortran)
105: #define FORTRANNULLOBJECT FORTRANNULLINTEGER
107: #define FORTRANNULLFUNCTION(a) (((void(*)(void))a) == PETSC_NULL_FUNCTION_Fortran)
111: #define CHKFORTRANNULLINTEGER(a)
112: if (FORTRANNULL(a) || FORTRANNULLSCALAR(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a)) {
113: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1,
114: "Use PETSC_NULL_INTEGER or PETSC_NULL_OBJECT"); *1; return; }
115: else if (FORTRANNULLINTEGER(a)) { a = PETSC_NULL; }
117: #define CHKFORTRANNULLSCALAR(a)
118: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLREAL(a)) {
119: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1,
120: "Use PETSC_NULL_SCALAR"); *1; return; }
121: else if (FORTRANNULLSCALAR(a)) { a = PETSC_NULL; }
123: #define CHKFORTRANNULLDOUBLE(a)
124: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLSCALAR(a) || FORTRANNULLREAL(a)) {
125: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1,
126: "Use PETSC_NULL_DOUBLE"); *1; return; }
127: else if (FORTRANNULLDOUBLE(a)) { a = PETSC_NULL; }
129: #define CHKFORTRANNULLREAL(a)
130: if (FORTRANNULL(a) || FORTRANNULLINTEGER(a) || FORTRANNULLDOUBLE(a) || FORTRANNULLSCALAR(a)) {
131: PetscError(__LINE__,"fortran_interface_unknown_file",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,1,
132: "Use PETSC_NULL_REAL"); *1; return; }
133: else if (FORTRANNULLREAL(a)) { a = PETSC_NULL; }
134:
135: #define CHKFORTRANNULLOBJECT CHKFORTRANNULLINTEGER
138: /*
139: These are used to support the default viewers that are
140: created at run time, in C using the , trick.
142: The numbers here must match the numbers in include/finclude/petsc.h
143: */
144: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN -4
145: #define PETSC_VIEWER_DRAW_SELF_FORTRAN -5
146: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN -6
147: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN -7
148: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN -8
149: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN -9
150: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN -10
151: #define PETSC_VIEWER_STDERR_SELF_FORTRAN -11
152: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN -12
153: #define PETSC_VIEWER_BINARY_SELF_FORTRAN -13
155: #define PetscPatchDefaultViewers_Fortran(vin,v)
156: {
157: if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) {
158: v = PETSC_VIEWER_DRAW_WORLD;
159: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) {
160: v = PETSC_VIEWER_DRAW_SELF;
161: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) {
162: v = PETSC_VIEWER_SOCKET_WORLD;
163: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) {
164: v = PETSC_VIEWER_SOCKET_SELF;
165: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) {
166: v = PETSC_VIEWER_STDOUT_WORLD;
167: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) {
168: v = PETSC_VIEWER_STDOUT_SELF;
169: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) {
170: v = PETSC_VIEWER_STDERR_WORLD;
171: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) {
172: v = PETSC_VIEWER_STDERR_SELF;
173: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) {
174: v = PETSC_VIEWER_BINARY_WORLD;
175: } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) {
176: v = PETSC_VIEWER_BINARY_SELF;
177: } else {
178: v = *vin;
179: }
180: }