Actual source code: zpetsc.h

  1: /*$Id: zpetsc.h,v 1.61 2001/04/10 22:37:42 balay 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,Scalar*,Scalar*,int,long*);
  9: EXTERN int     PetscScalarAddressFromFortran(PetscObject,Scalar*,long,int,Scalar **);
 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_SCALAR_Fortran;
 15: extern void   *PETSC_NULL_DOUBLE_Fortran;
 16: EXTERN_C_BEGIN
 17: extern void   (*PETSC_NULL_FUNCTION_Fortran)();
 18: EXTERN_C_END
 19: /*  ----------------------------------------------------------------------*/
 20: /*
 21:    We store each PETSc object C pointer directly as a
 22:    Fortran integer*4 or *8 depending on the size of pointers.
 23: */
 24: #define PetscFInt long

 26: #define PetscToPointer(a)     (*(long *)(a))
 27: #define PetscFromPointer(a)        (long)(a)
 28: #define PetscRmPointer(a)

 30: /*  ----------------------------------------------------------------------*/
 31: /*

 33:    Some MPI implementations use the same representation of MPI_Comm in C and 
 34: Fortran. 

 36:    MPICH
 37:      -For 32 bit machines there is no conversion between C and Fortran
 38:      -For 64 bit machines
 39:          = Before version 1.1 conversion with MPIR_xxx()
 40:          = Version 1.1 and later no conversion

 42:    Cray T3E/T3D 
 43:      No conversion

 45:    SGI
 46:      No conversion

 48:    HP-Convex
 49:      - Before release 1.3 MPI_*_F2C() and MPI_*_C2F()
 50:      - Release 1.3 and later MPI_*_f2c() and MPI_*_c2f()

 52:    MPI-2 standard
 53:      - MPI_*_f2c() and MPI_*_c2f()

 55:    LAM 6.1
 56:      - Upgrate to LAM 6.2

 58:   LAM 6.2
 59:      - MPI_*_f2c() and MPI_*_c2f()

 61:    We define the macros
 62:      PetscToPointerComm - from Fortran to C
 63:      PetscFromPointerComm - From C to Fortran

 65: */
 66: #if defined(PETSC_HAVE_INT_MPI_COMM)
 67: #define PetscToPointerComm(a)        (a)
 68: #define PetscFromPointerComm(a) (int)(a)

 70: #elif defined (PETSC_HAVE_MPI_COMM_F2C)
 71: #define PetscToPointerComm(a)        MPI_Comm_f2c(*(MPI_Fint *)(&a))
 72: #define PetscFromPointerComm(a)      MPI_Comm_c2f(a)

 74: #elif (PETSC_SIZEOF_VOIDP == 8)
 75: #error "Use Either of the following flags in the variable MPI_INCLUDE in base.site file: 
 76: -DPETSC_HAVE_INT_MPI_COMM, -DPETSC_HAVE_MPI_COMM_F2C"

 78: #else
 79: #define PetscToPointerComm(a)        (a)
 80: #define PetscFromPointerComm(a) (int)(a)
 81: #endif


 84: /* --------------------------------------------------------------------*/
 85: /*
 86:     This lets us map the str-len argument either, immediately following
 87:     the char argument (DVF on Win32) or at the end of the argument list
 88:     (general unix compilers)
 89: */
 90: #if defined(PETSC_USE_FORTRAN_MIXED_STR_ARG)
 91: #define PETSC_MIXED_LEN(len) ,int len
 92: #define PETSC_END_LEN(len)
 93: #else
 94: #define PETSC_MIXED_LEN(len)
 95: #define PETSC_END_LEN(len)   ,int len
 96: #endif

 98: /* --------------------------------------------------------------------*/
 99: /*
100:     This defines the mappings from Fortran charactor strings 
101:   to C charactor strings on the Cray T3D.
102: */
103: #if defined(PETSC_USES_CPTOFCD)
104: #include <fortran.h>

