Actual source code: zvectorf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscvec.h>
3: #include <petscviewer.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define vecsetrandom_ VECSETRANDOM
7: #define vecsetvalueslocal0_ VECSETVALUESLOCAL0
8: #define vecsetvalueslocal11_ VECSETVALUESLOCAL11
9: #define vecsetvalueslocal1_ VECSETVALUESLOCAL1
10: #define vecgetvalues_ VECGETVALUES
11: #define vecgetvalues0_ VECGETVALUES0
12: #define vecgetvalues1_ VECGETVALUES1
13: #define vecgetvalues11_ VECGETVALUES11
14: #define vecsetvalues_ VECSETVALUES
15: #define vecsetvalues0_ VECSETVALUES0
16: #define vecsetvalues1_ VECSETVALUES1
17: #define vecsetvalues11_ VECSETVALUES11
18: #define vecsetvaluesblocked VECSETVALUESBLOCKED
19: #define vecsetvaluesblocked0_ VECSETVALUESBLOCKED0
20: #define vecsetvaluesblocked1_ VECSETVALUESBLOCKED1
21: #define vecsetvaluesblocked11_ VECSETVALUESBLOCKED11
22: #define vecsetvalue_ VECSETVALUE
23: #define vecsetvaluelocal_ VECSETVALUELOCAL
24: #define vecload_ VECLOAD
25: #define vecview_ VECVIEW
26: #define vecgetarray_ VECGETARRAY
27: #define vecgetarrayread_ VECGETARRAYREAD
28: #define vecgetarrayaligned_ VECGETARRAYALIGNED
29: #define vecrestorearray_ VECRESTOREARRAY
30: #define vecrestorearrayread_ VECRESTOREARRAYREAD
31: #define vecduplicatevecs_ VECDUPLICATEVECS
32: #define vecdestroyvecs_ VECDESTROYVECS
33: #define vecmin1_ VECMIN1
34: #define vecmin2_ VECMIN2
35: #define vecmax1_ VECMAX1
36: #define vecmax2_ VECMAX2
37: #define vecgetownershiprange1_ VECGETOWNERSHIPRANGE1
38: #define vecgetownershiprange2_ VECGETOWNERSHIPRANGE2
39: #define vecgetownershiprange3_ VECGETOWNERSHIPRANGE3
40: #define vecgetownershipranges_ VECGETOWNERSHIPRANGES
41: #define vecsetoptionsprefix_ VECSETOPTIONSPREFIX
42: #define vecviewfromoptions_ VECVIEWFROMOPTIONS
43: #define vecstashviewfromoptions_ VECSTASHVIEWFROMOPTIONS
44: #define veccreatefromoptions_ VECCREATEFROMOPTIONS
45: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
46: #define vecsetrandom_ vecsetrandom
47: #define vecsetvalueslocal0_ vecsetvalueslocal0
48: #define vecsetvalueslocal1_ vecsetvalueslocal1
49: #define vecsetvalueslocal11_ vecsetvalueslocal11
50: #define vecgetvalues_ vecgetvalues
51: #define vecgetvalues0_ vecgetvalues0
52: #define vecgetvalues1_ vecgetvalues1
53: #define vecgetvalues11_ vecgetvalues11
54: #define vecsetvalues_ vecsetvalues
55: #define vecsetvalues0_ vecsetvalues0
56: #define vecsetvalues1_ vecsetvalues1
57: #define vecsetvalues11_ vecsetvalues11
58: #define vecsetvaluesblocked_ vecsetvaluesblocked
59: #define vecsetvaluesblocked0_ vecsetvaluesblocked0
60: #define vecsetvaluesblocked1_ vecsetvaluesblocked1
61: #define vecsetvaluesblocked11_ vecsetvaluesblocked11
62: #define vecgetarrayaligned_ vecgetarrayaligned
63: #define vecsetvalue_ vecsetvalue
64: #define vecsetvaluelocal_ vecsetvaluelocal
65: #define vecload_ vecload
66: #define vecview_ vecview
67: #define vecgetarray_ vecgetarray
68: #define vecrestorearray_ vecrestorearray
69: #define vecgetarrayaligned_ vecgetarrayaligned
70: #define vecgetarrayread_ vecgetarrayread
71: #define vecrestorearrayread_ vecrestorearrayread
72: #define vecduplicatevecs_ vecduplicatevecs
73: #define vecdestroyvecs_ vecdestroyvecs
74: #define vecmin1_ vecmin1
75: #define vecmin2_ vecmin2
76: #define vecmax1_ vecmax1
77: #define vecmax2_ vecmax2
78: #define vecgetownershiprange1_ vecgetownershiprange1
79: #define vecgetownershiprange2_ vecgetownershiprange2
80: #define vecgetownershiprange3_ vecgetownershiprange3
81: #define vecgetownershipranges_ vecgetownershipranges
82: #define vecsetoptionsprefix_ vecsetoptionsprefix
83: #define vecviewfromoptions_ vecviewfromoptions
84: #define vecstashviewfromoptions_ vecstashviewfromoptions
85: #define veccreatefromoptions_ veccreatefromoptions
86: #endif
88: PETSC_EXTERN void veccreatefromoptions_(MPI_Fint *comm, char *prefix, PetscInt *bs, PetscInt *m, PetscInt *n, Vec *vec, int *ierr, PETSC_FORTRAN_CHARLEN_T len)
89: {
90: char *fprefix;
92: FIXCHAR(prefix, len, fprefix);
93: *ierr = VecCreateFromOptions(MPI_Comm_f2c(*(comm)), fprefix, *bs, *m, *n, vec);
94: if (*ierr) return;
95: FREECHAR(prefix, fprefix);
96: }
98: PETSC_EXTERN void vecsetvalueslocal_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
99: {
100: *ierr = VecSetValuesLocal(*x, *ni, ix, y, *iora);
101: }
103: PETSC_EXTERN void vecsetvalueslocal0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
104: {
105: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
106: }
108: PETSC_EXTERN void vecsetvalueslocal1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
109: {
110: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
111: }
113: PETSC_EXTERN void vecsetvalueslocal11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
114: {
115: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
116: }
118: PETSC_EXTERN void vecgetvalues_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
119: {
120: *ierr = VecGetValues(*x, *ni, ix, y);
121: }
123: PETSC_EXTERN void vecgetvalues0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
124: {
125: vecgetvalues_(x, ni, ix, y, ierr);
126: }
128: PETSC_EXTERN void vecgetvalues1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
129: {
130: vecgetvalues_(x, ni, ix, y, ierr);
131: }
133: PETSC_EXTERN void vecgetvalues11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
134: {
135: vecgetvalues_(x, ni, ix, y, ierr);
136: }
138: PETSC_EXTERN void vecsetvalues_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
139: {
140: *ierr = VecSetValues(*x, *ni, ix, y, *iora);
141: }
143: PETSC_EXTERN void vecsetvalues0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
144: {
145: vecsetvalues_(x, ni, ix, y, iora, ierr);
146: }
148: PETSC_EXTERN void vecsetvalues1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
149: {
150: vecsetvalues_(x, ni, ix, y, iora, ierr);
151: }
153: PETSC_EXTERN void vecsetvalues11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
154: {
155: vecsetvalues_(x, ni, ix, y, iora, ierr);
156: }
158: PETSC_EXTERN void vecsetvaluesblocked_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
159: {
160: *ierr = VecSetValuesBlocked(*x, *ni, ix, y, *iora);
161: }
163: PETSC_EXTERN void vecsetvaluesblocked0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
164: {
165: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
166: }
168: PETSC_EXTERN void vecsetvaluesblocked1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
169: {
170: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
171: }
173: PETSC_EXTERN void vecsetvaluesblocked11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
174: {
175: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
176: }
178: PETSC_EXTERN void vecsetvalue_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
179: {
180: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
181: *ierr = VecSetValues(*v, 1, i, va, *mode);
182: }
183: PETSC_EXTERN void vecsetvaluelocal_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
184: {
185: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
186: *ierr = VecSetValuesLocal(*v, 1, i, va, *mode);
187: }
189: PETSC_EXTERN void vecload_(Vec *vec, PetscViewer *viewer, PetscErrorCode *ierr)
190: {
191: PetscViewer v;
192: PetscPatchDefaultViewers_Fortran(viewer, v);
193: *ierr = VecLoad(*vec, v);
194: }
196: PETSC_EXTERN void vecview_(Vec *x, PetscViewer *vin, PetscErrorCode *ierr)
197: {
198: PetscViewer v;
200: PetscPatchDefaultViewers_Fortran(vin, v);
201: if (!v) {
202: *ierr = PETSC_ERR_SYS;
203: return;
204: }
205: *ierr = VecView(*x, v);
206: }
208: /*MC
209: VecGetArrayAligned - FORTRAN only. Forces alignment of vector
210: arrays so that arrays of derived types may be used.
212: Synopsis:
213: VecGetArrayAligned(PetscErrorCode ierr)
215: Not Collective
217: Level: advanced
219: Notes:
220: Allows code such as
222: .vb
223: type :: Field
224: PetscScalar :: p1
225: PetscScalar :: p2
226: end type Field
228: type(Field) :: lx_v(0:1)
230: call VecGetArray(localX, lx_v, lx_i, ierr)
231: call InitialGuessLocal(lx_v(lx_i/2), ierr)
233: subroutine InitialGuessLocal(a,ierr)
234: type(Field) :: a(*)
235: .ve
237: If you have not called `VecGetArrayAligned()` the code may generate incorrect data
238: or crash.
240: lx_i needs to be divided by the number of entries in Field (in this case 2)
242: You do NOT need `VecGetArrayAligned()` if lx_v and a are arrays of `PetscScalar`
244: .seealso: `VecGetArray()`, `VecGetArrayF90()`
245: M*/
246: static PetscBool VecGetArrayAligned = PETSC_FALSE;
247: PETSC_EXTERN void vecgetarrayaligned_(PetscErrorCode *ierr)
248: {
249: VecGetArrayAligned = PETSC_TRUE;
250: }
252: PETSC_EXTERN void vecgetarray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
253: {
254: PetscScalar *lx;
255: PetscInt m, bs;
257: *ierr = VecGetArray(*x, &lx);
258: if (*ierr) return;
259: *ierr = VecGetLocalSize(*x, &m);
260: if (*ierr) return;
261: bs = 1;
262: if (VecGetArrayAligned) {
263: *ierr = VecGetBlockSize(*x, &bs);
264: if (*ierr) return;
265: }
266: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, lx, m, ia);
267: }
269: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
270: PETSC_EXTERN void vecrestorearray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
271: {
272: PetscInt m;
273: PetscScalar *lx;
275: *ierr = VecGetLocalSize(*x, &m);
276: if (*ierr) return;
277: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, &lx);
278: if (*ierr) return;
279: *ierr = VecRestoreArray(*x, &lx);
280: if (*ierr) return;
281: }
283: PETSC_EXTERN void vecgetarrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
284: {
285: const PetscScalar *lx;
286: PetscInt m, bs;
288: *ierr = VecGetArrayRead(*x, &lx);
289: if (*ierr) return;
290: *ierr = VecGetLocalSize(*x, &m);
291: if (*ierr) return;
292: bs = 1;
293: if (VecGetArrayAligned) {
294: *ierr = VecGetBlockSize(*x, &bs);
295: if (*ierr) return;
296: }
297: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, (PetscScalar *)lx, m, ia);
298: }
300: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
301: PETSC_EXTERN void vecrestorearrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
302: {
303: PetscInt m;
304: const PetscScalar *lx;
306: *ierr = VecGetLocalSize(*x, &m);
307: if (*ierr) return;
308: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, (PetscScalar **)&lx);
309: if (*ierr) return;
310: *ierr = VecRestoreArrayRead(*x, &lx);
311: if (*ierr) return;
312: }
314: /*
315: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
316: Fortran provides the array to hold the vector objects,while in C that
317: array is allocated by the VecDuplicateVecs()
318: */
319: PETSC_EXTERN void vecduplicatevecs_(Vec *v, PetscInt *m, Vec *newv, PetscErrorCode *ierr)
320: {
321: Vec *lV;
322: PetscInt i;
323: *ierr = VecDuplicateVecs(*v, *m, &lV);
324: if (*ierr) return;
325: for (i = 0; i < *m; i++) newv[i] = lV[i];
326: *ierr = PetscFree(lV);
327: }
329: PETSC_EXTERN void vecdestroyvecs_(PetscInt *m, Vec *vecs, PetscErrorCode *ierr)
330: {
331: PetscInt i;
332: for (i = 0; i < *m; i++) {
333: *ierr = VecDestroy(&vecs[i]);
334: if (*ierr) return;
335: }
336: }
338: PETSC_EXTERN void vecmin1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
339: {
340: CHKFORTRANNULLINTEGER(p);
341: *ierr = VecMin(*x, p, val);
342: }
344: PETSC_EXTERN void vecmin2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
345: {
346: CHKFORTRANNULLINTEGER(p);
347: *ierr = VecMin(*x, p, val);
348: }
350: PETSC_EXTERN void vecmax1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
351: {
352: CHKFORTRANNULLINTEGER(p);
353: *ierr = VecMax(*x, p, val);
354: }
356: PETSC_EXTERN void vecmax2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
357: {
358: CHKFORTRANNULLINTEGER(p);
359: *ierr = VecMax(*x, p, val);
360: }
362: PETSC_EXTERN void vecgetownershiprange1_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
363: {
364: CHKFORTRANNULLINTEGER(low);
365: CHKFORTRANNULLINTEGER(high);
366: *ierr = VecGetOwnershipRange(*x, low, high);
367: }
369: PETSC_EXTERN void vecgetownershiprange2_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
370: {
371: CHKFORTRANNULLINTEGER(low);
372: CHKFORTRANNULLINTEGER(high);
373: *ierr = VecGetOwnershipRange(*x, low, high);
374: }
376: PETSC_EXTERN void vecgetownershiprange3_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
377: {
378: CHKFORTRANNULLINTEGER(low);
379: CHKFORTRANNULLINTEGER(high);
380: *ierr = VecGetOwnershipRange(*x, low, high);
381: }
383: PETSC_EXTERN void vecgetownershipranges_(Vec *x, PetscInt *range, PetscErrorCode *ierr)
384: {
385: PetscMPIInt size, mpi_ierr;
386: const PetscInt *r;
388: mpi_ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*x), &size);
389: if (mpi_ierr) {
390: *ierr = PETSC_ERR_MPI;
391: return;
392: }
393: *ierr = VecGetOwnershipRanges(*x, &r);
394: if (*ierr) return;
395: *ierr = PetscArraycpy(range, r, size + 1);
396: }
398: PETSC_EXTERN void vecsetoptionsprefix_(Vec *v, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
399: {
400: char *t;
402: FIXCHAR(prefix, len, t);
403: *ierr = VecSetOptionsPrefix(*v, t);
404: if (*ierr) return;
405: FREECHAR(prefix, t);
406: }
407: PETSC_EXTERN void vecviewfromoptions_(Vec *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
408: {
409: char *t;
411: FIXCHAR(type, len, t);
412: CHKFORTRANNULLOBJECT(obj);
413: *ierr = VecViewFromOptions(*ao, obj, t);
414: if (*ierr) return;
415: FREECHAR(type, t);
416: }
417: PETSC_EXTERN void vecstashviewfromoptions_(Vec *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
418: {
419: char *t;
421: FIXCHAR(type, len, t);
422: CHKFORTRANNULLOBJECT(obj);
423: *ierr = VecStashViewFromOptions(*ao, obj, t);
424: if (*ierr) return;
425: FREECHAR(type, t);
426: }