Date: 2025-03-28T21:10:44+00:00

Actual source code: zda1f90.c

      1: #include <petsc/private/f90impl.h>
      2: #include <petscdmda.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define dmdagetlocalinfof90_         DMDAGETLOCALINFOF90
      6:   #define dmdavecgetarrayf901_         DMDAVECGETARRAYF901
      7:   #define dmdavecrestorearrayf901_     DMDAVECRESTOREARRAYF901
      8:   #define dmdavecgetarrayf902_         DMDAVECGETARRAYF902
      9:   #define dmdavecrestorearrayf902_     DMDAVECRESTOREARRAYF902
     10:   #define dmdavecgetarrayf903_         DMDAVECGETARRAYF903
     11:   #define dmdavecrestorearrayf903_     DMDAVECRESTOREARRAYF903
     12:   #define dmdavecgetarrayf904_         DMDAVECGETARRAYF904
     13:   #define dmdavecrestorearrayf904_     DMDAVECRESTOREARRAYF904
     14:   #define dmdavecgetarrayreadf901_     DMDAVECGETARRAYREADF901
     15:   #define dmdavecrestorearrayreadf901_ DMDAVECRESTOREARRAYREADF901
     16:   #define dmdavecgetarrayreadf902_     DMDAVECGETARRAYREADF902
     17:   #define dmdavecrestorearrayreadf902_ DMDAVECRESTOREARRAYREADF902
     18:   #define dmdavecgetarrayreadf903_     DMDAVECGETARRAYREADF903
     19:   #define dmdavecrestorearrayreadf903_ DMDAVECRESTOREARRAYREADF903
     20:   #define dmdavecgetarrayreadf904_     DMDAVECGETARRAYREADF904
     21:   #define dmdavecrestorearrayreadf904_ DMDAVECRESTOREARRAYREADF904
     22:   #define dmdagetelements_             DMDAGETELEMENTS
     23:   #define dmdarestoreelements_         DMDARESTOREELEMENTS
     24: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     25:   #define dmdagetlocalinfof90_         dmdagetlocalinfof90
     26:   #define dmdavecgetarrayf901_         dmdavecgetarrayf901
     27:   #define dmdavecrestorearrayf901_     dmdavecrestorearrayf901
     28:   #define dmdavecgetarrayf902_         dmdavecgetarrayf902
     29:   #define dmdavecrestorearrayf902_     dmdavecrestorearrayf902
     30:   #define dmdavecgetarrayf903_         dmdavecgetarrayf903
     31:   #define dmdavecrestorearrayf903_     dmdavecrestorearrayf903
     32:   #define dmdavecgetarrayf904_         dmdavecgetarrayf904
     33:   #define dmdavecrestorearrayf904_     dmdavecrestorearrayf904
     34:   #define dmdavecgetarrayreadf901_     dmdavecgetarrayreadf901
     35:   #define dmdavecrestorearrayreadf901_ dmdavecrestorearrayreadf901
     36:   #define dmdavecgetarrayreadf902_     dmdavecgetarrayreadf902
     37:   #define dmdavecrestorearrayreadf902_ dmdavecrestorearrayreadf902
     38:   #define dmdavecgetarrayreadf903_     dmdavecgetarrayreadf903
     39:   #define dmdavecrestorearrayreadf903_ dmdavecrestorearrayreadf903
     40:   #define dmdavecgetarrayreadf904_     dmdavecgetarrayreadf904
     41:   #define dmdavecrestorearrayreadf904_ dmdavecrestorearrayreadf904
     42:   #define dmdagetelements_             dmdagetelements
     43:   #define dmdarestoreelements_         dmdarestoreelements
     44: #endif

     46: PETSC_EXTERN void dmdagetelements_(DM *dm, PetscInt *nel, PetscInt *nen, F90Array1d *e, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     47: {
     48:   const PetscInt *fa;

     50:   if (!e) {
     51:     *ierr = PetscError(((PetscObject)e)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "e==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
     52:     return;
     53:   }
     54:   *ierr = DMDAGetElements(*dm, nel, nen, &fa);
     55:   if (*ierr) return;
     56:   *ierr = F90Array1dCreate((PetscInt *)fa, MPIU_INT, 1, (*nel) * (*nen), e PETSC_F90_2PTR_PARAM(ptrd));
     57: }

     59: PETSC_EXTERN void dmdarestoreelements_(DM *dm, PetscInt *nel, PetscInt *nen, F90Array1d *e, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     60: {
     61:   if (!e) {
     62:     *ierr = PetscError(((PetscObject)e)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "e==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
     63:     return;
     64:   }
     65:   *ierr = F90Array1dDestroy(e, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
     66: }

     68: PETSC_EXTERN void dmdagetlocalinfof90_(DM *da, DMDALocalInfo *info, PetscErrorCode *ierr)
     69: {
     70:   *ierr = DMDAGetLocalInfo(*da, info);
     71: }

     73: PETSC_EXTERN void dmdavecgetarrayf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
     74: {
     75:   PetscInt     xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
     76:   PetscScalar *aa;

     78:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
     79:   if (*ierr) return;
     80:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
     81:   if (*ierr) return;
     82:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
     83:   if (*ierr) return;

     85:   /* Handle case where user passes in global vector as opposed to local */
     86:   *ierr = VecGetLocalSize(*v, &N);
     87:   if (*ierr) return;
     88:   if (N == xm * ym * zm * dof) {
     89:     gxm = xm;
     90:     gym = ym;
     91:     gzm = zm;
     92:     gxs = xs;
     93:     gys = ys;
     94:     gzs = zs;
     95:   } else if (N != gxm * gym * gzm * dof) {
     96:     *ierr = PETSC_ERR_ARG_INCOMP;
     97:     return;
     98:   }
     99:   *ierr = VecGetArray(*v, &aa);
    100:   if (*ierr) return;
    101:   *ierr = F90Array1dCreate(aa, MPIU_SCALAR, gxs, gxm, a PETSC_F90_2PTR_PARAM(ptrd));
    102:   if (*ierr) return;
    103: }

    105: PETSC_EXTERN void dmdavecrestorearrayf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    106: {
    107:   PetscScalar *fa;
    108:   *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    109:   *ierr = VecRestoreArray(*v, &fa);
    110:   if (*ierr) return;
    111:   *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    112: }

    114: PETSC_EXTERN void dmdavecgetarrayf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    115: {
    116:   PetscInt     xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
    117:   PetscScalar *aa;

    119:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    120:   if (*ierr) return;
    121:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    122:   if (*ierr) return;
    123:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    124:   if (*ierr) return;

    126:   /* Handle case where user passes in global vector as opposed to local */
    127:   *ierr = VecGetLocalSize(*v, &N);
    128:   if (*ierr) return;
    129:   if (N == xm * ym * zm * dof) {
    130:     gxm = xm;
    131:     gym = ym;
    132:     gzm = zm;
    133:     gxs = xs;
    134:     gys = ys;
    135:     gzs = zs;
    136:   } else if (N != gxm * gym * gzm * dof) {
    137:     *ierr = PETSC_ERR_ARG_INCOMP;
    138:     return;
    139:   }
    140:   if (dim == 1) {
    141:     gys = gxs;
    142:     gym = gxm;
    143:     gxs = 0;
    144:     gxm = dof;
    145:   }
    146:   *ierr = VecGetArray(*v, &aa);
    147:   if (*ierr) return;
    148:   *ierr = F90Array2dCreate(aa, MPIU_SCALAR, gxs, gxm, gys, gym, a PETSC_F90_2PTR_PARAM(ptrd));
    149:   if (*ierr) return;
    150: }

    152: PETSC_EXTERN void dmdavecrestorearrayf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    153: {
    154:   PetscScalar *fa;
    155:   *ierr = F90Array2dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    156:   *ierr = VecRestoreArray(*v, &fa);
    157:   if (*ierr) return;
    158:   *ierr = F90Array2dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    159: }

    161: PETSC_EXTERN void dmdavecgetarrayf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    162: {
    163:   PetscInt     xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
    164:   PetscScalar *aa;

    166:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    167:   if (*ierr) return;
    168:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    169:   if (*ierr) return;
    170:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    171:   if (*ierr) return;

    173:   /* Handle case where user passes in global vector as opposed to local */
    174:   *ierr = VecGetLocalSize(*v, &N);
    175:   if (*ierr) return;
    176:   if (N == xm * ym * zm * dof) {
    177:     gxm = xm;
    178:     gym = ym;
    179:     gzm = zm;
    180:     gxs = xs;
    181:     gys = ys;
    182:     gzs = zs;
    183:   } else if (N != gxm * gym * gzm * dof) {
    184:     *ierr = PETSC_ERR_ARG_INCOMP;
    185:     return;
    186:   }
    187:   if (dim == 2) {
    188:     gzs = gys;
    189:     gzm = gym;
    190:     gys = gxs;
    191:     gym = gxm;
    192:     gxs = 0;
    193:     gxm = dof;
    194:   }
    195:   *ierr = VecGetArray(*v, &aa);
    196:   if (*ierr) return;
    197:   *ierr = F90Array3dCreate(aa, MPIU_SCALAR, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
    198:   if (*ierr) return;
    199: }

    201: PETSC_EXTERN void dmdavecrestorearrayf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    202: {
    203:   PetscScalar *fa;
    204:   *ierr = F90Array3dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    205:   *ierr = VecRestoreArray(*v, &fa);
    206:   if (*ierr) return;
    207:   *ierr = F90Array3dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    208: }

    210: PETSC_EXTERN void dmdavecgetarrayf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    211: {
    212:   PetscInt     xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof, zero = 0;
    213:   PetscScalar *aa;

    215:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    216:   if (*ierr) return;
    217:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    218:   if (*ierr) return;
    219:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    220:   if (*ierr) return;

    222:   /* Handle case where user passes in global vector as opposed to local */
    223:   *ierr = VecGetLocalSize(*v, &N);
    224:   if (*ierr) return;
    225:   if (N == xm * ym * zm * dof) {
    226:     gxm = xm;
    227:     gym = ym;
    228:     gzm = zm;
    229:     gxs = xs;
    230:     gys = ys;
    231:     gzs = zs;
    232:   } else if (N != gxm * gym * gzm * dof) {
    233:     *ierr = PETSC_ERR_ARG_INCOMP;
    234:     return;
    235:   }
    236:   *ierr = VecGetArray(*v, &aa);
    237:   if (*ierr) return;
    238:   *ierr = F90Array4dCreate(aa, MPIU_SCALAR, zero, dof, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
    239:   if (*ierr) return;
    240: }

    242: PETSC_EXTERN void dmdavecrestorearrayf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    243: {
    244:   PetscScalar *fa;
    245:   /*
    246:     F90Array4dAccess is not implemented, so the following call would fail
    247:   */
    248:   *ierr = F90Array4dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    249:   *ierr = VecRestoreArray(*v, &fa);
    250:   if (*ierr) return;
    251:   *ierr = F90Array4dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    252: }

    254: PETSC_EXTERN void dmdavecgetarrayreadf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    255: {
    256:   PetscInt           xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
    257:   const PetscScalar *aa;

    259:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    260:   if (*ierr) return;
    261:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    262:   if (*ierr) return;
    263:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    264:   if (*ierr) return;

    266:   /* Handle case where user passes in global vector as opposed to local */
    267:   *ierr = VecGetLocalSize(*v, &N);
    268:   if (*ierr) return;
    269:   if (N == xm * ym * zm * dof) {
    270:     gxm = xm;
    271:     gym = ym;
    272:     gzm = zm;
    273:     gxs = xs;
    274:     gys = ys;
    275:     gzs = zs;
    276:   } else if (N != gxm * gym * gzm * dof) {
    277:     *ierr = PETSC_ERR_ARG_INCOMP;
    278:     return;
    279:   }
    280:   *ierr = VecGetArrayRead(*v, &aa);
    281:   if (*ierr) return;
    282:   *ierr = F90Array1dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, a PETSC_F90_2PTR_PARAM(ptrd));
    283:   if (*ierr) return;
    284: }

    286: PETSC_EXTERN void dmdavecrestorearrayreadf901_(DM *da, Vec *v, F90Array1d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    287: {
    288:   const PetscScalar *fa;
    289:   *ierr = F90Array1dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    290:   *ierr = VecRestoreArrayRead(*v, &fa);
    291:   if (*ierr) return;
    292:   *ierr = F90Array1dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    293: }

    295: PETSC_EXTERN void dmdavecgetarrayreadf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    296: {
    297:   PetscInt           xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
    298:   const PetscScalar *aa;

    300:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    301:   if (*ierr) return;
    302:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    303:   if (*ierr) return;
    304:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    305:   if (*ierr) return;

    307:   /* Handle case where user passes in global vector as opposed to local */
    308:   *ierr = VecGetLocalSize(*v, &N);
    309:   if (*ierr) return;
    310:   if (N == xm * ym * zm * dof) {
    311:     gxm = xm;
    312:     gym = ym;
    313:     gzm = zm;
    314:     gxs = xs;
    315:     gys = ys;
    316:     gzs = zs;
    317:   } else if (N != gxm * gym * gzm * dof) {
    318:     *ierr = PETSC_ERR_ARG_INCOMP;
    319:     return;
    320:   }
    321:   if (dim == 1) {
    322:     gys = gxs;
    323:     gym = gxm;
    324:     gxs = 0;
    325:     gxm = dof;
    326:   }
    327:   *ierr = VecGetArrayRead(*v, &aa);
    328:   if (*ierr) return;
    329:   *ierr = F90Array2dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, gys, gym, a PETSC_F90_2PTR_PARAM(ptrd));
    330:   if (*ierr) return;
    331: }

    333: PETSC_EXTERN void dmdavecrestorearrayreadf902_(DM *da, Vec *v, F90Array2d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    334: {
    335:   const PetscScalar *fa;
    336:   *ierr = F90Array2dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    337:   *ierr = VecRestoreArrayRead(*v, &fa);
    338:   if (*ierr) return;
    339:   *ierr = F90Array2dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    340: }

    342: PETSC_EXTERN void dmdavecgetarrayreadf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    343: {
    344:   PetscInt           xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof;
    345:   const PetscScalar *aa;

    347:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    348:   if (*ierr) return;
    349:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    350:   if (*ierr) return;
    351:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    352:   if (*ierr) return;

    354:   /* Handle case where user passes in global vector as opposed to local */
    355:   *ierr = VecGetLocalSize(*v, &N);
    356:   if (*ierr) return;
    357:   if (N == xm * ym * zm * dof) {
    358:     gxm = xm;
    359:     gym = ym;
    360:     gzm = zm;
    361:     gxs = xs;
    362:     gys = ys;
    363:     gzs = zs;
    364:   } else if (N != gxm * gym * gzm * dof) {
    365:     *ierr = PETSC_ERR_ARG_INCOMP;
    366:     return;
    367:   }
    368:   if (dim == 2) {
    369:     gzs = gys;
    370:     gzm = gym;
    371:     gys = gxs;
    372:     gym = gxm;
    373:     gxs = 0;
    374:     gxm = dof;
    375:   }
    376:   *ierr = VecGetArrayRead(*v, &aa);
    377:   if (*ierr) return;
    378:   *ierr = F90Array3dCreate((void *)aa, MPIU_SCALAR, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
    379:   if (*ierr) return;
    380: }

    382: PETSC_EXTERN void dmdavecrestorearrayreadf903_(DM *da, Vec *v, F90Array3d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    383: {
    384:   const PetscScalar *fa;
    385:   *ierr = F90Array3dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    386:   *ierr = VecRestoreArrayRead(*v, &fa);
    387:   if (*ierr) return;
    388:   *ierr = F90Array3dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    389: }

    391: PETSC_EXTERN void dmdavecgetarrayreadf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    392: {
    393:   PetscInt           xs, ys, zs, xm, ym, zm, gxs, gys, gzs, gxm, gym, gzm, N, dim, dof, zero = 0;
    394:   const PetscScalar *aa;

    396:   *ierr = DMDAGetCorners(*da, &xs, &ys, &zs, &xm, &ym, &zm);
    397:   if (*ierr) return;
    398:   *ierr = DMDAGetGhostCorners(*da, &gxs, &gys, &gzs, &gxm, &gym, &gzm);
    399:   if (*ierr) return;
    400:   *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, &dof, NULL, NULL, NULL, NULL, NULL);
    401:   if (*ierr) return;

    403:   /* Handle case where user passes in global vector as opposed to local */
    404:   *ierr = VecGetLocalSize(*v, &N);
    405:   if (*ierr) return;
    406:   if (N == xm * ym * zm * dof) {
    407:     gxm = xm;
    408:     gym = ym;
    409:     gzm = zm;
    410:     gxs = xs;
    411:     gys = ys;
    412:     gzs = zs;
    413:   } else if (N != gxm * gym * gzm * dof) {
    414:     *ierr = PETSC_ERR_ARG_INCOMP;
    415:     return;
    416:   }
    417:   *ierr = VecGetArrayRead(*v, &aa);
    418:   if (*ierr) return;
    419:   *ierr = F90Array4dCreate((void *)aa, MPIU_SCALAR, zero, dof, gxs, gxm, gys, gym, gzs, gzm, a PETSC_F90_2PTR_PARAM(ptrd));
    420:   if (*ierr) return;
    421: }

    423: PETSC_EXTERN void dmdavecrestorearrayreadf904_(DM *da, Vec *v, F90Array4d *a, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
    424: {
    425:   const PetscScalar *fa;
    426:   /*
    427:     F90Array4dAccess is not implemented, so the following call would fail
    428:   */
    429:   *ierr = F90Array4dAccess(a, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    430:   *ierr = VecRestoreArrayRead(*v, &fa);
    431:   if (*ierr) return;
    432:   *ierr = F90Array4dDestroy(a, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    433: }