106: #define CHAR _fcd
107: #define FIXCHAR(a,n,b) 
108: { 
109:   b = _fcdtocp(a); 
110:   n = _fcdlen (a); 
111:   if (b == PETSC_NULL_CHARACTER_Fortran) { 
112:       b = 0; 
113:   } else {  
114:     while((n > 0) && (b[n-1] == ' ')) n--; 
115:     *PetscMalloc((n+1)*sizeof(char),&b); 
116:     if(*ierr) return; 
117:     *PetscStrncpy(b,_fcdtocp(a),n); 
118:     if(*ierr) return; 
119:     b[n] = 0; 
120:   } 
121: }
122: #define FREECHAR(a,b) if (b) PetscFree(b);

124: #else

126: #define CHAR char*
127: #define FIXCHAR(a,n,b) 
128: {
129:   if (a == PETSC_NULL_CHARACTER_Fortran) { 
130:     b = a = 0; 
131:   } else { 
132:     while((n > 0) && (a[n-1] == ' ')) n--; 
133:     if (a[n] != 0) { 
134:       *PetscMalloc((n+1)*sizeof(char),&b); 
135:       if(*ierr) return; 
136:       *PetscStrncpy(b,a,n); 
137:       if(*ierr) return; 
138:       b[n] = 0; 
139:     } else b = a;
140:   } 
141: }

143: #define FREECHAR(a,b) if (a != b) PetscFree(b);

145: #endif



149: #define FORTRANNULLINTEGER(a)  (((void*)a) == PETSC_NULL_INTEGER_Fortran)
150: #define FORTRANNULLOBJECT(a)   (((void*)a) == PETSC_NULL_INTEGER_Fortran)
151: #define FORTRANNULLSCALAR(a)   (((void*)a) == PETSC_NULL_SCALAR_Fortran)
152: #define FORTRANNULLDOUBLE(a)   (((void*)a) == PETSC_NULL_DOUBLE_Fortran)
153: #define FORTRANNULLFUNCTION(a) (((void(*)())a) == PETSC_NULL_FUNCTION_Fortran)
154: /*
155:     These are used to support the default viewers that are 
156:   created at run time, in C using the , trick.

158:     The numbers here must match the numbers in include/finclude/petsc.h
159: */
160: #define PETSC_VIEWER_DRAW_WORLD_FORTRAN     -4
161: #define PETSC_VIEWER_DRAW_SELF_FORTRAN      -5
162: #define PETSC_VIEWER_SOCKET_WORLD_FORTRAN   -6 
163: #define PETSC_VIEWER_SOCKET_SELF_FORTRAN    -7
164: #define PETSC_VIEWER_STDOUT_WORLD_FORTRAN   -8 
165: #define PETSC_VIEWER_STDOUT_SELF_FORTRAN    -9
166: #define PETSC_VIEWER_STDERR_WORLD_FORTRAN   -10 
167: #define PETSC_VIEWER_STDERR_SELF_FORTRAN    -11
168: #define PETSC_VIEWER_BINARY_WORLD_FORTRAN   -12
169: #define PETSC_VIEWER_BINARY_SELF_FORTRAN    -13

171: #define PetscPatchDefaultViewers_Fortran(vin,v) 
172: { 
173:     if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_WORLD_FORTRAN) { 
174:       v = PETSC_VIEWER_DRAW_WORLD; 
175:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_DRAW_SELF_FORTRAN) { 
176:       v = PETSC_VIEWER_DRAW_SELF; 
177:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_WORLD_FORTRAN) { 
178:       v = PETSC_VIEWER_SOCKET_WORLD; 
179:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_SOCKET_SELF_FORTRAN) { 
180:       v = PETSC_VIEWER_SOCKET_SELF; 
181:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_WORLD_FORTRAN) { 
182:       v = PETSC_VIEWER_STDOUT_WORLD; 
183:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDOUT_SELF_FORTRAN) { 
184:       v = PETSC_VIEWER_STDOUT_SELF; 
185:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_WORLD_FORTRAN) { 
186:       v = PETSC_VIEWER_STDERR_WORLD; 
187:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_STDERR_SELF_FORTRAN) { 
188:       v = PETSC_VIEWER_STDERR_SELF; 
189:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_WORLD_FORTRAN) { 
190:       v = PETSC_VIEWER_BINARY_WORLD; 
191:     } else if ((*(PetscFortranAddr*)vin) == PETSC_VIEWER_BINARY_SELF_FORTRAN) { 
192:       v = PETSC_VIEWER_BINARY_SELF; 
193:     } else { 
194:       v = *vin; 
195:     } 
196: }