Actual source code: f90_cwrap.c

  1: #include <petsc/private/ftnimpl.h>

  3: /*@
  4:    PetscMPIFortranDatatypeToC - Converts a `MPI_Fint` that contains a Fortran `MPI_Datatype` to its C `MPI_Datatype` equivalent

  6:    Not Collective, No Fortran Support

  8:    Input Parameter:
  9: .  unit - The Fortran `MPI_Datatype`

 11:    Output Parameter:
 12: .  dtype - the corresponding C `MPI_Datatype`

 14:    Level: developer

 16:    Developer Note:
 17:    The MPI documentation in multiple places says that one can never us
 18:    Fortran `MPI_Datatype`s in C (or vice-versa) but this is problematic since users could never
 19:    call C routines from Fortran that have `MPI_Datatype` arguments. Jed states that the Fortran
 20:    `MPI_Datatype`s will always be available in C if the MPI was built to support Fortran. This function
 21:    relies on this.

 23: .seealso: `MPI_Fint`, `MPI_Datatype`
 24: @*/
 25: PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint unit, MPI_Datatype *dtype)
 26: {
 27:   MPI_Datatype ftype;

 29:   PetscFunctionBegin;
 30:   ftype = MPI_Type_f2c(unit);
 31:   if (ftype == MPI_INTEGER || ftype == MPI_INT) *dtype = MPI_INT;
 32:   else if (ftype == MPI_INTEGER8 || ftype == MPIU_INT64) *dtype = MPIU_INT64;
 33:   else if (ftype == MPI_DOUBLE_PRECISION || ftype == MPI_DOUBLE) *dtype = MPI_DOUBLE;
 34:   else if (ftype == MPI_FLOAT) *dtype = MPI_FLOAT;
 35:   else if (ftype == MPI_C_BOOL) *dtype = MPI_C_BOOL;
 36: #if PetscDefined(HAVE_COMPLEX)
 37:   else if (ftype == MPI_COMPLEX16 || ftype == MPI_C_DOUBLE_COMPLEX) *dtype = MPI_C_DOUBLE_COMPLEX;
 38: #endif
 39: #if PetscDefined(HAVE_REAL___FLOAT128)
 40:   else if (ftype == MPIU___FLOAT128) *dtype = MPIU___FLOAT128;
 41: #endif
 42:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unknown Fortran MPI_Datatype");
 43:   PetscFunctionReturn(PETSC_SUCCESS);
 44: }

 46: /*************************************************************************/

 48: #if PetscDefined(HAVE_FORTRAN_CAPS)
 49:   #define f90array1dcreatescalar_      F90ARRAY1DCREATESCALAR
 50:   #define f90array1daccessscalar_      F90ARRAY1DACCESSSCALAR
 51:   #define f90array1ddestroyscalar_     F90ARRAY1DDESTROYSCALAR
 52:   #define f90array1dcreatereal_        F90ARRAY1DCREATEREAL
 53:   #define f90array1daccessreal_        F90ARRAY1DACCESSREAL
 54:   #define f90array1ddestroyreal_       F90ARRAY1DDESTROYREAL
 55:   #define f90array1dcreateint_         F90ARRAY1DCREATEINT
 56:   #define f90array1daccessint_         F90ARRAY1DACCESSINT
 57:   #define f90array1ddestroyint_        F90ARRAY1DDESTROYINT
 58:   #define f90array1dcreatebool_        F90ARRAY1DCREATEBOOL
 59:   #define f90array1daccessbool_        F90ARRAY1DACCESSBOOL
 60:   #define f90array1ddestroybool_       F90ARRAY1DDESTROYBOOL
 61:   #define f90array1dcreatempiint_      F90ARRAY1DCREATEMPIINT
 62:   #define f90array1daccessmpiint_      F90ARRAY1DACCESSMPIINT
 63:   #define f90array1ddestroympiint_     F90ARRAY1DDESTROYMPIINT
 64:   #define f90array1dcreatefortranaddr_ F90ARRAY1DCREATEFORTRANADDR
 65:   #define f90array1daccessfortranaddr_ F90ARRAY1DACCESSFORTRANADDR
 66: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
 67:   #define f90array1dcreatescalar_      f90array1dcreatescalar
 68:   #define f90array1daccessscalar_      f90array1daccessscalar
 69:   #define f90array1ddestroyscalar_     f90array1ddestroyscalar
 70:   #define f90array1dcreatereal_        f90array1dcreatereal
 71:   #define f90array1daccessreal_        f90array1daccessreal
 72:   #define f90array1ddestroyreal_       f90array1ddestroyreal
 73:   #define f90array1dcreateint_         f90array1dcreateint
 74:   #define f90array1daccessint_         f90array1daccessint
 75:   #define f90array1ddestroyint_        f90array1ddestroyint
 76:   #define f90array1dcreatebool_        f90array1dcreatebool
 77:   #define f90array1daccessbool_        f90array1daccessbool
 78:   #define f90array1ddestroybool_       f90array1ddestroybool
 79:   #define f90array1dcreatempiint_      f90array1dcreatempiint
 80:   #define f90array1daccessmpiint_      f90array1daccessmpiint
 81:   #define f90array1ddestroympiint_     f90array1ddestroympiint
 82:   #define f90array1dcreatefortranaddr_ f90array1dcreatefortranaddr
 83:   #define f90array1daccessfortranaddr_ f90array1daccessfortranaddr
 84: #endif

 86: PETSC_EXTERN void f90array1dcreatescalar_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 87: PETSC_EXTERN void f90array1daccessscalar_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 88: PETSC_EXTERN void f90array1ddestroyscalar_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 89: PETSC_EXTERN void f90array1dcreatereal_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 90: PETSC_EXTERN void f90array1daccessreal_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 91: PETSC_EXTERN void f90array1ddestroyreal_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 92: PETSC_EXTERN void f90array1dcreateint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 93: PETSC_EXTERN void f90array1daccessint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 94: PETSC_EXTERN void f90array1ddestroyint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 95: PETSC_EXTERN void f90array1dcreatebool_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 96: PETSC_EXTERN void f90array1daccessbool_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 97: PETSC_EXTERN void f90array1ddestroybool_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 98: PETSC_EXTERN void f90array1dcreatempiint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 99: PETSC_EXTERN void f90array1daccessmpiint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
