Actual source code: f90_cwrap.c

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

  3: /*@C
  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: #if defined(PETSC_HAVE_COMPLEX)
 36:   else if (ftype == MPI_COMPLEX16 || ftype == MPI_C_DOUBLE_COMPLEX) *dtype = MPI_C_DOUBLE_COMPLEX;
 37: #endif
 38: #if defined(PETSC_HAVE_REAL___FLOAT128)
 39:   else if (ftype == MPIU___FLOAT128) *dtype = MPIU___FLOAT128;
 40: #endif
 41:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unknown Fortran MPI_Datatype");
 42:   PetscFunctionReturn(PETSC_SUCCESS);
 43: }

 45: /*************************************************************************/

 47: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 48:   #define f90array1dcreatescalar_       F90ARRAY1DCREATESCALAR
 49:   #define f90array1daccessscalar_       F90ARRAY1DACCESSSCALAR
 50:   #define f90array1ddestroyscalar_      F90ARRAY1DDESTROYSCALAR
 51:   #define f90array1dcreatereal_         F90ARRAY1DCREATEREAL
 52:   #define f90array1daccessreal_         F90ARRAY1DACCESSREAL
 53:   #define f90array1ddestroyreal_        F90ARRAY1DDESTROYREAL
 54:   #define f90array1dcreateint_          F90ARRAY1DCREATEINT
 55:   #define f90array1daccessint_          F90ARRAY1DACCESSINT
 56:   #define f90array1ddestroyint_         F90ARRAY1DDESTROYINT
 57:   #define f90array1dcreatempiint_       F90ARRAY1DCREATEMPIINT
 58:   #define f90array1daccessmpiint_       F90ARRAY1DACCESSMPIINT
 59:   #define f90array1ddestroympiint_      F90ARRAY1DDESTROYMPIINT
 60:   #define f90array1dcreatefortranaddr_  F90ARRAY1DCREATEFORTRANADDR
 61:   #define f90array1daccessfortranaddr_  F90ARRAY1DACCESSFORTRANADDR
 62:   #define f90array1ddestroyfortranaddr_ F90ARRAY1DDESTROYFORTRANADDR
 63: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 64:   #define f90array1dcreatescalar_       f90array1dcreatescalar
 65:   #define f90array1daccessscalar_       f90array1daccessscalar
 66:   #define f90array1ddestroyscalar_      f90array1ddestroyscalar
 67:   #define f90array1dcreatereal_         f90array1dcreatereal
 68:   #define f90array1daccessreal_         f90array1daccessreal
 69:   #define f90array1ddestroyreal_        f90array1ddestroyreal
 70:   #define f90array1dcreateint_          f90array1dcreateint
 71:   #define f90array1daccessint_          f90array1daccessint
 72:   #define f90array1ddestroyint_         f90array1ddestroyint
 73:   #define f90array1dcreatempiint_       f90array1dcreatempiint
 74:   #define f90array1daccessmpiint_       f90array1daccessmpiint
 75:   #define f90array1ddestroympiint_      f90array1ddestroympiint
 76:   #define f90array1dcreatefortranaddr_  f90array1dcreatefortranaddr
 77:   #define f90array1daccessfortranaddr_  f90array1daccessfortranaddr
 78:   #define f90array1ddestroyfortranaddr_ f90array1ddestroyfortranaddr
 79: #endif

 81: PETSC_EXTERN void f90array1dcreatescalar_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 82: PETSC_EXTERN void f90array1daccessscalar_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 83: PETSC_EXTERN void f90array1ddestroyscalar_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 84: PETSC_EXTERN void f90array1dcreatereal_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 85: PETSC_EXTERN void f90array1daccessreal_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 86: PETSC_EXTERN void f90array1ddestroyreal_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 87: PETSC_EXTERN void f90array1dcreateint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 88: PETSC_EXTERN void f90array1daccessint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 89: PETSC_EXTERN void f90array1ddestroyint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 90: PETSC_EXTERN void f90array1dcreatempiint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 91: PETSC_EXTERN void f90array1daccessmpiint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 92: PETSC_EXTERN void f90array1ddestroympiint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 93: PETSC_EXTERN void f90array1dcreatefortranaddr_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 94: PETSC_EXTERN void f90array1daccessfortranaddr_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 95: PETSC_EXTERN void f90array1ddestroyfortranaddr_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

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

