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: }