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 vecsetvalue_ VECSETVALUE
7: #define vecsetvaluelocal_ VECSETVALUELOCAL
8: #define vecgetarray_ VECGETARRAY
9: #define vecgetarrayread_ VECGETARRAYREAD
10: #define vecgetarrayaligned_ VECGETARRAYALIGNED
11: #define vecrestorearray_ VECRESTOREARRAY
12: #define vecrestorearrayread_ VECRESTOREARRAYREAD
13: #define vecduplicatevecs_ VECDUPLICATEVECS
14: #define vecdestroyvecs_ VECDESTROYVECS
15: #define vecmin1_ VECMIN1
16: #define vecmin2_ VECMIN2
17: #define vecmax1_ VECMAX1
18: #define vecmax2_ VECMAX2
20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
21: #define vecgetarrayaligned_ vecgetarrayaligned
22: #define vecsetvalue_ vecsetvalue
23: #define vecsetvaluelocal_ vecsetvaluelocal
24: #define vecgetarray_ vecgetarray
25: #define vecrestorearray_ vecrestorearray
26: #define vecgetarrayaligned_ vecgetarrayaligned
27: #define vecgetarrayread_ vecgetarrayread
28: #define vecrestorearrayread_ vecrestorearrayread
29: #define vecduplicatevecs_ vecduplicatevecs
30: #define vecdestroyvecs_ vecdestroyvecs
31: #define vecmin1_ vecmin1
32: #define vecmin2_ vecmin2
33: #define vecmax1_ vecmax1
34: #define vecmax2_ vecmax2
35: #endif
37: PETSC_EXTERN void vecsetvalue_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
38: {
39: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
40: *ierr = VecSetValues(*v, 1, i, va, *mode);
41: }
42: PETSC_EXTERN void vecsetvaluelocal_(Vec *v, PetscInt *i, PetscScalar *va, InsertMode *mode, PetscErrorCode *ierr)
43: {
44: /* cannot use VecSetValue() here since that uses PetscCall() which has a return in it */
45: *ierr = VecSetValuesLocal(*v, 1, i, va, *mode);
46: }
48: /*MC
49: VecGetArrayAligned - FORTRAN only. Forces alignment of vector
50: arrays so that arrays of derived types may be used.
52: Synopsis:
53: VecGetArrayAligned(PetscErrorCode ierr)
55: Not Collective
57: Level: advanced
59: Notes:
60: Allows code such as
62: .vb
63: type :: Field
64: PetscScalar :: p1
65: PetscScalar :: p2
66: end type Field
68: type(Field) :: lx_v(0:1)
70: call VecGetArray(localX, lx_v, lx_i, ierr)
71: call InitialGuessLocal(lx_v(lx_i/2), ierr)
73: subroutine InitialGuessLocal(a,ierr)
74: type(Field) :: a(*)
75: .ve
77: If you have not called `VecGetArrayAligned()` the code may generate incorrect data
78: or crash.
80: lx_i needs to be divided by the number of entries in Field (in this case 2)
82: You do NOT need `VecGetArrayAligned()` if lx_v and a are arrays of `PetscScalar`
84: .seealso: `VecGetArray()`, `VecGetArrayF90()`
85: M*/
86: static PetscBool VecGetArrayAligned = PETSC_FALSE;
87: PETSC_EXTERN void vecgetarrayaligned_(PetscErrorCode *ierr)
88: {
89: VecGetArrayAligned = PETSC_TRUE;
90: }
92: PETSC_EXTERN void vecgetarray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
93: {
94: PetscScalar *lx;
95: PetscInt m, bs;
97: *ierr = VecGetArray(*x, &lx);
98: if (*ierr) return;
99: *ierr = VecGetLocalSize(*x, &m);
100: if (*ierr) return;
101: bs = 1;
102: if (VecGetArrayAligned) {
103: *ierr = VecGetBlockSize(*x, &bs);
104: if (*ierr) return;
105: }
106: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, lx, m, ia);
107: }
109: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
110: PETSC_EXTERN void vecrestorearray_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
111: {
112: PetscInt m;
113: PetscScalar *lx;
115: *ierr = VecGetLocalSize(*x, &m);
116: if (*ierr) return;
117: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, &lx);
118: if (*ierr) return;
119: *ierr = VecRestoreArray(*x, &lx);
120: if (*ierr) return;
121: }
123: PETSC_EXTERN void vecgetarrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
124: {
125: const PetscScalar *lx;
126: PetscInt m, bs;
128: *ierr = VecGetArrayRead(*x, &lx);
129: if (*ierr) return;
130: *ierr = VecGetLocalSize(*x, &m);
131: if (*ierr) return;
132: bs = 1;
133: if (VecGetArrayAligned) {
134: *ierr = VecGetBlockSize(*x, &bs);
135: if (*ierr) return;
136: }
137: *ierr = PetscScalarAddressToFortran((PetscObject)*x, bs, fa, (PetscScalar *)lx, m, ia);
138: }
140: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
141: PETSC_EXTERN void vecrestorearrayread_(Vec *x, PetscScalar *fa, size_t *ia, PetscErrorCode *ierr)
142: {
143: PetscInt m;
144: const PetscScalar *lx;
146: *ierr = VecGetLocalSize(*x, &m);
147: if (*ierr) return;
148: *ierr = PetscScalarAddressFromFortran((PetscObject)*x, fa, *ia, m, (PetscScalar **)&lx);
149: if (*ierr) return;
150: *ierr = VecRestoreArrayRead(*x, &lx);
151: if (*ierr) return;
152: }
154: /*
155: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
156: Fortran provides the array to hold the vector objects,while in C that
157: array is allocated by the VecDuplicateVecs()
158: */
159: PETSC_EXTERN void vecduplicatevecs_(Vec *v, PetscInt *m, Vec *newv, PetscErrorCode *ierr)
160: {
161: Vec *lV;
162: PetscInt i;
163: *ierr = VecDuplicateVecs(*v, *m, &lV);
164: if (*ierr) return;
165: for (i = 0; i < *m; i++) newv[i] = lV[i];
166: *ierr = PetscFree(lV);
167: }
169: PETSC_EXTERN void vecdestroyvecs_(PetscInt *m, Vec *vecs, PetscErrorCode *ierr)
170: {
171: PetscInt i;
172: for (i = 0; i < *m; i++) {
173: *ierr = VecDestroy(&vecs[i]);
174: if (*ierr) return;
175: }
176: }
178: PETSC_EXTERN void vecmin1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
179: {
180: CHKFORTRANNULLINTEGER(p);
181: *ierr = VecMin(*x, p, val);
182: }
184: PETSC_EXTERN void vecmin2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
185: {
186: CHKFORTRANNULLINTEGER(p);
187: *ierr = VecMin(*x, p, val);
188: }
190: PETSC_EXTERN void vecmax1_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
191: {
192: CHKFORTRANNULLINTEGER(p);
193: *ierr = VecMax(*x, p, val);
194: }
196: PETSC_EXTERN void vecmax2_(Vec *x, PetscInt *p, PetscReal *val, PetscErrorCode *ierr)
197: {
198: CHKFORTRANNULLINTEGER(p);
199: *ierr = VecMax(*x, p, val);
200: }
202: PETSC_EXTERN void vecgetownershipranges_(Vec *x, PetscInt *range, PetscErrorCode *ierr)
203: {
204: PetscMPIInt size, mpi_ierr;
205: const PetscInt *r;
207: mpi_ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*x), &size);
208: if (mpi_ierr) {
209: *ierr = PETSC_ERR_MPI;
210: return;
211: }
212: *ierr = VecGetOwnershipRanges(*x, &r);
213: if (*ierr) return;
214: *ierr = PetscArraycpy(range, r, size + 1);
215: }