100:    Not Collective, No Fortran Support

102:    Input Parameters:
103: +  array - the C address pointer
104: .  type  - the MPI datatype of the array
105: .  start - the first index of the array
106: .  len   - the length of the array
107: .  ptr   - the `F90Array1d` passed from Fortran
108: -  ptrd   - an extra pointer passed by some Fortran compilers

110:    Level: developer

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

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

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

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

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

148:    Not Collective, No Fortran Support

150:    Input Parameters:
151: +  ptr   - the `F90Array1d` passed from Fortran
152: .  type  - the MPI datatype of the array
153: -  ptrd   - an extra pointer passed by some Fortran compilers

155:    Output Parameter:
156: .  array - the C address pointer

158:    Level: developer

160:    Developer Note:
161:    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.

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

165: .seealso: `F90Array1d`, `F90Array1dCreate()`, `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
166: @*/
167: PetscErrorCode F90Array1dAccess(F90Array1d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
168: {
169:   PetscFunctionBegin;
170:   if (type == MPIU_SCALAR) {
171:     f90array1daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
172:     if (*array == PETSC_NULL_SCALAR_Fortran) *array = NULL;
173:   } else if (type == MPIU_REAL) {
174:     f90array1daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
175:     if (*array == PETSC_NULL_REAL_Fortran) *array = NULL;
176:   } else if (type == MPIU_INT) {
177:     f90array1daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
178:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
179:   } else if (type == MPI_INT) {
180:     f90array1daccessmpiint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
181:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
182:   } else if (type == MPIU_FORTRANADDR) {
183:     f90array1daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
184:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
185:   PetscFunctionReturn(PETSC_SUCCESS);
186: }

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

191:    Not Collective, No Fortran Support

193:    Input Parameters:
194: +  ptr   - the `F90Array1d` passed from Fortran
195: .  type  - the MPI datatype of the array
196: -  ptrd   - an extra pointer passed by some Fortran compilers

198:    Level: developer

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

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

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

207: .seealso: `F90Array1d`, `F90Array1dAccess()`, `F90Array1dCreate()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
208: @*/
209: PetscErrorCode F90Array1dDestroy(F90Array1d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
210: {
211:   PetscFunctionBegin;
212:   if (type == MPIU_SCALAR) {
213:     f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
214:   } else if (type == MPIU_REAL) {
215:     f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
216:   } else if (type == MPIU_INT) {
217:     f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
218:   } else if (type == MPI_INT) {
219:     f90array1ddestroympiint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
220:   } else if (type == MPIU_FORTRANADDR) {
221:     f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
222:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
223:   PetscFunctionReturn(PETSC_SUCCESS);
224: }

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

229:    Not Collective, No Fortran Support

231:    Level: developer

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

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

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

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

243: #if defined(PETSC_HAVE_FORTRAN_CAPS)
244:   #define f90array2dcreatescalar_       F90ARRAY2DCREATESCALAR
245:   #define f90array2daccessscalar_       F90ARRAY2DACCESSSCALAR
246:   #define f90array2ddestroyscalar_      F90ARRAY2DDESTROYSCALAR
247:   #define f90array2dcreatereal_         F90ARRAY2DCREATEREAL
248:   #define f90array2daccessreal_         F90ARRAY2DACCESSREAL
249:   #define f90array2ddestroyreal_        F90ARRAY2DDESTROYREAL
250:   #define f90array2dcreateint_          F90ARRAY2DCREATEINT
251:   #define f90array2daccessint_          F90ARRAY2DACCESSINT
252:   #define f90array2ddestroyint_         F90ARRAY2DDESTROYINT
253:   #define f90array2dcreatefortranaddr_  F90ARRAY2DCREATEFORTRANADDR
254:   #define f90array2daccessfortranaddr_  F90ARRAY2DACCESSFORTRANADDR
255:   #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
256: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
257:   #define f90array2dcreatescalar_       f90array2dcreatescalar
258:   #define f90array2daccessscalar_       f90array2daccessscalar
259:   #define f90array2ddestroyscalar_      f90array2ddestroyscalar
260:   #define f90array2dcreatereal_         f90array2dcreatereal
261:   #define f90array2daccessreal_         f90array2daccessreal
262:   #define f90array2ddestroyreal_        f90array2ddestroyreal
263:   #define f90array2dcreateint_          f90array2dcreateint
264:   #define f90array2daccessint_          f90array2daccessint
265:   #define f90array2ddestroyint_         f90array2ddestroyint
266:   #define f90array2dcreatefortranaddr_  f90array2dcreatefortranaddr
267:   #define f90array2daccessfortranaddr_  f90array2daccessfortranaddr
268:   #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
269: #endif

271: PETSC_EXTERN void f90array2dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
272: PETSC_EXTERN void f90array2daccessscalar_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
273: PETSC_EXTERN void f90array2ddestroyscalar_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
274: PETSC_EXTERN void f90array2dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
275: PETSC_EXTERN void f90array2daccessreal_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
276: PETSC_EXTERN void f90array2ddestroyreal_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
277: PETSC_EXTERN void f90array2dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
278: PETSC_EXTERN void f90array2daccessint_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
279: PETSC_EXTERN void f90array2ddestroyint_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
280: PETSC_EXTERN void f90array2dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
281: PETSC_EXTERN void f90array2daccessfortranaddr_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
282: PETSC_EXTERN void f90array2ddestroyfortranaddr_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

284: PetscErrorCode F90Array2dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
285: {
286:   PetscFunctionBegin;
287:   if (type == MPIU_SCALAR) {
288:     f90array2dcreatescalar_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
289:   } else if (type == MPIU_REAL) {
290:     f90array2dcreatereal_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
291:   } else if (type == MPIU_INT) {
292:     f90array2dcreateint_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
293:   } else if (type == MPIU_FORTRANADDR) {
294:     f90array2dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
295:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
296:   PetscFunctionReturn(PETSC_SUCCESS);
297: }

299: PetscErrorCode F90Array2dAccess(F90Array2d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
300: {
301:   PetscFunctionBegin;
302:   if (type == MPIU_SCALAR) {
303:     f90array2daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
304:   } else if (type == MPIU_REAL) {
305:     f90array2daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
306:   } else if (type == MPIU_INT) {
307:     f90array2daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
308:   } else if (type == MPIU_FORTRANADDR) {
309:     f90array2daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
310:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
311:   PetscFunctionReturn(PETSC_SUCCESS);
312: }

314: PetscErrorCode F90Array2dDestroy(F90Array2d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
315: {
316:   PetscFunctionBegin;
317:   if (type == MPIU_SCALAR) {
318:     f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
319:   } else if (type == MPIU_REAL) {
320:     f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
321:   } else if (type == MPIU_INT) {
322:     f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
323:   } else if (type == MPIU_FORTRANADDR) {
324:     f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
325:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
326:   PetscFunctionReturn(PETSC_SUCCESS);
327: }

329: #if defined(PETSC_HAVE_FORTRAN_CAPS)
330:   #define f90array3dcreatescalar_       F90ARRAY3DCREATESCALAR
331:   #define f90array3daccessscalar_       F90ARRAY3DACCESSSCALAR
332:   #define f90array3ddestroyscalar_      F90ARRAY3DDESTROYSCALAR
333:   #define f90array3dcreatereal_         F90ARRAY3DCREATEREAL
334:   #define f90array3daccessreal_         F90ARRAY3DACCESSREAL
335:   #define f90array3ddestroyreal_        F90ARRAY3DDESTROYREAL
336:   #define f90array3dcreateint_          F90ARRAY3DCREATEINT
337:   #define f90array3daccessint_          F90ARRAY3DACCESSINT
338:   #define f90array3ddestroyint_         F90ARRAY3DDESTROYINT
339:   #define f90array3dcreatefortranaddr_  F90ARRAY3DCREATEFORTRANADDR
340:   #define f90array3daccessfortranaddr_  F90ARRAY3DACCESSFORTRANADDR
341:   #define f90array3ddestroyfortranaddr_ F90ARRAY3DDESTROYFORTRANADDR
342: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
343:   #define f90array3dcreatescalar_       f90array3dcreatescalar
344:   #define f90array3daccessscalar_       f90array3daccessscalar
345:   #define f90array3ddestroyscalar_      f90array3ddestroyscalar
346:   #define f90array3dcreatereal_         f90array3dcreatereal
347:   #define f90array3daccessreal_         f90array3daccessreal
348:   #define f90array3ddestroyreal_        f90array3ddestroyreal
349:   #define f90array3dcreateint_          f90array3dcreateint
350:   #define f90array3daccessint_          f90array3daccessint
351:   #define f90array3ddestroyint_         f90array3ddestroyint
352:   #define f90array3dcreatefortranaddr_  f90array3dcreatefortranaddr
353:   #define f90array3daccessfortranaddr_  f90array3daccessfortranaddr
354:   #define f90array3ddestroyfortranaddr_ f90array3ddestroyfortranaddr
355: #endif

357: PETSC_EXTERN void f90array3dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
358: PETSC_EXTERN void f90array3daccessscalar_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
359: PETSC_EXTERN void f90array3ddestroyscalar_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
360: PETSC_EXTERN void f90array3dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
361: PETSC_EXTERN void f90array3daccessreal_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
362: PETSC_EXTERN void f90array3ddestroyreal_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
363: PETSC_EXTERN void f90array3dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
364: PETSC_EXTERN void f90array3daccessint_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
365: PETSC_EXTERN void f90array3ddestroyint_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
366: PETSC_EXTERN void f90array3dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
367: PETSC_EXTERN void f90array3daccessfortranaddr_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
368: PETSC_EXTERN void f90array3ddestroyfortranaddr_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

370: 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))
371: {
372:   PetscFunctionBegin;
373:   if (type == MPIU_SCALAR) {
374:     f90array3dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
375:   } else if (type == MPIU_REAL) {
376:     f90array3dcreatereal_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
377:   } else if (type == MPIU_INT) {
378:     f90array3dcreateint_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
379:   } else if (type == MPIU_FORTRANADDR) {
380:     f90array3dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
381:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
382:   PetscFunctionReturn(PETSC_SUCCESS);
383: }

385: PetscErrorCode F90Array3dAccess(F90Array3d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
386: {
387:   PetscFunctionBegin;
388:   if (type == MPIU_SCALAR) {
389:     f90array3daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
390:   } else if (type == MPIU_REAL) {
391:     f90array3daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
392:   } else if (type == MPIU_INT) {
393:     f90array3daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
394:   } else if (type == MPIU_FORTRANADDR) {
395:     f90array3daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
396:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
397:   PetscFunctionReturn(PETSC_SUCCESS);
398: }

400: PetscErrorCode F90Array3dDestroy(F90Array3d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
401: {
402:   PetscFunctionBegin;
403:   if (type == MPIU_SCALAR) {
404:     f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
405:   } else if (type == MPIU_REAL) {
406:     f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
407:   } else if (type == MPIU_INT) {
408:     f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
409:   } else if (type == MPIU_FORTRANADDR) {
410:     f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
411:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
412:   PetscFunctionReturn(PETSC_SUCCESS);
413: }

415: #if defined(PETSC_HAVE_FORTRAN_CAPS)
416:   #define f90array4dcreatescalar_       F90ARRAY4DCREATESCALAR
417:   #define f90array4daccessscalar_       F90ARRAY4DACCESSSCALAR
418:   #define f90array4ddestroyscalar_      F90ARRAY4DDESTROYSCALAR
419:   #define f90array4dcreatereal_         F90ARRAY4DCREATEREAL
420:   #define f90array4daccessreal_         F90ARRAY4DACCESSREAL
421:   #define f90array4ddestroyreal_        F90ARRAY4DDESTROYREAL
422:   #define f90array4dcreateint_          F90ARRAY4DCREATEINT
423:   #define f90array4daccessint_          F90ARRAY4DACCESSINT
424:   #define f90array4ddestroyint_         F90ARRAY4DDESTROYINT
425:   #define f90array4dcreatefortranaddr_  F90ARRAY4DCREATEFORTRANADDR
426:   #define f90array4daccessfortranaddr_  F90ARRAY4DACCESSFORTRANADDR
427:   #define f90array4ddestroyfortranaddr_ F90ARRAY4DDESTROYFORTRANADDR
428: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
429:   #define f90array4dcreatescalar_       f90array4dcreatescalar
430:   #define f90array4daccessscalar_       f90array4daccessscalar
431:   #define f90array4ddestroyscalar_      f90array4ddestroyscalar
432:   #define f90array4dcreatereal_         f90array4dcreatereal
433:   #define f90array4daccessreal_         f90array4daccessreal
434:   #define f90array4ddestroyreal_        f90array4ddestroyreal
435:   #define f90array4dcreateint_          f90array4dcreateint
436:   #define f90array4daccessint_          f90array4daccessint
437:   #define f90array4ddestroyint_         f90array4ddestroyint
438:   #define f90array4dcreatefortranaddr_  f90array4dcreatefortranaddr
439:   #define f90array4daccessfortranaddr_  f90array4daccessfortranaddr
440:   #define f90array4ddestroyfortranaddr_ f90array4ddestroyfortranaddr
441: #endif

443: PETSC_EXTERN void f90array4dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
444: PETSC_EXTERN void f90array4daccessscalar_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
445: PETSC_EXTERN void f90array4ddestroyscalar_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
446: PETSC_EXTERN void f90array4dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
447: PETSC_EXTERN void f90array4daccessreal_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
448: PETSC_EXTERN void f90array4ddestroyreal_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
449: PETSC_EXTERN void f90array4dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
450: PETSC_EXTERN void f90array4daccessint_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
451: PETSC_EXTERN void f90array4ddestroyint_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
452: PETSC_EXTERN void f90array4dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
453: PETSC_EXTERN void f90array4daccessfortranaddr_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
454: PETSC_EXTERN void f90array4ddestroyfortranaddr_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

456: 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))
457: {
458:   PetscFunctionBegin;
459:   PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
460:   f90array4dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, &start4, &len4, ptr PETSC_F90_2PTR_PARAM(ptrd));
461:   PetscFunctionReturn(PETSC_SUCCESS);
462: }

464: PetscErrorCode F90Array4dAccess(F90Array4d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
465: {
466:   PetscFunctionBegin;
467:   if (type == MPIU_SCALAR) {
468:     f90array4daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
469:   } else if (type == MPIU_REAL) {
470:     f90array4daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
471:   } else if (type == MPIU_INT) {
472:     f90array4daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
473:   } else if (type == MPIU_FORTRANADDR) {
474:     f90array4daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
475:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
476:   PetscFunctionReturn(PETSC_SUCCESS);
477: }

479: PetscErrorCode F90Array4dDestroy(F90Array4d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
480: {
481:   PetscFunctionBegin;
482:   PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
483:   f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
484:   PetscFunctionReturn(PETSC_SUCCESS);
485: }

487: #if defined(PETSC_HAVE_FORTRAN_CAPS)
488:   #define f90array1dgetaddrscalar_      F90ARRAY1DGETADDRSCALAR
489:   #define f90array1dgetaddrreal_        F90ARRAY1DGETADDRREAL
490:   #define f90array1dgetaddrint_         F90ARRAY1DGETADDRINT
491:   #define f90array1dgetaddrmpiint_      F90ARRAY1DGETADDRMPIINT
492:   #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
493: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
494:   #define f90array1dgetaddrscalar_      f90array1dgetaddrscalar
495:   #define f90array1dgetaddrreal_        f90array1dgetaddrreal
496:   #define f90array1dgetaddrint_         f90array1dgetaddrint
497:   #define f90array1dgetaddrmpiint_      f90array1dgetaddrmpiint
498:   #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
499: #endif

501: PETSC_EXTERN void f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
502: {
503:   *address = (PetscFortranAddr)array;
504: }
505: PETSC_EXTERN void f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
506: {
507:   *address = (PetscFortranAddr)array;
508: }
509: PETSC_EXTERN void f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
510: {
511:   *address = (PetscFortranAddr)array;
512: }
513: PETSC_EXTERN void f90array1dgetaddrmpiint_(void *array, PetscFortranAddr *address)
514: {
515:   *address = (PetscFortranAddr)array;
516: }
517: PETSC_EXTERN void f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
518: {
519:   *address = (PetscFortranAddr)array;
520: }

522: #if defined(PETSC_HAVE_FORTRAN_CAPS)
523:   #define f90array2dgetaddrscalar_      F90ARRAY2DGETADDRSCALAR
524:   #define f90array2dgetaddrreal_        F90ARRAY2DGETADDRREAL
525:   #define f90array2dgetaddrint_         F90ARRAY2DGETADDRINT
526:   #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
527: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
528:   #define f90array2dgetaddrscalar_      f90array2dgetaddrscalar
529:   #define f90array2dgetaddrreal_        f90array2dgetaddrreal
530:   #define f90array2dgetaddrint_         f90array2dgetaddrint
531:   #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
532: #endif

534: PETSC_EXTERN void f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
535: {
536:   *address = (PetscFortranAddr)array;
537: }
538: PETSC_EXTERN void f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
539: {
540:   *address = (PetscFortranAddr)array;
541: }
542: PETSC_EXTERN void f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
543: {
544:   *address = (PetscFortranAddr)array;
545: }
546: PETSC_EXTERN void f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
547: {
548:   *address = (PetscFortranAddr)array;
549: }

551: #if defined(PETSC_HAVE_FORTRAN_CAPS)
552:   #define f90array3dgetaddrscalar_      F90ARRAY3DGETADDRSCALAR
553:   #define f90array3dgetaddrreal_        F90ARRAY3DGETADDRREAL
554:   #define f90array3dgetaddrint_         F90ARRAY3DGETADDRINT
555:   #define f90array3dgetaddrfortranaddr_ F90ARRAY3DGETADDRFORTRANADDR
556: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
557:   #define f90array3dgetaddrscalar_      f90array3dgetaddrscalar
558:   #define f90array3dgetaddrreal_        f90array3dgetaddrreal
559:   #define f90array3dgetaddrint_         f90array3dgetaddrint
560:   #define f90array3dgetaddrfortranaddr_ f90array3dgetaddrfortranaddr
561: #endif

563: PETSC_EXTERN void f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
564: {
565:   *address = (PetscFortranAddr)array;
566: }
567: PETSC_EXTERN void f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
568: {
569:   *address = (PetscFortranAddr)array;
570: }
571: PETSC_EXTERN void f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
572: {
573:   *address = (PetscFortranAddr)array;
574: }
575: PETSC_EXTERN void f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
576: {
577:   *address = (PetscFortranAddr)array;
578: }

580: #if defined(PETSC_HAVE_FORTRAN_CAPS)
581:   #define f90array4dgetaddrscalar_      F90ARRAY4DGETADDRSCALAR
582:   #define f90array4dgetaddrreal_        F90ARRAY4DGETADDRREAL
583:   #define f90array4dgetaddrint_         F90ARRAY4DGETADDRINT
584:   #define f90array4dgetaddrfortranaddr_ F90ARRAY4DGETADDRFORTRANADDR
585: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
586:   #define f90array4dgetaddrscalar_      f90array4dgetaddrscalar
587:   #define f90array4dgetaddrreal_        f90array4dgetaddrreal
588:   #define f90array4dgetaddrint_         f90array4dgetaddrint
589:   #define f90array4dgetaddrfortranaddr_ f90array4dgetaddrfortranaddr
590: #endif

592: PETSC_EXTERN void f90array4dgetaddrscalar_(void *array, PetscFortranAddr *address)
593: {
594:   *address = (PetscFortranAddr)array;
595: }
596: PETSC_EXTERN void f90array4dgetaddrreal_(void *array, PetscFortranAddr *address)
597: {
598:   *address = (PetscFortranAddr)array;
599: }
600: PETSC_EXTERN void f90array4dgetaddrint_(void *array, PetscFortranAddr *address)
601: {
602:   *address = (PetscFortranAddr)array;
603: }
604: PETSC_EXTERN void f90array4dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
605: {
606:   *address = (PetscFortranAddr)array;
607: }