Actual source code: f90_cwrap.c

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

  3: /*@C

  5:    PetscMPIFortranDatatypeToC - Converts a `MPI_Fint` that contains a Fortran `MPI_Datatype` to its C `MPI_Datatype` equivalent

  7:    Not Collective

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

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

 15:    Level: developer

 17:    Developer Note:
 18:     The MPI documentation in multiple places says that one can never us
 19:    Fortran `MPI_Datatype`s in C (or vice-versa) but this is problematic since users could never
 20:    call C routines from Fortran that have `MPI_Datatype` arguments. Jed states that the Fortran
 21:    `MPI_Datatype`s will always be available in C if the MPI was built to support Fortran. This function
 22:    relies on this.
 23: @*/
 24: PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint unit, MPI_Datatype *dtype)
 25: {
 26:   MPI_Datatype ftype;

 28:   ftype = MPI_Type_f2c(unit);
 29:   if (ftype == MPI_INTEGER || ftype == MPI_INT) *dtype = MPI_INT;
 30:   else if (ftype == MPI_INTEGER8 || ftype == MPIU_INT64) *dtype = MPIU_INT64;
 31:   else if (ftype == MPI_DOUBLE_PRECISION || ftype == MPI_DOUBLE) *dtype = MPI_DOUBLE;
 32: #if defined(PETSC_HAVE_COMPLEX)
 33:   else if (ftype == MPI_COMPLEX16 || ftype == MPI_C_DOUBLE_COMPLEX) *dtype = MPI_C_DOUBLE_COMPLEX;
 34: #endif
 35:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unknown Fortran MPI_Datatype");
 36:   return 0;
 37: }

 39: /*************************************************************************/

 41: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 42:   #define f90array1dcreatescalar_       F90ARRAY1DCREATESCALAR
 43:   #define f90array1daccessscalar_       F90ARRAY1DACCESSSCALAR
 44:   #define f90array1ddestroyscalar_      F90ARRAY1DDESTROYSCALAR
 45:   #define f90array1dcreatereal_         F90ARRAY1DCREATEREAL
 46:   #define f90array1daccessreal_         F90ARRAY1DACCESSREAL
 47:   #define f90array1ddestroyreal_        F90ARRAY1DDESTROYREAL
 48:   #define f90array1dcreateint_          F90ARRAY1DCREATEINT
 49:   #define f90array1daccessint_          F90ARRAY1DACCESSINT
 50:   #define f90array1ddestroyint_         F90ARRAY1DDESTROYINT
 51:   #define f90array1dcreatefortranaddr_  F90ARRAY1DCREATEFORTRANADDR
 52:   #define f90array1daccessfortranaddr_  F90ARRAY1DACCESSFORTRANADDR
 53:   #define f90array1ddestroyfortranaddr_ F90ARRAY1DDESTROYFORTRANADDR
 54: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 55:   #define f90array1dcreatescalar_       f90array1dcreatescalar
 56:   #define f90array1daccessscalar_       f90array1daccessscalar
 57:   #define f90array1ddestroyscalar_      f90array1ddestroyscalar
 58:   #define f90array1dcreatereal_         f90array1dcreatereal
 59:   #define f90array1daccessreal_         f90array1daccessreal
 60:   #define f90array1ddestroyreal_        f90array1ddestroyreal
 61:   #define f90array1dcreateint_          f90array1dcreateint
 62:   #define f90array1daccessint_          f90array1daccessint
 63:   #define f90array1ddestroyint_         f90array1ddestroyint
 64:   #define f90array1dcreatefortranaddr_  f90array1dcreatefortranaddr
 65:   #define f90array1daccessfortranaddr_  f90array1daccessfortranaddr
 66:   #define f90array1ddestroyfortranaddr_ f90array1ddestroyfortranaddr
 67: #endif

 69: PETSC_EXTERN void f90array1dcreatescalar_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 70: PETSC_EXTERN void f90array1daccessscalar_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 71: PETSC_EXTERN void f90array1ddestroyscalar_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 72: PETSC_EXTERN void f90array1dcreatereal_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 73: PETSC_EXTERN void f90array1daccessreal_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 74: PETSC_EXTERN void f90array1ddestroyreal_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 75: PETSC_EXTERN void f90array1dcreateint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 76: PETSC_EXTERN void f90array1daccessint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 77: PETSC_EXTERN void f90array1ddestroyint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
 78: PETSC_EXTERN void f90array1dcreatefortranaddr_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
 79: PETSC_EXTERN void f90array1daccessfortranaddr_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
 80: PETSC_EXTERN void f90array1ddestroyfortranaddr_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

 82: PetscErrorCode F90Array1dCreate(void *array, MPI_Datatype type, PetscInt start, PetscInt len, F90Array1d *ptr PETSC_F90_2PTR_PROTO(ptrd))
 83: {
 84:   if (type == MPIU_SCALAR) {
 85:     if (!len) array = PETSC_NULL_SCALAR_Fortran;
 86:     f90array1dcreatescalar_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 87:   } else if (type == MPIU_REAL) {
 88:     if (!len) array = PETSC_NULL_REAL_Fortran;
 89:     f90array1dcreatereal_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 90:   } else if (type == MPIU_INT) {
 91:     if (!len) array = PETSC_NULL_INTEGER_Fortran;
 92:     f90array1dcreateint_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 93:   } else if (type == MPIU_FORTRANADDR) {
 94:     f90array1dcreatefortranaddr_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 95:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
 96:   return 0;
 97: }

 99: PetscErrorCode F90Array1dAccess(F90Array1d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
100: {
101:   if (type == MPIU_SCALAR) {
102:     f90array1daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
103:     if (*array == PETSC_NULL_SCALAR_Fortran) *array = 0;
104:   } else if (type == MPIU_REAL) {
105:     f90array1daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
106:     if (*array == PETSC_NULL_REAL_Fortran) *array = 0;
107:   } else if (type == MPIU_INT) {
108:     f90array1daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
109:     if (*array == PETSC_NULL_INTEGER_Fortran) *array = 0;
110:   } else if (type == MPIU_FORTRANADDR) {
111:     f90array1daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
112:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
113:   return 0;
114: }

116: PetscErrorCode F90Array1dDestroy(F90Array1d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
117: {
118:   if (type == MPIU_SCALAR) {
119:     f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
120:   } else if (type == MPIU_REAL) {
121:     f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
122:   } else if (type == MPIU_INT) {
123:     f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
124:   } else if (type == MPIU_FORTRANADDR) {
125:     f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
126:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
127:   return 0;
128: }

130: /*************************************************************************/

132: #if defined(PETSC_HAVE_FORTRAN_CAPS)
133:   #define f90array2dcreatescalar_       F90ARRAY2DCREATESCALAR
134:   #define f90array2daccessscalar_       F90ARRAY2DACCESSSCALAR
135:   #define f90array2ddestroyscalar_      F90ARRAY2DDESTROYSCALAR
136:   #define f90array2dcreatereal_         F90ARRAY2DCREATEREAL
137:   #define f90array2daccessreal_         F90ARRAY2DACCESSREAL
138:   #define f90array2ddestroyreal_        F90ARRAY2DDESTROYREAL
139:   #define f90array2dcreateint_          F90ARRAY2DCREATEINT
140:   #define f90array2daccessint_          F90ARRAY2DACCESSINT
141:   #define f90array2ddestroyint_         F90ARRAY2DDESTROYINT
142:   #define f90array2dcreatefortranaddr_  F90ARRAY2DCREATEFORTRANADDR
143:   #define f90array2daccessfortranaddr_  F90ARRAY2DACCESSFORTRANADDR
144:   #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
145: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
146:   #define f90array2dcreatescalar_       f90array2dcreatescalar
147:   #define f90array2daccessscalar_       f90array2daccessscalar
148:   #define f90array2ddestroyscalar_      f90array2ddestroyscalar
149:   #define f90array2dcreatereal_         f90array2dcreatereal
150:   #define f90array2daccessreal_         f90array2daccessreal
151:   #define f90array2ddestroyreal_        f90array2ddestroyreal
152:   #define f90array2dcreateint_          f90array2dcreateint
153:   #define f90array2daccessint_          f90array2daccessint
154:   #define f90array2ddestroyint_         f90array2ddestroyint
155:   #define f90array2dcreatefortranaddr_  f90array2dcreatefortranaddr
156:   #define f90array2daccessfortranaddr_  f90array2daccessfortranaddr
157:   #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
158: #endif

160: PETSC_EXTERN void f90array2dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
161: PETSC_EXTERN void f90array2daccessscalar_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
162: PETSC_EXTERN void f90array2ddestroyscalar_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
163: PETSC_EXTERN void f90array2dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
164: PETSC_EXTERN void f90array2daccessreal_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
165: PETSC_EXTERN void f90array2ddestroyreal_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
166: PETSC_EXTERN void f90array2dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
167: PETSC_EXTERN void f90array2daccessint_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
168: PETSC_EXTERN void f90array2ddestroyint_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
169: PETSC_EXTERN void f90array2dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
170: PETSC_EXTERN void f90array2daccessfortranaddr_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
171: PETSC_EXTERN void f90array2ddestroyfortranaddr_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

173: PetscErrorCode F90Array2dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
174: {
175:   if (type == MPIU_SCALAR) {
176:     f90array2dcreatescalar_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
177:   } else if (type == MPIU_REAL) {
178:     f90array2dcreatereal_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
179:   } else if (type == MPIU_INT) {
180:     f90array2dcreateint_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
181:   } else if (type == MPIU_FORTRANADDR) {
182:     f90array2dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
183:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
184:   return 0;
185: }

187: PetscErrorCode F90Array2dAccess(F90Array2d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
188: {
189:   if (type == MPIU_SCALAR) {
190:     f90array2daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
191:   } else if (type == MPIU_REAL) {
192:     f90array2daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
193:   } else if (type == MPIU_INT) {
194:     f90array2daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
195:   } else if (type == MPIU_FORTRANADDR) {
196:     f90array2daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
197:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
198:   return 0;
199: }

201: PetscErrorCode F90Array2dDestroy(F90Array2d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
202: {
203:   if (type == MPIU_SCALAR) {
204:     f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
205:   } else if (type == MPIU_REAL) {
206:     f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
207:   } else if (type == MPIU_INT) {
208:     f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
209:   } else if (type == MPIU_FORTRANADDR) {
210:     f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
211:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
212:   return 0;
213: }

215: /*************************************************************************/

217: #if defined(PETSC_HAVE_FORTRAN_CAPS)
218:   #define f90array3dcreatescalar_       F90ARRAY3DCREATESCALAR
219:   #define f90array3daccessscalar_       F90ARRAY3DACCESSSCALAR
220:   #define f90array3ddestroyscalar_      F90ARRAY3DDESTROYSCALAR
221:   #define f90array3dcreatereal_         F90ARRAY3DCREATEREAL
222:   #define f90array3daccessreal_         F90ARRAY3DACCESSREAL
223:   #define f90array3ddestroyreal_        F90ARRAY3DDESTROYREAL
224:   #define f90array3dcreateint_          F90ARRAY3DCREATEINT
225:   #define f90array3daccessint_          F90ARRAY3DACCESSINT
226:   #define f90array3ddestroyint_         F90ARRAY3DDESTROYINT
227:   #define f90array3dcreatefortranaddr_  F90ARRAY3DCREATEFORTRANADDR
228:   #define f90array3daccessfortranaddr_  F90ARRAY3DACCESSFORTRANADDR
229:   #define f90array3ddestroyfortranaddr_ F90ARRAY3DDESTROYFORTRANADDR
230: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
231:   #define f90array3dcreatescalar_       f90array3dcreatescalar
232:   #define f90array3daccessscalar_       f90array3daccessscalar
233:   #define f90array3ddestroyscalar_      f90array3ddestroyscalar
234:   #define f90array3dcreatereal_         f90array3dcreatereal
235:   #define f90array3daccessreal_         f90array3daccessreal
236:   #define f90array3ddestroyreal_        f90array3ddestroyreal
237:   #define f90array3dcreateint_          f90array3dcreateint
238:   #define f90array3daccessint_          f90array3daccessint
239:   #define f90array3ddestroyint_         f90array3ddestroyint
240:   #define f90array3dcreatefortranaddr_  f90array3dcreatefortranaddr
241:   #define f90array3daccessfortranaddr_  f90array3daccessfortranaddr
242:   #define f90array3ddestroyfortranaddr_ f90array3ddestroyfortranaddr
243: #endif

245: PETSC_EXTERN void f90array3dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
246: PETSC_EXTERN void f90array3daccessscalar_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
247: PETSC_EXTERN void f90array3ddestroyscalar_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
248: PETSC_EXTERN void f90array3dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
249: PETSC_EXTERN void f90array3daccessreal_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
250: PETSC_EXTERN void f90array3ddestroyreal_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
251: PETSC_EXTERN void f90array3dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
252: PETSC_EXTERN void f90array3daccessint_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
253: PETSC_EXTERN void f90array3ddestroyint_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
254: PETSC_EXTERN void f90array3dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
255: PETSC_EXTERN void f90array3daccessfortranaddr_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
256: PETSC_EXTERN void f90array3ddestroyfortranaddr_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

258: 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))
259: {
260:   if (type == MPIU_SCALAR) {
261:     f90array3dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
262:   } else if (type == MPIU_REAL) {
263:     f90array3dcreatereal_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
264:   } else if (type == MPIU_INT) {
265:     f90array3dcreateint_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
266:   } else if (type == MPIU_FORTRANADDR) {
267:     f90array3dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
268:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
269:   return 0;
270: }

272: PetscErrorCode F90Array3dAccess(F90Array3d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
273: {
274:   if (type == MPIU_SCALAR) {
275:     f90array3daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
276:   } else if (type == MPIU_REAL) {
277:     f90array3daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
278:   } else if (type == MPIU_INT) {
279:     f90array3daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
280:   } else if (type == MPIU_FORTRANADDR) {
281:     f90array3daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
282:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
283:   return 0;
284: }

286: PetscErrorCode F90Array3dDestroy(F90Array3d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
287: {
288:   if (type == MPIU_SCALAR) {
289:     f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
290:   } else if (type == MPIU_REAL) {
291:     f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
292:   } else if (type == MPIU_INT) {
293:     f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
294:   } else if (type == MPIU_FORTRANADDR) {
295:     f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
296:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
297:   return 0;
298: }

300: /*************************************************************************/
301: #if defined(PETSC_HAVE_FORTRAN_CAPS)
302:   #define f90array4dcreatescalar_       F90ARRAY4DCREATESCALAR
303:   #define f90array4daccessscalar_       F90ARRAY4DACCESSSCALAR
304:   #define f90array4ddestroyscalar_      F90ARRAY4DDESTROYSCALAR
305:   #define f90array4dcreatereal_         F90ARRAY4DCREATEREAL
306:   #define f90array4daccessreal_         F90ARRAY4DACCESSREAL
307:   #define f90array4ddestroyreal_        F90ARRAY4DDESTROYREAL
308:   #define f90array4dcreateint_          F90ARRAY4DCREATEINT
309:   #define f90array4daccessint_          F90ARRAY4DACCESSINT
310:   #define f90array4ddestroyint_         F90ARRAY4DDESTROYINT
311:   #define f90array4dcreatefortranaddr_  F90ARRAY4DCREATEFORTRANADDR
312:   #define f90array4daccessfortranaddr_  F90ARRAY4DACCESSFORTRANADDR
313:   #define f90array4ddestroyfortranaddr_ F90ARRAY4DDESTROYFORTRANADDR
314: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
315:   #define f90array4dcreatescalar_       f90array4dcreatescalar
316:   #define f90array4daccessscalar_       f90array4daccessscalar
317:   #define f90array4ddestroyscalar_      f90array4ddestroyscalar
318:   #define f90array4dcreatereal_         f90array4dcreatereal
319:   #define f90array4daccessreal_         f90array4daccessreal
320:   #define f90array4ddestroyreal_        f90array4ddestroyreal
321:   #define f90array4dcreateint_          f90array4dcreateint
322:   #define f90array4daccessint_          f90array4daccessint
323:   #define f90array4ddestroyint_         f90array4ddestroyint
324:   #define f90array4dcreatefortranaddr_  f90array4dcreatefortranaddr
325:   #define f90array4daccessfortranaddr_  f90array4daccessfortranaddr
326:   #define f90array4ddestroyfortranaddr_ f90array4ddestroyfortranaddr
327: #endif

329: PETSC_EXTERN void f90array4dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
330: PETSC_EXTERN void f90array4daccessscalar_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
331: PETSC_EXTERN void f90array4ddestroyscalar_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
332: PETSC_EXTERN void f90array4dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
333: PETSC_EXTERN void f90array4daccessreal_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
334: PETSC_EXTERN void f90array4ddestroyreal_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
335: PETSC_EXTERN void f90array4dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
336: PETSC_EXTERN void f90array4daccessint_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
337: PETSC_EXTERN void f90array4ddestroyint_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
338: PETSC_EXTERN void f90array4dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
339: PETSC_EXTERN void f90array4daccessfortranaddr_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
340: PETSC_EXTERN void f90array4ddestroyfortranaddr_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

342: 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))
343: {
344:   if (type == MPIU_SCALAR) {
345:     f90array4dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, &start4, &len4, ptr PETSC_F90_2PTR_PARAM(ptrd));
346:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
347:   return 0;
348: }

350: PetscErrorCode F90Array4dAccess(F90Array4d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
351: {
352:   if (type == MPIU_SCALAR) {
353:     f90array4daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
354:   } else if (type == MPIU_REAL) {
355:     f90array4daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
356:   } else if (type == MPIU_INT) {
357:     f90array4daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
358:   } else if (type == MPIU_FORTRANADDR) {
359:     f90array4daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
360:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
361:   return 0;
362: }

364: PetscErrorCode F90Array4dDestroy(F90Array4d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
365: {
366:   if (type == MPIU_SCALAR) {
367:     f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
368:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
369:   return 0;
370: }

372: /*************************************************************************/
373: #if defined(PETSC_HAVE_FORTRAN_CAPS)
374:   #define f90array1dgetaddrscalar_      F90ARRAY1DGETADDRSCALAR
375:   #define f90array1dgetaddrreal_        F90ARRAY1DGETADDRREAL
376:   #define f90array1dgetaddrint_         F90ARRAY1DGETADDRINT
377:   #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
378: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
379:   #define f90array1dgetaddrscalar_      f90array1dgetaddrscalar
380:   #define f90array1dgetaddrreal_        f90array1dgetaddrreal
381:   #define f90array1dgetaddrint_         f90array1dgetaddrint
382:   #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
383: #endif

385: PETSC_EXTERN void f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
386: {
387:   *address = (PetscFortranAddr)array;
388: }
389: PETSC_EXTERN void f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
390: {
391:   *address = (PetscFortranAddr)array;
392: }
393: PETSC_EXTERN void f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
394: {
395:   *address = (PetscFortranAddr)array;
396: }
397: PETSC_EXTERN void f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
398: {
399:   *address = (PetscFortranAddr)array;
400: }

402: /*************************************************************************/
403: #if defined(PETSC_HAVE_FORTRAN_CAPS)
404:   #define f90array2dgetaddrscalar_      F90ARRAY2DGETADDRSCALAR
405:   #define f90array2dgetaddrreal_        F90ARRAY2DGETADDRREAL
406:   #define f90array2dgetaddrint_         F90ARRAY2DGETADDRINT
407:   #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
408: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
409:   #define f90array2dgetaddrscalar_      f90array2dgetaddrscalar
410:   #define f90array2dgetaddrreal_        f90array2dgetaddrreal
411:   #define f90array2dgetaddrint_         f90array2dgetaddrint
412:   #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
413: #endif

415: PETSC_EXTERN void f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
416: {
417:   *address = (PetscFortranAddr)array;
418: }
419: PETSC_EXTERN void f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
420: {
421:   *address = (PetscFortranAddr)array;
422: }
423: PETSC_EXTERN void f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
424: {
425:   *address = (PetscFortranAddr)array;
426: }
427: PETSC_EXTERN void f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
428: {
429:   *address = (PetscFortranAddr)array;
430: }

432: /*************************************************************************/
433: #if defined(PETSC_HAVE_FORTRAN_CAPS)
434:   #define f90array3dgetaddrscalar_      F90ARRAY3DGETADDRSCALAR
435:   #define f90array3dgetaddrreal_        F90ARRAY3DGETADDRREAL
436:   #define f90array3dgetaddrint_         F90ARRAY3DGETADDRINT
437:   #define f90array3dgetaddrfortranaddr_ F90ARRAY3DGETADDRFORTRANADDR
438: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
439:   #define f90array3dgetaddrscalar_      f90array3dgetaddrscalar
440:   #define f90array3dgetaddrreal_        f90array3dgetaddrreal
441:   #define f90array3dgetaddrint_         f90array3dgetaddrint
442:   #define f90array3dgetaddrfortranaddr_ f90array3dgetaddrfortranaddr
443: #endif

445: PETSC_EXTERN void f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
446: {
447:   *address = (PetscFortranAddr)array;
448: }
449: PETSC_EXTERN void f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
450: {
451:   *address = (PetscFortranAddr)array;
452: }
453: PETSC_EXTERN void f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
454: {
455:   *address = (PetscFortranAddr)array;
456: }
457: PETSC_EXTERN void f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
458: {
459:   *address = (PetscFortranAddr)array;
460: }

462: /*************************************************************************/
463: #if defined(PETSC_HAVE_FORTRAN_CAPS)
464:   #define f90array4dgetaddrscalar_      F90ARRAY4DGETADDRSCALAR
465:   #define f90array4dgetaddrreal_        F90ARRAY4DGETADDRREAL
466:   #define f90array4dgetaddrint_         F90ARRAY4DGETADDRINT
467:   #define f90array4dgetaddrfortranaddr_ F90ARRAY4DGETADDRFORTRANADDR
468: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
469:   #define f90array4dgetaddrscalar_      f90array4dgetaddrscalar
470:   #define f90array4dgetaddrreal_        f90array4dgetaddrreal
471:   #define f90array4dgetaddrint_         f90array4dgetaddrint
472:   #define f90array4dgetaddrfortranaddr_ f90array4dgetaddrfortranaddr
473: #endif

475: PETSC_EXTERN void f90array4dgetaddrscalar_(void *array, PetscFortranAddr *address)
476: {
477:   *address = (PetscFortranAddr)array;
478: }
479: PETSC_EXTERN void f90array4dgetaddrreal_(void *array, PetscFortranAddr *address)
480: {
481:   *address = (PetscFortranAddr)array;
482: }
483: PETSC_EXTERN void f90array4dgetaddrint_(void *array, PetscFortranAddr *address)
484: {
485:   *address = (PetscFortranAddr)array;
486: }
487: PETSC_EXTERN void f90array4dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
488: {
489:   *address = (PetscFortranAddr)array;
490: }