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