Actual source code: zvectorf90.c
1: #include <petscvec.h>
2: #include <petsc/private/ftnimpl.h>
4: #if PetscDefined(HAVE_FORTRAN_CAPS)
5: #define vecgetarraywrite_ VECGETARRAYWRITE
6: #define vecrestorearraywrite_ VECRESTOREARRAYWRITE
7: #define vecgetarray_ VECGETARRAY
8: #define vecrestorearray_ VECRESTOREARRAY
9: #define vecgetarrayread_ VECGETARRAYREAD
10: #define vecrestorearrayread_ VECRESTOREARRAYREAD
11: #define vecduplicatevecs_ VECDUPLICATEVECS
12: #define vecdestroyvecs_ VECDESTROYVECS
13: #define veccudagetarray_ VECCUDAGETARRAY
14: #define veccudarestorearray_ VECCUDARESTOREARRAY
15: #define veccudagetarrayread_ VECCUDAGETARRAYREAD
16: #define veccudarestorearrayread_ VECCUDARESTOREARRAYREAD
17: #define veccudagetarraywrite_ VECCUDAGETARRAYWRITE
18: #define veccudarestorearraywrite_ VECCUDARESTOREARRAYWRITE
19: #define vechipgetarray_ VECHIPGETARRAY
20: #define vechiprestorearray_ VECHIPRESTOREARRAY
21: #define vechipgetarrayread_ VECHIPGETARRAYREAD
22: #define vechiprestorearrayread_ VECHIPRESTOREARRAYREAD
23: #define vechipgetarraywrite_ VECHIPGETARRAYWRITE
24: #define vechiprestorearraywrite_ VECHIPRESTOREARRAYWRITE
25: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
26: #define vecgetarraywrite_ vecgetarraywrite
27: #define vecrestorearraywrite_ vecrestorearraywrite
28: #define vecgetarray_ vecgetarray
29: #define vecrestorearray_ vecrestorearray
30: #define vecgetarrayread_ vecgetarrayread
31: #define vecrestorearrayread_ vecrestorearrayread
32: #define vecduplicatevecs_ vecduplicatevecs
33: #define vecdestroyvecs_ vecdestroyvecs
34: #define veccudagetarray_ veccudagetarray
35: #define veccudarestorearray_ veccudarestorearray
36: #define veccudagetarrayread_ veccudagetarrayread
37: #define veccudarestorearrayread_ veccudarestorearrayread
38: #define veccudagetarraywrite_ veccudagetarraywrite
39: #define veccudarestorearraywrite_ veccudarestorearraywrite
40: #define vechipgetarray_ vechipgetarray
41: #define vechiprestorearray_ vechiprestorearray
42: #define vechipgetarrayread_ vechipgetarrayread
43: #define vechiprestorearrayread_ vechiprestorearrayread
44: #define vechipgetarraywrite_ vechipgetarraywrite
45: #define vechiprestorearraywrite_ vechiprestorearraywrite
46: #endif
48: PETSC_EXTERN void vecgetarraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
49: {
50: PetscScalar *fa;
51: PetscInt len;
52: if (!ptr) {
53: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
54: return;
55: }
56: *ierr = VecGetArrayWrite(*x, &fa);
57: if (*ierr) return;
58: *ierr = VecGetLocalSize(*x, &len);
59: if (*ierr) return;
60: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
61: }
63: PETSC_EXTERN void vecrestorearraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
64: {
65: PetscScalar *fa;
66: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
67: if (*ierr) return;
68: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
69: if (*ierr) return;
70: *ierr = VecRestoreArrayWrite(*x, &fa);
71: }
73: PETSC_EXTERN void vecgetarray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
74: {
75: PetscScalar *fa;
76: PetscInt len;
77: if (!ptr) {
78: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
79: return;
80: }
81: *ierr = VecGetArray(*x, &fa);
82: if (*ierr) return;
83: *ierr = VecGetLocalSize(*x, &len);
84: if (*ierr) return;
85: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
86: }
88: PETSC_EXTERN void vecrestorearray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
89: {
90: PetscScalar *fa;
91: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
92: if (*ierr) return;
93: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
94: if (*ierr) return;
95: *ierr = VecRestoreArray(*x, &fa);
96: }
98: PETSC_EXTERN void vecgetarrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
99: {
100: const PetscScalar *fa;
101: PetscInt len;
102: if (!ptr) {
103: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
104: return;
105: }
106: *ierr = VecGetArrayRead(*x, &fa);
107: if (*ierr) return;
108: *ierr = VecGetLocalSize(*x, &len);
109: if (*ierr) return;
110: *ierr = F90Array1dCreate((PetscScalar *)fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
111: }
113: PETSC_EXTERN void vecrestorearrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
114: {
115: const PetscScalar *fa;
116: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
117: if (*ierr) return;
118: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
119: if (*ierr) return;
120: *ierr = VecRestoreArrayRead(*x, &fa);
121: }
123: PETSC_EXTERN void veccudagetarray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
124: {
125: PetscScalar *fa = NULL;
126: PetscInt len;
127: if (!ptr) {
128: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
129: return;
130: }
131: *ierr = VecCUDAGetArray(*x, &fa);
132: if (*ierr) return;
133: *ierr = VecGetLocalSize(*x, &len);
134: if (*ierr) return;
135: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
136: }
138: PETSC_EXTERN void veccudarestorearray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
139: {
140: PetscScalar *fa;
141: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
142: if (*ierr) return;
143: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
144: if (*ierr) return;
145: *ierr = VecCUDARestoreArray(*x, &fa);
146: }
148: PETSC_EXTERN void veccudagetarrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
149: {
150: const PetscScalar *fa = NULL;
151: PetscInt len;
152: if (!ptr) {
153: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
154: return;
155: }
156: *ierr = VecCUDAGetArrayRead(*x, &fa);
157: if (*ierr) return;
158: *ierr = VecGetLocalSize(*x, &len);
159: if (*ierr) return;
160: *ierr = F90Array1dCreate((PetscScalar *)fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
161: }
163: PETSC_EXTERN void veccudarestorearrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
164: {
165: const PetscScalar *fa;
166: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
167: if (*ierr) return;
168: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
169: if (*ierr) return;
170: *ierr = VecCUDARestoreArrayRead(*x, &fa);
171: }
173: PETSC_EXTERN void veccudagetarraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
174: {
175: PetscScalar *fa = NULL;
176: PetscInt len;
177: if (!ptr) {
178: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
179: return;
180: }
181: *ierr = VecCUDAGetArrayWrite(*x, &fa);
182: if (*ierr) return;
183: *ierr = VecGetLocalSize(*x, &len);
184: if (*ierr) return;
185: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
186: }
188: PETSC_EXTERN void veccudarestorearraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
189: {
190: PetscScalar *fa;
191: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
192: if (*ierr) return;
193: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
194: if (*ierr) return;
195: *ierr = VecCUDARestoreArrayWrite(*x, &fa);
196: }
198: PETSC_EXTERN void vechipgetarray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
199: {
200: PetscScalar *fa = NULL;
201: PetscInt len;
202: if (!ptr) {
203: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
204: return;
205: }
206: *ierr = VecHIPGetArray(*x, &fa);
207: if (*ierr) return;
208: *ierr = VecGetLocalSize(*x, &len);
209: if (*ierr) return;
210: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
211: }
213: PETSC_EXTERN void vechiprestorearray_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
214: {
215: PetscScalar *fa;
216: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
217: if (*ierr) return;
218: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
219: if (*ierr) return;
220: *ierr = VecHIPRestoreArray(*x, &fa);
221: }
223: PETSC_EXTERN void vechipgetarrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
224: {
225: const PetscScalar *fa = NULL;
226: PetscInt len;
227: if (!ptr) {
228: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
229: return;
230: }
231: *ierr = VecHIPGetArrayRead(*x, &fa);
232: if (*ierr) return;
233: *ierr = VecGetLocalSize(*x, &len);
234: if (*ierr) return;
235: *ierr = F90Array1dCreate((PetscScalar *)fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
236: }
238: PETSC_EXTERN void vechiprestorearrayread_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
239: {
240: const PetscScalar *fa;
241: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
242: if (*ierr) return;
243: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
244: if (*ierr) return;
245: *ierr = VecHIPRestoreArrayRead(*x, &fa);
246: }
248: PETSC_EXTERN void vechipgetarraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
249: {
250: PetscScalar *fa = NULL;
251: PetscInt len;
252: if (!ptr) {
253: *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
254: return;
255: }
256: *ierr = VecHIPGetArrayWrite(*x, &fa);
257: if (*ierr) return;
258: *ierr = VecGetLocalSize(*x, &len);
259: if (*ierr) return;
260: *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
261: }
263: PETSC_EXTERN void vechiprestorearraywrite_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
264: {
265: PetscScalar *fa;
266: *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
267: if (*ierr) return;
268: *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
269: if (*ierr) return;
270: *ierr = VecHIPRestoreArrayWrite(*x, &fa);
271: }
273: PETSC_EXTERN void vecduplicatevecs_(Vec *v, int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
274: {
275: Vec *lV;
276: PetscFortranAddr *newvint;
277: int i;
278: *ierr = VecDuplicateVecs(*v, *m, &lV);
279: if (*ierr) return;
280: *ierr = PetscMalloc1(*m, &newvint);
281: if (*ierr) return;
283: for (i = 0; i < *m; i++) newvint[i] = (PetscFortranAddr)lV[i];
284: *ierr = PetscFree(lV);
285: if (*ierr) return;
286: *ierr = F90Array1dCreate(newvint, MPIU_FORTRANADDR, 1, *m, ptr PETSC_F90_2PTR_PARAM(ptrd));
287: }
289: PETSC_EXTERN void vecdestroyvecs_(int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
290: {
291: Vec *vecs;
292: int i;
294: *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&vecs PETSC_F90_2PTR_PARAM(ptrd));
295: if (*ierr) return;
296: for (i = 0; i < *m; i++) {
297: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&vecs[i]);
298: *ierr = VecDestroy(&vecs[i]);
299: if (*ierr) return;
300: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(&vecs[i]);
301: }
302: *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
303: if (*ierr) return;
304: *ierr = PetscFree(vecs);
305: }