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: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
45: #define vecsetrandom_ vecsetrandom
46: #define vecsetvalueslocal0_ vecsetvalueslocal0
47: #define vecsetvalueslocal1_ vecsetvalueslocal1
48: #define vecsetvalueslocal11_ vecsetvalueslocal11
49: #define vecgetvalues_ vecgetvalues
50: #define vecgetvalues0_ vecgetvalues0
51: #define vecgetvalues1_ vecgetvalues1
52: #define vecgetvalues11_ vecgetvalues11
53: #define vecsetvalues_ vecsetvalues
54: #define vecsetvalues0_ vecsetvalues0
55: #define vecsetvalues1_ vecsetvalues1
56: #define vecsetvalues11_ vecsetvalues11
57: #define vecsetvaluesblocked_ vecsetvaluesblocked
58: #define vecsetvaluesblocked0_ vecsetvaluesblocked0
59: #define vecsetvaluesblocked1_ vecsetvaluesblocked1
60: #define vecsetvaluesblocked11_ vecsetvaluesblocked11
61: #define vecgetarrayaligned_ vecgetarrayaligned
62: #define vecsetvalue_ vecsetvalue
63: #define vecsetvaluelocal_ vecsetvaluelocal
64: #define vecload_ vecload
65: #define vecview_ vecview
66: #define vecgetarray_ vecgetarray
67: #define vecrestorearray_ vecrestorearray
68: #define vecgetarrayaligned_ vecgetarrayaligned
69: #define vecgetarrayread_ vecgetarrayread
70: #define vecrestorearrayread_ vecrestorearrayread
71: #define vecduplicatevecs_ vecduplicatevecs
72: #define vecdestroyvecs_ vecdestroyvecs
73: #define vecmin1_ vecmin1
74: #define vecmin2_ vecmin2
75: #define vecmax1_ vecmax1
76: #define vecmax2_ vecmax2
77: #define vecgetownershiprange1_ vecgetownershiprange1
78: #define vecgetownershiprange2_ vecgetownershiprange2
79: #define vecgetownershiprange3_ vecgetownershiprange3
80: #define vecgetownershipranges_ vecgetownershipranges
81: #define vecsetoptionsprefix_ vecsetoptionsprefix
82: #define vecviewfromoptions_ vecviewfromoptions
83: #define vecstashviewfromoptions_ vecstashviewfromoptions
84: #endif
86: PETSC_EXTERN void vecsetvalueslocal_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
87: {
88: *ierr = VecSetValuesLocal(*x, *ni, ix, y, *iora);
89: }
91: PETSC_EXTERN void vecsetvalueslocal0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
92: {
93: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
94: }
96: PETSC_EXTERN void vecsetvalueslocal1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
97: {
98: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
99: }
101: PETSC_EXTERN void vecsetvalueslocal11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
102: {
103: vecsetvalueslocal_(x, ni, ix, y, iora, ierr);
104: }
106: PETSC_EXTERN void vecgetvalues_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
107: {
108: *ierr = VecGetValues(*x, *ni, ix, y);
109: }
111: PETSC_EXTERN void vecgetvalues0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
112: {
113: vecgetvalues_(x, ni, ix, y, ierr);
114: }
116: PETSC_EXTERN void vecgetvalues1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
117: {
118: vecgetvalues_(x, ni, ix, y, ierr);
119: }
121: PETSC_EXTERN void vecgetvalues11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], int *ierr)
122: {
123: vecgetvalues_(x, ni, ix, y, ierr);
124: }
126: PETSC_EXTERN void vecsetvalues_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
127: {
128: *ierr = VecSetValues(*x, *ni, ix, y, *iora);
129: }
131: PETSC_EXTERN void vecsetvalues0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
132: {
133: vecsetvalues_(x, ni, ix, y, iora, ierr);
134: }
136: PETSC_EXTERN void vecsetvalues1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
137: {
138: vecsetvalues_(x, ni, ix, y, iora, ierr);
139: }
141: PETSC_EXTERN void vecsetvalues11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
142: {
143: vecsetvalues_(x, ni, ix, y, iora, ierr);
144: }
146: PETSC_EXTERN void vecsetvaluesblocked_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
147: {
148: *ierr = VecSetValuesBlocked(*x, *ni, ix, y, *iora);
149: }
151: PETSC_EXTERN void vecsetvaluesblocked0_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
152: {
153: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
154: }
156: PETSC_EXTERN void vecsetvaluesblocked1_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
157: {
158: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
159: }
161: PETSC_EXTERN void vecsetvaluesblocked11_(Vec *x, PetscInt *ni, PetscInt ix[], PetscScalar y[], InsertMode *iora, int *ierr)
162: {
163: vecsetvaluesblocked_(x, ni, ix, y, iora, ierr);
164: }
166: PETSC_EXTERN void vecsetvalue_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
167: {
168: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
169: *ierr = VecSetValues(*v, 1, i, va, *mode);
170: }
171: PETSC_EXTERN void vecsetvaluelocal_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
172: {
173: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
174: *ierr = VecSetValuesLocal(*v, 1, i, va, *mode);
175: }
177: PETSC_EXTERN void vecload_(Vec *vec, PetscViewer *viewer, PetscErrorCode *ierr)
178: {
179: PetscViewer v;
180: PetscPatchDefaultViewers_Fortran(viewer, v);
181: *ierr = VecLoad(*vec, v);
182: }
184: PETSC_EXTERN void vecview_(Vec *x, PetscViewer *vin, PetscErrorCode *ierr)
185: {
186: PetscViewer v;
188: PetscPatchDefaultViewers_Fortran(vin, v);
189: if (!v) {
190: *ierr = PETSC_ERR_SYS;
191: return;
192: }
193: *ierr = VecView(*x, v);
194: }
196: /*MC
197: VecGetArrayAligned - FORTRAN only. Forces alignment of vector
198: arrays so that arrays of derived types may be used.
200: Synopsis:
201: VecGetArrayAligned(PetscErrorCode ierr)
203: Not Collective
205: Level: advanced
207: Notes:
208: Allows code such as
210: .vb
211: type :: Field
212: PetscScalar :: p1
213: PetscScalar :: p2
214: end type Field
216: type(Field) :: lx_v(0:1)
218: call VecGetArray(localX, lx_v, lx_i, ierr)
219: call InitialGuessLocal(lx_v(lx_i/2), ierr)
221: subroutine InitialGuessLocal(a,ierr)
222: type(Field) :: a(*)
223: .ve
225: If you have not called `VecGetArrayAligned()` the code may generate incorrect data
226: or crash.
228: lx_i needs to be divided by the number of entries in Field (in this case 2)
230: You do NOT need `VecGetArrayAligned()` if lx_v and a are arrays of `PetscScalar`
232: .seealso: `VecGetArray()`, `VecGetArrayF90()`
233: M*/
234: static PetscBool VecGetArrayAligned = PETSC_FALSE;
235: PETSC_EXTERN void vecgetarrayaligned_(PetscErrorCode *ierr)
236: {
237: VecGetArrayAligned = PETSC_TRUE;
238: }
240: PETSC_EXTERN void vecgetarray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
241: {
242: PetscScalar *lx;
243: PetscInt m, bs;
245: *ierr = VecGetArray(*x, &lx);
246: if (*ierr) return;
247: *ierr = VecGetLocalSize(*x, &m);
248: if (*ierr) return;
249: bs = 1;
250: if (VecGetArrayAligned) {
251: *ierr = VecGetBlockSize(*x, &bs);
252: if (*ierr) return;
253: }
254: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, lx, m, ia);
255: }
257: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
258: PETSC_EXTERN void vecrestorearray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
259: {
260: PetscInt m;
261: PetscScalar *lx;
263: *ierr = VecGetLocalSize(*x, &m);
264: if (*ierr) return;
265: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, &lx);
266: if (*ierr) return;
267: *ierr = VecRestoreArray(*x, &lx);
268: if (*ierr) return;
269: }
271: PETSC_EXTERN void vecgetarrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
272: {
273: const PetscScalar *lx;
274: PetscInt m, bs;
276: *ierr = VecGetArrayRead(*x, &lx);
277: if (*ierr) return;
278: *ierr = VecGetLocalSize(*x, &m);
279: if (*ierr) return;
280: bs = 1;
281: if (VecGetArrayAligned) {
282: *ierr = VecGetBlockSize(*x, &bs);
283: if (*ierr) return;
284: }
285: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, (PetscScalar *)lx, m, ia);
286: }
288: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
289: PETSC_EXTERN void vecrestorearrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
290: {
291: PetscInt m;
292: const PetscScalar *lx;
294: *ierr = VecGetLocalSize(*x, &m);
295: if (*ierr) return;
296: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, (PetscScalar **)&lx);
297: if (*ierr) return;
298: *ierr = VecRestoreArrayRead(*x, &lx);
299: if (*ierr) return;
300: }
302: /*
303: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
304: Fortran provides the array to hold the vector objects,while in C that
305: array is allocated by the VecDuplicateVecs()
306: */
307: PETSC_EXTERN void vecduplicatevecs_(Vec *v, PetscInt *m, Vec *newv, PetscErrorCode *ierr)
308: {
309: Vec *lV;
310: PetscInt i;
311: *ierr = VecDuplicateVecs(*v, *m, &lV);
312: if (*ierr) return;
313: for (i = 0; i < *m; i++) newv[i] = lV[i];
314: *ierr = PetscFree(lV);
315: }
317: PETSC_EXTERN void vecdestroyvecs_(PetscInt *m, Vec *vecs, PetscErrorCode *ierr)
318: {
319: PetscInt i;
320: for (i = 0; i < *m; i++) {
321: *ierr = VecDestroy(&vecs[i]);
322: if (*ierr) return;
323: }
324: }
326: PETSC_EXTERN void vecmin1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
327: {
328: CHKFORTRANNULLINTEGER(p);
329: *ierr = VecMin(*x, p, val);
330: }
332: PETSC_EXTERN void vecmin2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
333: {
334: CHKFORTRANNULLINTEGER(p);
335: *ierr = VecMin(*x, p, val);
336: }
338: PETSC_EXTERN void vecmax1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
339: {
340: CHKFORTRANNULLINTEGER(p);
341: *ierr = VecMax(*x, p, val);
342: }
344: PETSC_EXTERN void vecmax2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
345: {
346: CHKFORTRANNULLINTEGER(p);
347: *ierr = VecMax(*x, p, val);
348: }
350: PETSC_EXTERN void vecgetownershiprange1_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
351: {
352: CHKFORTRANNULLINTEGER(low);
353: CHKFORTRANNULLINTEGER(high);
354: *ierr = VecGetOwnershipRange(*x, low, high);
355: }
357: PETSC_EXTERN void vecgetownershiprange2_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
358: {
359: CHKFORTRANNULLINTEGER(low);
360: CHKFORTRANNULLINTEGER(high);
361: *ierr = VecGetOwnershipRange(*x, low, high);
362: }
364: PETSC_EXTERN void vecgetownershiprange3_(Vec *x, PetscInt *low, PetscInt *high, PetscErrorCode *ierr)
365: {
366: CHKFORTRANNULLINTEGER(low);
367: CHKFORTRANNULLINTEGER(high);
368: *ierr = VecGetOwnershipRange(*x, low, high);
369: }
371: PETSC_EXTERN void vecgetownershipranges_(Vec *x, PetscInt *range, PetscErrorCode *ierr)
372: {
373: PetscMPIInt size, mpi_ierr;
374: const PetscInt *r;
376: mpi_ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*x), &size);
377: if (mpi_ierr) {
378: *ierr = PETSC_ERR_MPI;
379: return;
380: }
381: *ierr = VecGetOwnershipRanges(*x, &r);
382: if (*ierr) return;
383: *ierr = PetscArraycpy(range, r, size + 1);
384: }
386: PETSC_EXTERN void vecsetoptionsprefix_(Vec *v, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
387: {
388: char *t;
390: FIXCHAR(prefix, len, t);
391: *ierr = VecSetOptionsPrefix(*v, t);
392: if (*ierr) return;
393: FREECHAR(prefix, t);
394: }
395: PETSC_EXTERN void vecviewfromoptions_(Vec *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
396: {
397: char *t;
399: FIXCHAR(type, len, t);
400: CHKFORTRANNULLOBJECT(obj);
401: *ierr = VecViewFromOptions(*ao, obj, t);
402: if (*ierr) return;
403: FREECHAR(type, t);
404: }
405: PETSC_EXTERN void vecstashviewfromoptions_(Vec *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
406: {
407: char *t;
409: FIXCHAR(type, len, t);
410: CHKFORTRANNULLOBJECT(obj);
411: *ierr = VecStashViewFromOptions(*ao, obj, t);
412: if (*ierr) return;
413: FREECHAR(type, t);
414: }