Actual source code: zda1f90.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscdmda.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define dmdavecgetarrayf901_ DMDAVECGETARRAYF901
6: #define dmdavecrestorearrayf901_ DMDAVECRESTOREARRAYF901
7: #define dmdavecgetarrayf902_ DMDAVECGETARRAYF902
8: #define dmdavecrestorearrayf902_ DMDAVECRESTOREARRAYF902
9: #define dmdavecgetarrayf903_ DMDAVECGETARRAYF903
10: #define dmdavecrestorearrayf903_ DMDAVECRESTOREARRAYF903
11: #define dmdavecgetarrayf904_ DMDAVECGETARRAYF904
12: #define dmdavecrestorearrayf904_ DMDAVECRESTOREARRAYF904
13: #define dmdavecgetarrayreadf901_ DMDAVECGETARRAYREADF901
14: #define dmdavecrestorearrayreadf901_ DMDAVECRESTOREARRAYREADF901
15: #define dmdavecgetarrayreadf902_ DMDAVECGETARRAYREADF902
16: #define dmdavecrestorearrayreadf902_ DMDAVECRESTOREARRAYREADF902
17: #define dmdavecgetarrayreadf903_ DMDAVECGETARRAYREADF903
18: #define dmdavecrestorearrayreadf903_ DMDAVECRESTOREARRAYREADF903
19: #define dmdavecgetarrayreadf904_ DMDAVECGETARRAYREADF904
20: #define dmdavecrestorearrayreadf904_ DMDAVECRESTOREARRAYREADF904
21: #define dmdagetelements_ DMDAGETELEMENTS
22: #define dmdarestoreelements_ DMDARESTOREELEMENTS
23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
24: #define dmdavecgetarrayf901_ dmdavecgetarrayf901
25: #define dmdavecrestorearrayf901_ dmdavecrestorearrayf901
26: #define dmdavecgetarrayf902_ dmdavecgetarrayf902
27: #define dmdavecrestorearrayf902_ dmdavecrestorearrayf902
28: #define dmdavecgetarrayf903_ dmdavecgetarrayf903
29: #define dmdavecrestorearrayf903_ dmdavecrestorearrayf903
30: #define dmdavecgetarrayf904_ dmdavecgetarrayf904
31: #define dmdavecrestorearrayf904_ dmdavecrestorearrayf904
32: #define dmdavecgetarrayreadf901_ dmdavecgetarrayreadf901
33: #define dmdavecrestorearrayreadf901_ dmdavecrestorearrayreadf901
34: #define dmdavecgetarrayreadf902_ dmdavecgetarrayreadf902
35: #define dmdavecrestorearrayreadf902_ dmdavecrestorearrayreadf902
36: #define dmdavecgetarrayreadf903_ dmdavecgetarrayreadf903
37: #define dmdavecrestorearrayreadf903_ dmdavecrestorearrayreadf903
38: #define dmdavecgetarrayreadf904_ dmdavecgetarrayreadf904
39: #define dmdavecrestorearrayreadf904_ dmdavecrestorearrayreadf904
40: #define dmdagetelements_ dmdagetelements
41: #define dmdarestoreelements_ dmdarestoreelements
42: #endif
44: PETSC_EXTERN void dmdagetelements_(DM *dm, PetscInt *nel, PetscInt *nen, F90Array1d *e, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
45: {
46: const PetscInt *fa;
48: if (!e) {
49: *ierr = PetscError(((PetscObject)e)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "e==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
50: return;
51: }
52: *ierr = DMDAGetElements(*dm, nel, nen, &fa);
53: if (*ierr) return;
54: *ierr = F90Array1dCreate((PetscInt *)fa, MPIU_INT, 1, (*nel) * (*nen), e PETSC_F90_2PTR_PARAM(ptrd));
55: }
57: PETSC_EXTERN void dmdarestoreelements_(DM *dm, PetscInt *nel, PetscInt *nen, F90Array1d *e, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
58: {
59: if (!e) {
60: *ierr = PetscError(((PetscObject)e)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "e==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
61: return;
62: }
63: *ierr = F90Array1dDestroy(e, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
64: }
66: PETSC_EXTERN void dmdavecgetarrayf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
67: {
68: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
69: PetscScalar *aa;
71: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
72: if (*ierr) return;
73: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
74: if (*ierr) return;
75: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
76: if (*ierr) return;
78: /* Handle case where user passes in global vector as opposed to local */
79: *ierr = VecGetLocalSize(*v, &N);
80: if (*ierr) return;
81: if (N == xm * ym * zm * dof) {
82: gxm = xm;
83: gym = ym;
84: gzm = zm;
85: gxs = xs;
86: gys = ys;
87: gzs = zs;
88: } else if (N != gxm * gym * gzm * dof) {
89: *ierr = PETSC_ERR_ARG_INCOMP;
90: return;
91: }
92: *ierr = VecGetArray(*v, &aa);
93: if (*ierr) return;
94: *ierr = F90Array1dCreate(aa, MPIU_SCALAR, gxs, gxm, a PETSC_F90_2PTR_PARAM(ptrd));
95: if (*ierr) return;
96: }
98: PETSC_EXTERN void dmdavecrestorearrayf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
99: {
100: PetscScalar *fa;
101: *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
102: *ierr = VecRestoreArray(*v, &fa);
103: if (*ierr) return;
104: *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
105: }
107: PETSC_EXTERN void dmdavecgetarrayf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
108: {
109: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
110: PetscScalar *aa;
112: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
113: if (*ierr) return;
114: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
115: if (*ierr) return;
116: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
117: if (*ierr) return;
119: /* Handle case where user passes in global vector as opposed to local */
120: *ierr = VecGetLocalSize(*v, &N);
121: if (*ierr) return;
122: if (N == xm * ym * zm * dof) {
123: gxm = xm;
124: gym = ym;
125: gzm = zm;
126: gxs = xs;
127: gys = ys;
128: gzs = zs;
129: } else if (N != gxm * gym * gzm * dof) {
130: *ierr = PETSC_ERR_ARG_INCOMP;
131: return;
132: }
133: if (dim == 1) {
134: gys = gxs;
135: gym = gxm;
136: gxs = 0;
137: gxm = dof;
138: }
139: *ierr = VecGetArray(*v, &aa);
140: if (*ierr) return;
141: *ierr = F90Array2dCreate(aa, MPIU_SCALAR, gxs, gxm, gys, gym, a PETSC_F90_2PTR_PARAM(ptrd));
142: if (*ierr) return;
143: }
145: PETSC_EXTERN void dmdavecrestorearrayf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
146: {
147: PetscScalar *fa;
148: *ierr = F90Array2dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
149: *ierr = VecRestoreArray(*v, &fa);
150: if (*ierr) return;
151: *ierr = F90Array2dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
152: }
154: PETSC_EXTERN void dmdavecgetarrayf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
155: {
156: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
157: PetscScalar *aa;
159: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
160: if (*ierr) return;
161: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
162: if (*ierr) return;
163: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
164: if (*ierr) return;
166: /* Handle case where user passes in global vector as opposed to local */
167: *ierr = VecGetLocalSize(*v, &N);
168: if (*ierr) return;
169: if (N == xm * ym * zm * dof) {
170: gxm = xm;
171: gym = ym;
172: gzm = zm;
173: gxs = xs;
174: gys = ys;
175: gzs = zs;
176: } else if (N != gxm * gym * gzm * dof) {
177: *ierr = PETSC_ERR_ARG_INCOMP;
178: return;
179: }
180: if (dim == 2) {
181: gzs = gys;
182: gzm = gym;
183: gys = gxs;
184: gym = gxm;
185: gxs = 0;
186: gxm = dof;
187: }
188: *ierr = VecGetArray(*v, &aa);
189: if (*ierr) return;
190: *ierr = F90Array3dCreate(aa, MPIU_SCALAR, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
191: if (*ierr) return;
192: }
194: PETSC_EXTERN void dmdavecrestorearrayf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
195: {
196: PetscScalar *fa;
197: *ierr = F90Array3dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
198: *ierr = VecRestoreArray(*v, &fa);
199: if (*ierr) return;
200: *ierr = F90Array3dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
201: }
203: PETSC_EXTERN void dmdavecgetarrayf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
204: {
205: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof, zero = 0;
206: PetscScalar *aa;
208: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
209: if (*ierr) return;
210: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
211: if (*ierr) return;
212: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
213: if (*ierr) return;
215: /* Handle case where user passes in global vector as opposed to local */
216: *ierr = VecGetLocalSize(*v, &N);
217: if (*ierr) return;
218: if (N == xm * ym * zm * dof) {
219: gxm = xm;
220: gym = ym;
221: gzm = zm;
222: gxs = xs;
223: gys = ys;
224: gzs = zs;
225: } else if (N != gxm * gym * gzm * dof) {
226: *ierr = PETSC_ERR_ARG_INCOMP;
227: return;
228: }
229: *ierr = VecGetArray(*v, &aa);
230: if (*ierr) return;
231: *ierr = F90Array4dCreate(aa, MPIU_SCALAR, zero, dof, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
232: if (*ierr) return;
233: }
235: PETSC_EXTERN void dmdavecrestorearrayf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
236: {
237: PetscScalar *fa;
238: /*
239: F90Array4dAccess is not implemented, so the following call would fail
240: */
241: *ierr = F90Array4dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
242: *ierr = VecRestoreArray(*v, &fa);
243: if (*ierr) return;
244: *ierr = F90Array4dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
245: }
247: PETSC_EXTERN void dmdavecgetarrayreadf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
248: {
249: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
250: const PetscScalar *aa;
252: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
253: if (*ierr) return;
254: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
255: if (*ierr) return;
256: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
257: if (*ierr) return;
259: /* Handle case where user passes in global vector as opposed to local */
260: *ierr = VecGetLocalSize(*v, &N);
261: if (*ierr) return;
262: if (N == xm * ym * zm * dof) {
263: gxm = xm;
264: gym = ym;
265: gzm = zm;
266: gxs = xs;
267: gys = ys;
268: gzs = zs;
269: } else if (N != gxm * gym * gzm * dof) {
270: *ierr = PETSC_ERR_ARG_INCOMP;
271: return;
272: }
273: *ierr = VecGetArrayRead(*v, &aa);
274: if (*ierr) return;
275: *ierr = F90Array1dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, a PETSC_F90_2PTR_PARAM(ptrd));
276: if (*ierr) return;
277: }
279: PETSC_EXTERN void dmdavecrestorearrayreadf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
280: {
281: const PetscScalar *fa;
282: *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
283: *ierr = VecRestoreArrayRead(*v, &fa);
284: if (*ierr) return;
285: *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
286: }
288: PETSC_EXTERN void dmdavecgetarrayreadf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
289: {
290: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
291: const PetscScalar *aa;
293: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
294: if (*ierr) return;
295: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
296: if (*ierr) return;
297: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
298: if (*ierr) return;
300: /* Handle case where user passes in global vector as opposed to local */
301: *ierr = VecGetLocalSize(*v, &N);
302: if (*ierr) return;
303: if (N == xm * ym * zm * dof) {
304: gxm = xm;
305: gym = ym;
306: gzm = zm;
307: gxs = xs;
308: gys = ys;
309: gzs = zs;
310: } else if (N != gxm * gym * gzm * dof) {
311: *ierr = PETSC_ERR_ARG_INCOMP;
312: return;
313: }
314: if (dim == 1) {
315: gys = gxs;
316: gym = gxm;
317: gxs = 0;
318: gxm = dof;
319: }
320: *ierr = VecGetArrayRead(*v, &aa);
321: if (*ierr) return;
322: *ierr = F90Array2dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, gys, gym, a PETSC_F90_2PTR_PARAM(ptrd));
323: if (*ierr) return;
324: }
326: PETSC_EXTERN void dmdavecrestorearrayreadf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
327: {
328: const PetscScalar *fa;
329: *ierr = F90Array2dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
330: *ierr = VecRestoreArrayRead(*v, &fa);
331: if (*ierr) return;
332: *ierr = F90Array2dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
333: }
335: PETSC_EXTERN void dmdavecgetarrayreadf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
336: {
337: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
338: const PetscScalar *aa;
340: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
341: if (*ierr) return;
342: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
343: if (*ierr) return;
344: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
345: if (*ierr) return;
347: /* Handle case where user passes in global vector as opposed to local */
348: *ierr = VecGetLocalSize(*v, &N);
349: if (*ierr) return;
350: if (N == xm * ym * zm * dof) {
351: gxm = xm;
352: gym = ym;
353: gzm = zm;
354: gxs = xs;
355: gys = ys;
356: gzs = zs;
357: } else if (N != gxm * gym * gzm * dof) {
358: *ierr = PETSC_ERR_ARG_INCOMP;
359: return;
360: }
361: if (dim == 2) {
362: gzs = gys;
363: gzm = gym;
364: gys = gxs;
365: gym = gxm;
366: gxs = 0;
367: gxm = dof;
368: }
369: *ierr = VecGetArrayRead(*v, &aa);
370: if (*ierr) return;
371: *ierr = F90Array3dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
372: if (*ierr) return;
373: }
375: PETSC_EXTERN void dmdavecrestorearrayreadf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
376: {
377: const PetscScalar *fa;
378: *ierr = F90Array3dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
379: *ierr = VecRestoreArrayRead(*v, &fa);
380: if (*ierr) return;
381: *ierr = F90Array3dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
382: }
384: PETSC_EXTERN void dmdavecgetarrayreadf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
385: {
386: PetscInt xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof, zero = 0;
387: const PetscScalar *aa;
389: *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
390: if (*ierr) return;
391: *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
392: if (*ierr) return;
393: *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
394: if (*ierr) return;
396: /* Handle case where user passes in global vector as opposed to local */
397: *ierr = VecGetLocalSize(*v, &N);
398: if (*ierr) return;
399: if (N == xm * ym * zm * dof) {
400: gxm = xm;
401: gym = ym;
402: gzm = zm;
403: gxs = xs;
404: gys = ys;
405: gzs = zs;
406: } else if (N != gxm * gym * gzm * dof) {
407: *ierr = PETSC_ERR_ARG_INCOMP;
408: return;
409: }
410: *ierr = VecGetArrayRead(*v, &aa);
411: if (*ierr) return;
412: *ierr = F90Array4dCreate((void *)aa, MPIU_SCALAR, zero, dof, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
413: if (*ierr) return;
414: }
416: PETSC_EXTERN void dmdavecrestorearrayreadf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
417: {
418: const PetscScalar *fa;
419: /*
420: F90Array4dAccess is not implemented, so the following call would fail
421: */
422: *ierr = F90Array4dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
423: *ierr = VecRestoreArrayRead(*v, &fa);
424: if (*ierr) return;
425: *ierr = F90Array4dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
426: }