100: PETSC_EXTERN void f90array1ddestroympiint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
101: PETSC_EXTERN void f90array1dcreatefortranaddr_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
102: PETSC_EXTERN void f90array1daccessfortranaddr_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);

104: /*@
105:    F90Array1dCreate - given a `F90Array1d` passed from Fortran associate with it a C array, its starting index and length

107:    Not Collective, No Fortran Support

109:    Input Parameters:
110: +  array - the C address pointer
111: .  type  - the MPI datatype of the array
112: .  start - the first index of the array
113: .  len   - the length of the array
114: .  ptr   - the `F90Array1d` passed from Fortran
115: -  ptrd   - an extra pointer passed by some Fortran compilers

117:    Level: developer

119:    Developer Notes:
120:    This is used in PETSc Fortran stubs that are used to pass C arrays to Fortran, for example `VecGetArray()`

122:    This doesn't actually create the `F90Array1d()`, it just associates a C pointer with it.

124:    There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

126: .seealso: `F90Array1d`, `F90Array1dAccess()`, `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
127: @*/
128: PetscErrorCode F90Array1dCreate(void *array, MPI_Datatype type, PetscInt start, PetscInt len, F90Array1d *ptr PETSC_F90_2PTR_PROTO(ptrd))
129: {
130:   PetscFunctionBegin;
131:   if (type == MPIU_SCALAR) {
132:     if (!len) array = PETSC_NULL_SCALAR_Fortran;
133:     f90array1dcreatescalar_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
134:   } else if (type == MPIU_REAL) {
135:     if (!len) array = PETSC_NULL_REAL_Fortran;
136:     f90array1dcreatereal_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
137:   } else if (type == MPIU_INT) {
138:     if (!len) array = PETSC_NULL_INTEGER_Fortran;
139:     f90array1dcreateint_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
140:   } else if (type == MPI_C_BOOL) {
141:     if (!len) array = PETSC_NULL_BOOL_Fortran;
142:     f90array1dcreatebool_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
143:   } else if (type == MPI_INT) {
144:     /* PETSC_NULL_MPIINT_Fortran is not needed since there is no PETSc APIs allowing NULL in place of 'PetscMPIInt *' arguments.
145:        At this line, we only need to assign 'array' a valid address when len is 0, thus PETSC_NULL_INTEGER_Fortran is enough.
146:     */
147:     if (!len) array = PETSC_NULL_INTEGER_Fortran;
148:     f90array1dcreatempiint_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
149:   } else if (type == MPIU_FORTRANADDR) {
150:     f90array1dcreatefortranaddr_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
151:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
152:   PetscFunctionReturn(PETSC_SUCCESS);
153: }

155: /*@
156:    F90Array1dAccess - given a `F90Array1d` passed from Fortran, accesses from it the associate C array that was provided with `F90Array1dCreate()`

158:    Not Collective, No Fortran Support

160:    Input Parameters:
161: +  ptr   - the `F90Array1d` passed from Fortran
162: .  type  - the MPI datatype of the array
163: -  ptrd   - an extra pointer passed by some Fortran compilers

165:    Output Parameter:
166: .  array - the C address pointer

168:    Level: developer

170:    Developer Note:
171:    This is used in PETSc Fortran stubs that access C arrays inside Fortran pointer arrays to Fortran. It is usually used in `XXXRestore()`` Fortran stubs.

173:    There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

175: .seealso: `F90Array1d`, `F90Array1dCreate()`, `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
176: @*/
177: PetscErrorCode F90Array1dAccess(F90Array1d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
178: {
179:   PetscFunctionBegin;
180:   if (type == MPIU_SCALAR) {
181:     f90array1daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
182:     if (*array == PETSC_NULL_SCALAR_Fortran) *array = NULL;
183:   } else if (type == MPIU_REAL) {
184:     f90array1daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
185:     if (*array == PETSC_NULL_REAL_Fortran) *array = NULL;
186:   } else if (type == MPIU_INT) {
187:     f90array1daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
188:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
189:   } else if (type == MPI_C_BOOL) {
190:     f90array1daccessbool_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
191:     if (*array == PETSC_NULL_BOOL_Fortran) *array = NULL;
192:   } else if (type == MPI_INT) {
193:     f90array1daccessmpiint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
194:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
195:   } else if (type == MPIU_FORTRANADDR) {
196:     f90array1daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
197:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
198:   PetscFunctionReturn(PETSC_SUCCESS);
199: }

201: /*@
202:    F90Array1dDestroy - given a `F90Array1d` passed from Fortran removes the C array associate with it with `F90Array1dCreate()`

204:    Not Collective, No Fortran Support

206:    Input Parameters:
207: +  ptr   - the `F90Array1d` passed from Fortran
208: .  type  - the MPI datatype of the array
209: -  ptrd   - an extra pointer passed by some Fortran compilers

211:    Level: developer

213:    Developer Notes:
214:    This is used in PETSc Fortran stubs that are used to end access to C arrays from Fortran, for example `VecRestoreArray()`

216:    This doesn't actually destroy the `F90Array1d()`, it just removes the associated C pointer from it.

218:    There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

220: .seealso: `F90Array1d`, `F90Array1dAccess()`, `F90Array1dCreate()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
221: @*/
222: PetscErrorCode F90Array1dDestroy(F90Array1d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
223: {
224:   PetscFunctionBegin;
225:   if (type == MPIU_SCALAR) {
226:     f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
227:   } else if (type == MPIU_REAL) {
228:     f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
229:   } else if (type == MPIU_INT) {
230:     f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
231:   } else if (type == MPI_C_BOOL) {
232:     f90array1ddestroybool_(ptr PETSC_F90_2PTR_PARAM(ptrd));
233:   } else if (type == MPI_INT) {
234:     f90array1ddestroympiint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
235:   } else if (type == MPIU_FORTRANADDR) {
236:     f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
237:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
238:   *(void **)ptr = (void *)1;
239:   PetscFunctionReturn(PETSC_SUCCESS);
240: }

242: /*MC
243:    F90Array1d - a PETSc C representation of a Fortran `XXX, pointer :: array(:)` object

245:    Not Collective, No Fortran Support

247:    Level: developer

249:    Developer Notes:
250:    This is used in PETSc Fortran stubs that are used to control access to C arrays from Fortran, for example `VecGetArray()`

252:    PETSc does not require any information about the format of this object, all operations on the object are performed by calling Fortran routines.

254:    There are equivalent objects for 2, 3, and 4 dimensional Fortran arrays.

256: .seealso: `F90Array1dAccess()`, `F90Array1dCreate()`, , `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
257: M*/

259: #if PetscDefined(HAVE_FORTRAN_CAPS)
260:   #define f90array2dcreatescalar_       F90ARRAY2DCREATESCALAR
261:   #define f90array2daccessscalar_       F90ARRAY2DACCESSSCALAR
262:   #define f90array2ddestroyscalar_      F90ARRAY2DDESTROYSCALAR
263:   #define f90array2dcreatereal_         F90ARRAY2DCREATEREAL
264:   #define f90array2daccessreal_         F90ARRAY2DACCESSREAL
265:   #define f90array2ddestroyreal_        F90ARRAY2DDESTROYREAL
266:   #define f90array2dcreateint_          F90ARRAY2DCREATEINT
267:   #define f90array2daccessint_          F90ARRAY2DACCESSINT
268:   #define f90array2ddestroyint_         F90ARRAY2DDESTROYINT
269:   #define f90array2dcreatebool_         F90ARRAY2DCREATEBOOL
270:   #define f90array2daccessbool_         F90ARRAY2DACCESSBOOL
271:   #define f90array2ddestroybool_        F90ARRAY2DDESTROYBOOL
272:   #define f90array2dcreatefortranaddr_  F90ARRAY2DCREATEFORTRANADDR
273:   #define f90array2daccessfortranaddr_  F90ARRAY2DACCESSFORTRANADDR
274:   #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
275: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
276:   #define f90array2dcreatescalar_       f90array2dcreatescalar
277:   #define f90array2daccessscalar_       f90array2daccessscalar
278:   #define f90array2ddestroyscalar_      f90array2ddestroyscalar
279:   #define f90array2dcreatereal_         f90array2dcreatereal
280:   #define f90array2daccessreal_         f90array2daccessreal
281:   #define f90array2ddestroyreal_        f90array2ddestroyreal
282:   #define f90array2dcreateint_          f90array2dcreateint
283:   #define f90array2daccessint_          f90array2daccessint
284:   #define f90array2ddestroyint_         f90array2ddestroyint
285:   #define f90array2dcreatebool_         f90array2dcreatebool
286:   #define f90array2daccessbool_         f90array2daccessbool
287:   #define f90array2ddestroybool_        f90array2ddestroybool
288:   #define f90array2dcreatefortranaddr_  f90array2dcreatefortranaddr
289:   #define f90array2daccessfortranaddr_  f90array2daccessfortranaddr
290:   #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
291: #endif

293: PETSC_EXTERN void f90array2dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
294: PETSC_EXTERN void f90array2daccessscalar_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
295: PETSC_EXTERN void f90array2ddestroyscalar_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
296: PETSC_EXTERN void f90array2dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
297: PETSC_EXTERN void f90array2daccessreal_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
298: PETSC_EXTERN void f90array2ddestroyreal_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
299: PETSC_EXTERN void f90array2dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
300: PETSC_EXTERN void f90array2daccessint_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
301: PETSC_EXTERN void f90array2ddestroyint_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
302: PETSC_EXTERN void f90array2dcreatebool_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
303: PETSC_EXTERN void f90array2daccessbool_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
304: PETSC_EXTERN void f90array2ddestroybool_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
305: PETSC_EXTERN void f90array2dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
306: PETSC_EXTERN void f90array2daccessfortranaddr_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
307: PETSC_EXTERN void f90array2ddestroyfortranaddr_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

309: PetscErrorCode F90Array2dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
310: {
311:   PetscFunctionBegin;
312:   if (type == MPIU_SCALAR) {
313:     f90array2dcreatescalar_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
314:   } else if (type == MPIU_REAL) {
315:     f90array2dcreatereal_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
316:   } else if (type == MPIU_INT) {
317:     f90array2dcreateint_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
318:   } else if (type == MPI_C_BOOL) {
319:     f90array2dcreatebool_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
320:   } else if (type == MPIU_FORTRANADDR) {
321:     f90array2dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
322:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
323:   PetscFunctionReturn(PETSC_SUCCESS);
324: }

326: PetscErrorCode F90Array2dAccess(F90Array2d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
327: {
328:   PetscFunctionBegin;
329:   if (type == MPIU_SCALAR) {
330:     f90array2daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
331:   } else if (type == MPIU_REAL) {
332:     f90array2daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
333:   } else if (type == MPIU_INT) {
334:     f90array2daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
335:   } else if (type == MPI_C_BOOL) {
336:     f90array2daccessbool_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
337:   } else if (type == MPIU_FORTRANADDR) {
338:     f90array2daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
339:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
340:   PetscFunctionReturn(PETSC_SUCCESS);
341: }

343: PetscErrorCode F90Array2dDestroy(F90Array2d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
344: {
345:   PetscFunctionBegin;
346:   if (type == MPIU_SCALAR) {
347:     f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
348:   } else if (type == MPIU_REAL) {
349:     f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
350:   } else if (type == MPIU_INT) {
351:     f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
352:   } else if (type == MPI_C_BOOL) {
353:     f90array2ddestroybool_(ptr PETSC_F90_2PTR_PARAM(ptrd));
354:   } else if (type == MPIU_FORTRANADDR) {
355:     f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
356:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
357:   PetscFunctionReturn(PETSC_SUCCESS);
358: }

360: #if PetscDefined(HAVE_FORTRAN_CAPS)
361:   #define f90array3dcreatescalar_       F90ARRAY3DCREATESCALAR
362:   #define f90array3daccessscalar_       F90ARRAY3DACCESSSCALAR
363:   #define f90array3ddestroyscalar_      F90ARRAY3DDESTROYSCALAR
364:   #define f90array3dcreatereal_         F90ARRAY3DCREATEREAL
365:   #define f90array3daccessreal_         F90ARRAY3DACCESSREAL
366:   #define f90array3ddestroyreal_        F90ARRAY3DDESTROYREAL
367:   #define f90array3dcreateint_          F90ARRAY3DCREATEINT
368:   #define f90array3daccessint_          F90ARRAY3DACCESSINT
369:   #define f90array3ddestroyint_         F90ARRAY3DDESTROYINT
370:   #define f90array3dcreatebool_         F90ARRAY3DCREATEBOOL
371:   #define f90array3daccessbool_         F90ARRAY3DACCESSBOOL
372:   #define f90array3ddestroybool_        F90ARRAY3DDESTROYBOOL
373:   #define f90array3dcreatefortranaddr_  F90ARRAY3DCREATEFORTRANADDR
374:   #define f90array3daccessfortranaddr_  F90ARRAY3DACCESSFORTRANADDR
375:   #define f90array3ddestroyfortranaddr_ F90ARRAY3DDESTROYFORTRANADDR
376: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
377:   #define f90array3dcreatescalar_       f90array3dcreatescalar
378:   #define f90array3daccessscalar_       f90array3daccessscalar
379:   #define f90array3ddestroyscalar_      f90array3ddestroyscalar
380:   #define f90array3dcreatereal_         f90array3dcreatereal
381:   #define f90array3daccessreal_         f90array3daccessreal
382:   #define f90array3ddestroyreal_        f90array3ddestroyreal
383:   #define f90array3dcreateint_          f90array3dcreateint
384:   #define f90array3daccessint_          f90array3daccessint
385:   #define f90array3ddestroyint_         f90array3ddestroyint
386:   #define f90array3dcreatebool_         f90array3dcreatebool
387:   #define f90array3daccessbool_         f90array3daccessbool
388:   #define f90array3ddestroybool_        f90array3ddestroybool
389:   #define f90array3dcreatefortranaddr_  f90array3dcreatefortranaddr
390:   #define f90array3daccessfortranaddr_  f90array3daccessfortranaddr
391:   #define f90array3ddestroyfortranaddr_ f90array3ddestroyfortranaddr
392: #endif

394: PETSC_EXTERN void f90array3dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
395: PETSC_EXTERN void f90array3daccessscalar_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
396: PETSC_EXTERN void f90array3ddestroyscalar_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
397: PETSC_EXTERN void f90array3dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
398: PETSC_EXTERN void f90array3daccessreal_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
399: PETSC_EXTERN void f90array3ddestroyreal_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
400: PETSC_EXTERN void f90array3dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
401: PETSC_EXTERN void f90array3daccessint_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
402: PETSC_EXTERN void f90array3ddestroyint_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
403: PETSC_EXTERN void f90array3dcreatebool_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
404: PETSC_EXTERN void f90array3daccessbool_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
405: PETSC_EXTERN void f90array3ddestroybool_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
406: PETSC_EXTERN void f90array3dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
407: PETSC_EXTERN void f90array3daccessfortranaddr_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
408: PETSC_EXTERN void f90array3ddestroyfortranaddr_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

410: PetscErrorCode F90Array3dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, PetscInt start3, PetscInt len3, F90Array3d *ptr PETSC_F90_2PTR_PROTO(ptrd))
411: {
412:   PetscFunctionBegin;
413:   if (type == MPIU_SCALAR) {
414:     f90array3dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
415:   } else if (type == MPIU_REAL) {
416:     f90array3dcreatereal_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
417:   } else if (type == MPIU_INT) {
418:     f90array3dcreateint_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
419:   } else if (type == MPI_C_BOOL) {
420:     f90array3dcreatebool_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
421:   } else if (type == MPIU_FORTRANADDR) {
422:     f90array3dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
423:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
424:   PetscFunctionReturn(PETSC_SUCCESS);
425: }

427: PetscErrorCode F90Array3dAccess(F90Array3d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
428: {
429:   PetscFunctionBegin;
430:   if (type == MPIU_SCALAR) {
431:     f90array3daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
432:   } else if (type == MPIU_REAL) {
433:     f90array3daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
434:   } else if (type == MPIU_INT) {
435:     f90array3daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
436:   } else if (type == MPI_C_BOOL) {
437:     f90array3daccessbool_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
438:   } else if (type == MPIU_FORTRANADDR) {
439:     f90array3daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
440:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
441:   PetscFunctionReturn(PETSC_SUCCESS);
442: }

444: PetscErrorCode F90Array3dDestroy(F90Array3d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
445: {
446:   PetscFunctionBegin;
447:   if (type == MPIU_SCALAR) {
448:     f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
449:   } else if (type == MPIU_REAL) {
450:     f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
451:   } else if (type == MPIU_INT) {
452:     f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
453:   } else if (type == MPI_C_BOOL) {
454:     f90array3ddestroybool_(ptr PETSC_F90_2PTR_PARAM(ptrd));
455:   } else if (type == MPIU_FORTRANADDR) {
456:     f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
457:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
458:   PetscFunctionReturn(PETSC_SUCCESS);
459: }

461: #if PetscDefined(HAVE_FORTRAN_CAPS)
462:   #define f90array4dcreatescalar_       F90ARRAY4DCREATESCALAR
463:   #define f90array4daccessscalar_       F90ARRAY4DACCESSSCALAR
464:   #define f90array4ddestroyscalar_      F90ARRAY4DDESTROYSCALAR
465:   #define f90array4dcreatereal_         F90ARRAY4DCREATEREAL
466:   #define f90array4daccessreal_         F90ARRAY4DACCESSREAL
467:   #define f90array4ddestroyreal_        F90ARRAY4DDESTROYREAL
468:   #define f90array4dcreateint_          F90ARRAY4DCREATEINT
469:   #define f90array4daccessint_          F90ARRAY4DACCESSINT
470:   #define f90array4ddestroyint_         F90ARRAY4DDESTROYINT
471:   #define f90array4dcreatebool_         F90ARRAY4DCREATEBOOL
472:   #define f90array4daccessbool_         F90ARRAY4DACCESSBOOL
473:   #define f90array4ddestroybool_        F90ARRAY4DDESTROYBOOL
474:   #define f90array4dcreatefortranaddr_  F90ARRAY4DCREATEFORTRANADDR
475:   #define f90array4daccessfortranaddr_  F90ARRAY4DACCESSFORTRANADDR
476:   #define f90array4ddestroyfortranaddr_ F90ARRAY4DDESTROYFORTRANADDR
477: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
478:   #define f90array4dcreatescalar_       f90array4dcreatescalar
479:   #define f90array4daccessscalar_       f90array4daccessscalar
480:   #define f90array4ddestroyscalar_      f90array4ddestroyscalar
481:   #define f90array4dcreatereal_         f90array4dcreatereal
482:   #define f90array4daccessreal_         f90array4daccessreal
483:   #define f90array4ddestroyreal_        f90array4ddestroyreal
484:   #define f90array4dcreateint_          f90array4dcreateint
485:   #define f90array4daccessint_          f90array4daccessint
486:   #define f90array4ddestroyint_         f90array4ddestroyint
487:   #define f90array4dcreatebool_         f90array4dcreatebool
488:   #define f90array4daccessbool_         f90array4daccessbool
489:   #define f90array4ddestroybool_        f90array4ddestroybool
490:   #define f90array4dcreatefortranaddr_  f90array4dcreatefortranaddr
491:   #define f90array4daccessfortranaddr_  f90array4daccessfortranaddr
492:   #define f90array4ddestroyfortranaddr_ f90array4ddestroyfortranaddr
493: #endif

495: PETSC_EXTERN void f90array4dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
496: PETSC_EXTERN void f90array4daccessscalar_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
497: PETSC_EXTERN void f90array4ddestroyscalar_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
498: PETSC_EXTERN void f90array4dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
499: PETSC_EXTERN void f90array4daccessreal_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
500: PETSC_EXTERN void f90array4ddestroyreal_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
501: PETSC_EXTERN void f90array4dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
502: PETSC_EXTERN void f90array4daccessint_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
503: PETSC_EXTERN void f90array4ddestroyint_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
504: PETSC_EXTERN void f90array4dcreatebool_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
505: PETSC_EXTERN void f90array4daccessbool_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
506: PETSC_EXTERN void f90array4ddestroybool_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
507: PETSC_EXTERN void f90array4dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
508: PETSC_EXTERN void f90array4daccessfortranaddr_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
509: PETSC_EXTERN void f90array4ddestroyfortranaddr_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

511: PetscErrorCode F90Array4dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, PetscInt start3, PetscInt len3, PetscInt start4, PetscInt len4, F90Array4d *ptr PETSC_F90_2PTR_PROTO(ptrd))
512: {
513:   PetscFunctionBegin;
514:   PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
515:   f90array4dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, &start4, &len4, ptr PETSC_F90_2PTR_PARAM(ptrd));
516:   PetscFunctionReturn(PETSC_SUCCESS);
517: }

519: PetscErrorCode F90Array4dAccess(F90Array4d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
520: {
521:   PetscFunctionBegin;
522:   if (type == MPIU_SCALAR) {
523:     f90array4daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
524:   } else if (type == MPIU_REAL) {
525:     f90array4daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
526:   } else if (type == MPIU_INT) {
527:     f90array4daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
528:   } else if (type == MPI_C_BOOL) {
529:     f90array4daccessbool_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
530:   } else if (type == MPIU_FORTRANADDR) {
531:     f90array4daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
532:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
533:   PetscFunctionReturn(PETSC_SUCCESS);
534: }

536: PetscErrorCode F90Array4dDestroy(F90Array4d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
537: {
538:   PetscFunctionBegin;
539:   PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
540:   f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
541:   PetscFunctionReturn(PETSC_SUCCESS);
542: }

544: #if PetscDefined(HAVE_FORTRAN_CAPS)
545:   #define f90array1dgetaddrscalar_      F90ARRAY1DGETADDRSCALAR
546:   #define f90array1dgetaddrreal_        F90ARRAY1DGETADDRREAL
547:   #define f90array1dgetaddrint_         F90ARRAY1DGETADDRINT
548:   #define f90array1dgetaddrbool_        F90ARRAY1DGETADDRBOOL
549:   #define f90array1dgetaddrmpiint_      F90ARRAY1DGETADDRMPIINT
550:   #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
551:   #define f90array1dgetdescriptor_      F90ARRAY1DGETDESCRIPTOR
552: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
553:   #define f90array1dgetaddrscalar_      f90array1dgetaddrscalar
554:   #define f90array1dgetaddrreal_        f90array1dgetaddrreal
555:   #define f90array1dgetaddrint_         f90array1dgetaddrint
556:   #define f90array1dgetaddrbool_        f90array1dgetaddrbool
557:   #define f90array1dgetaddrmpiint_      f90array1dgetaddrmpiint
558:   #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
559:   #define f90array1dgetdescriptor_      f90array1dgetdescriptor
560: #endif

562: PETSC_EXTERN void f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
563: {
564:   *address = (PetscFortranAddr)array;
565: }
566: PETSC_EXTERN void f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
567: {
568:   *address = (PetscFortranAddr)array;
569: }
570: PETSC_EXTERN void f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
571: {
572:   *address = (PetscFortranAddr)array;
573: }
574: PETSC_EXTERN void f90array1dgetaddrbool_(void *array, PetscFortranAddr *address)
575: {
576:   *address = (PetscFortranAddr)array;
577: }
578: PETSC_EXTERN void f90array1dgetaddrmpiint_(void *array, PetscFortranAddr *address)
579: {
580:   *address = (PetscFortranAddr)array;
581: }
582: PETSC_EXTERN void f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
583: {
584:   *address = (PetscFortranAddr)array;
585: }
586: PETSC_EXTERN void f90array1dgetdescriptor_(F90Array1d *array, void **address PETSC_F90_2PTR_PROTO(ptrd))
587: {
588:   *address = array;
589: }

591: #if PetscDefined(HAVE_FORTRAN_CAPS)
592:   #define f90array2dgetaddrscalar_      F90ARRAY2DGETADDRSCALAR
593:   #define f90array2dgetaddrreal_        F90ARRAY2DGETADDRREAL
594:   #define f90array2dgetaddrint_         F90ARRAY2DGETADDRINT
595:   #define f90array2dgetaddrbool_        F90ARRAY2DGETADDRBOOL
596:   #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
597: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
598:   #define f90array2dgetaddrscalar_      f90array2dgetaddrscalar
599:   #define f90array2dgetaddrreal_        f90array2dgetaddrreal
600:   #define f90array2dgetaddrint_         f90array2dgetaddrint
601:   #define f90array2dgetaddrbool_        f90array2dgetaddrbool
602:   #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
603: #endif

605: PETSC_EXTERN void f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
606: {
607:   *address = (PetscFortranAddr)array;
608: }
609: PETSC_EXTERN void f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
610: {
611:   *address = (PetscFortranAddr)array;
612: }
613: PETSC_EXTERN void f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
614: {
615:   *address = (PetscFortranAddr)array;
616: }
617: PETSC_EXTERN void f90array2dgetaddrbool_(void *array, PetscFortranAddr *address)
618: {
619:   *address = (PetscFortranAddr)array;
620: }
621: PETSC_EXTERN void f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
622: {
623:   *address = (PetscFortranAddr)array;
624: }

626: #if PetscDefined(HAVE_FORTRAN_CAPS)
627:   #define f90array3dgetaddrscalar_      F90ARRAY3DGETADDRSCALAR
628:   #define f90array3dgetaddrreal_        F90ARRAY3DGETADDRREAL
629:   #define f90array3dgetaddrint_         F90ARRAY3DGETADDRINT
630:   #define f90array3dgetaddrbool_        F90ARRAY3DGETADDRBOOL
631:   #define f90array3dgetaddrfortranaddr_ F90ARRAY3DGETADDRFORTRANADDR
632: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
633:   #define f90array3dgetaddrscalar_      f90array3dgetaddrscalar
634:   #define f90array3dgetaddrreal_        f90array3dgetaddrreal
635:   #define f90array3dgetaddrint_         f90array3dgetaddrint
636:   #define f90array3dgetaddrbool_        f90array3dgetaddrbool
637:   #define f90array3dgetaddrfortranaddr_ f90array3dgetaddrfortranaddr
638: #endif

640: PETSC_EXTERN void f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
641: {
642:   *address = (PetscFortranAddr)array;
643: }
644: PETSC_EXTERN void f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
645: {
646:   *address = (PetscFortranAddr)array;
647: }
648: PETSC_EXTERN void f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
649: {
650:   *address = (PetscFortranAddr)array;
651: }
652: PETSC_EXTERN void f90array3dgetaddrbool_(void *array, PetscFortranAddr *address)
653: {
654:   *address = (PetscFortranAddr)array;
655: }
656: PETSC_EXTERN void f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
657: {
658:   *address = (PetscFortranAddr)array;
659: }

661: #if PetscDefined(HAVE_FORTRAN_CAPS)
662:   #define f90array4dgetaddrscalar_      F90ARRAY4DGETADDRSCALAR
663:   #define f90array4dgetaddrreal_        F90ARRAY4DGETADDRREAL
664:   #define f90array4dgetaddrint_         F90ARRAY4DGETADDRINT
665:   #define f90array4dgetaddrbool_        F90ARRAY4DGETADDRBOOL
666:   #define f90array4dgetaddrfortranaddr_ F90ARRAY4DGETADDRFORTRANADDR
667: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
668:   #define f90array4dgetaddrscalar_      f90array4dgetaddrscalar
669:   #define f90array4dgetaddrreal_        f90array4dgetaddrreal
670:   #define f90array4dgetaddrint_         f90array4dgetaddrint
671:   #define f90array4dgetaddrbool_        f90array4dgetaddrbool
672:   #define f90array4dgetaddrfortranaddr_ f90array4dgetaddrfortranaddr
673: #endif

675: PETSC_EXTERN void f90array4dgetaddrscalar_(void *array, PetscFortranAddr *address)
676: {
677:   *address = (PetscFortranAddr)array;
678: }
679: PETSC_EXTERN void f90array4dgetaddrreal_(void *array, PetscFortranAddr *address)
680: {
681:   *address = (PetscFortranAddr)array;
682: }
683: PETSC_EXTERN void f90array4dgetaddrint_(void *array, PetscFortranAddr *address)
684: {
685:   *address = (PetscFortranAddr)array;
686: }
687: PETSC_EXTERN void f90array4dgetaddrbool_(void *array, PetscFortranAddr *address)
688: {
689:   *address = (PetscFortranAddr)array;
690: }
691: PETSC_EXTERN void f90array4dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
692: {
693:   *address = (PetscFortranAddr)array;
694: }