Actual source code: plexfem.c

petsc-3.10.5 2019-03-28
Report Typos and Errors
  1:  #include <petsc/private/dmpleximpl.h>
  2:  #include <petscsf.h>

  4:  #include <petsc/private/hashsetij.h>
  5:  #include <petsc/private/petscfeimpl.h>
  6:  #include <petsc/private/petscfvimpl.h>

  8: static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx)
  9: {
 10:   PetscFEGeom *geom = (PetscFEGeom *) ctx;

 14:   PetscFEGeomDestroy(&geom);
 15:   return(0);
 16: }

 18: static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
 19: {
 20:   char            composeStr[33] = {0};
 21:   PetscObjectId   id;
 22:   PetscContainer  container;
 23:   PetscErrorCode  ierr;

 26:   PetscObjectGetId((PetscObject)quad,&id);
 27:   PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);
 28:   PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);
 29:   if (container) {
 30:     PetscContainerGetPointer(container, (void **) geom);
 31:   } else {
 32:     DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);
 33:     PetscContainerCreate(PETSC_COMM_SELF,&container);
 34:     PetscContainerSetPointer(container, (void *) *geom);
 35:     PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);
 36:     PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);
 37:     PetscContainerDestroy(&container);
 38:   }
 39:   return(0);
 40: }

 42: static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
 43: {
 45:   *geom = NULL;
 46:   return(0);
 47: }

 49: /*@
 50:   DMPlexGetScale - Get the scale for the specified fundamental unit

 52:   Not collective

 54:   Input Arguments:
 55: + dm   - the DM
 56: - unit - The SI unit

 58:   Output Argument:
 59: . scale - The value used to scale all quantities with this unit

 61:   Level: advanced

 63: .seealso: DMPlexSetScale(), PetscUnit
 64: @*/
 65: PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale)
 66: {
 67:   DM_Plex *mesh = (DM_Plex*) dm->data;

 72:   *scale = mesh->scale[unit];
 73:   return(0);
 74: }

 76: /*@
 77:   DMPlexSetScale - Set the scale for the specified fundamental unit

 79:   Not collective

 81:   Input Arguments:
 82: + dm   - the DM
 83: . unit - The SI unit
 84: - scale - The value used to scale all quantities with this unit

 86:   Level: advanced

 88: .seealso: DMPlexGetScale(), PetscUnit
 89: @*/
 90: PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale)
 91: {
 92:   DM_Plex *mesh = (DM_Plex*) dm->data;

 96:   mesh->scale[unit] = scale;
 97:   return(0);
 98: }

100: static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *mode, void *ctx)
101: {
102:   const PetscInt eps[3][3][3] = {{{0, 0, 0}, {0, 0, 1}, {0, -1, 0}}, {{0, 0, -1}, {0, 0, 0}, {1, 0, 0}}, {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}}};
103:   PetscInt *ctxInt  = (PetscInt *) ctx;
104:   PetscInt  dim2    = ctxInt[0];
105:   PetscInt  d       = ctxInt[1];
106:   PetscInt  i, j, k = dim > 2 ? d - dim : d;

109:   if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %d does not match context dimension %d", dim, dim2);
110:   for (i = 0; i < dim; i++) mode[i] = 0.;
111:   if (d < dim) {
112:     mode[d] = 1.; /* Translation along axis d */
113:   } else {
114:     for (i = 0; i < dim; i++) {
115:       for (j = 0; j < dim; j++) {
116:         mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */
117:       }
118:     }
119:   }
120:   return(0);
121: }

123: /*@C
124:   DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation

126:   Collective on DM

128:   Input Arguments:
129: . dm - the DM

131:   Output Argument:
132: . sp - the null space

134:   Note: This is necessary to provide a suitable coarse space for algebraic multigrid

136:   Level: advanced

138: .seealso: MatNullSpaceCreate(), PCGAMG
139: @*/
140: PetscErrorCode DMPlexCreateRigidBody(DM dm, MatNullSpace *sp)
141: {
142:   MPI_Comm       comm;
143:   Vec            mode[6];
144:   PetscSection   section, globalSection;
145:   PetscInt       dim, dimEmbed, n, m, d, i, j;

149:   PetscObjectGetComm((PetscObject)dm,&comm);
150:   DMGetDimension(dm, &dim);
151:   DMGetCoordinateDim(dm, &dimEmbed);
152:   if (dim == 1) {
153:     MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);
154:     return(0);
155:   }
156:   DMGetSection(dm, &section);
157:   DMGetGlobalSection(dm, &globalSection);
158:   PetscSectionGetConstrainedStorageSize(globalSection, &n);
159:   m    = (dim*(dim+1))/2;
160:   VecCreate(comm, &mode[0]);
161:   VecSetSizes(mode[0], n, PETSC_DETERMINE);
162:   VecSetUp(mode[0]);
163:   for (i = 1; i < m; ++i) {VecDuplicate(mode[0], &mode[i]);}
164:   for (d = 0; d < m; d++) {
165:     PetscInt         ctx[2];
166:     PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
167:     void            *voidctx = (void *) (&ctx[0]);

169:     ctx[0] = dimEmbed;
170:     ctx[1] = d;
171:     DMProjectFunction(dm, 0.0, &func, &voidctx, INSERT_VALUES, mode[d]);
172:   }
173:   for (i = 0; i < dim; ++i) {VecNormalize(mode[i], NULL);}
174:   /* Orthonormalize system */
175:   for (i = dim; i < m; ++i) {
176:     PetscScalar dots[6];

178:     VecMDot(mode[i], i, mode, dots);
179:     for (j = 0; j < i; ++j) dots[j] *= -1.0;
180:     VecMAXPY(mode[i], i, dots, mode);
181:     VecNormalize(mode[i], NULL);
182:   }
183:   MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);
184:   for (i = 0; i< m; ++i) {VecDestroy(&mode[i]);}
185:   return(0);
186: }

188: /*@C
189:   DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation

191:   Collective on DM

193:   Input Arguments:
194: + dm    - the DM
195: . nb    - The number of bodies
196: . label - The DMLabel marking each domain
197: . nids  - The number of ids per body
198: - ids   - An array of the label ids in sequence for each domain

200:   Output Argument:
201: . sp - the null space

203:   Note: This is necessary to provide a suitable coarse space for algebraic multigrid

205:   Level: advanced

207: .seealso: MatNullSpaceCreate()
208: @*/
209: PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp)
210: {
211:   MPI_Comm       comm;
212:   PetscSection   section, globalSection;
213:   Vec           *mode;
214:   PetscScalar   *dots;
215:   PetscInt       dim, dimEmbed, n, m, b, d, i, j, off;

219:   PetscObjectGetComm((PetscObject)dm,&comm);
220:   DMGetDimension(dm, &dim);
221:   DMGetCoordinateDim(dm, &dimEmbed);
222:   DMGetSection(dm, &section);
223:   DMGetGlobalSection(dm, &globalSection);
224:   PetscSectionGetConstrainedStorageSize(globalSection, &n);
225:   m    = nb * (dim*(dim+1))/2;
226:   PetscMalloc2(m, &mode, m, &dots);
227:   VecCreate(comm, &mode[0]);
228:   VecSetSizes(mode[0], n, PETSC_DETERMINE);
229:   VecSetUp(mode[0]);
230:   for (i = 1; i < m; ++i) {VecDuplicate(mode[0], &mode[i]);}
231:   for (b = 0, off = 0; b < nb; ++b) {
232:     for (d = 0; d < m/nb; ++d) {
233:       PetscInt         ctx[2];
234:       PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
235:       void            *voidctx = (void *) (&ctx[0]);

237:       ctx[0] = dimEmbed;
238:       ctx[1] = d;
239:       DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);
240:       off   += nids[b];
241:     }
242:   }
243:   for (i = 0; i < dim; ++i) {VecNormalize(mode[i], NULL);}
244:   /* Orthonormalize system */
245:   for (i = 0; i < m; ++i) {
246:     VecMDot(mode[i], i, mode, dots);
247:     for (j = 0; j < i; ++j) dots[j] *= -1.0;
248:     VecMAXPY(mode[i], i, dots, mode);
249:     VecNormalize(mode[i], NULL);
250:   }
251:   MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);
252:   for (i = 0; i< m; ++i) {VecDestroy(&mode[i]);}
253:   PetscFree2(mode, dots);
254:   return(0);
255: }

257: /*@
258:   DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs
259:   are computed by associating the basis function with one of the mesh points in its transitively-closed support, and
260:   evaluating the dual space basis of that point.  A basis function is associated with the point in its
261:   transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum
262:   projection height, which is set with this function.  By default, the maximum projection height is zero, which means
263:   that only mesh cells are used to project basis functions.  A height of one, for example, evaluates a cell-interior
264:   basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face.

266:   Input Parameters:
267: + dm - the DMPlex object
268: - height - the maximum projection height >= 0

270:   Level: advanced

272: .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
273: @*/
274: PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height)
275: {
276:   DM_Plex *plex = (DM_Plex *) dm->data;

280:   plex->maxProjectionHeight = height;
281:   return(0);
282: }

284: /*@
285:   DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in
286:   DMPlexProjectXXXLocal() functions.

288:   Input Parameters:
289: . dm - the DMPlex object

291:   Output Parameters:
292: . height - the maximum projection height

294:   Level: intermediate

296: .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
297: @*/
298: PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height)
299: {
300:   DM_Plex *plex = (DM_Plex *) dm->data;

304:   *height = plex->maxProjectionHeight;
305:   return(0);
306: }

308: /*@C
309:   DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector

311:   Input Parameters:
312: + dm     - The DM, with a PetscDS that matches the problem being constrained
313: . time   - The time
314: . field  - The field to constrain
315: . Nc     - The number of constrained field components, or 0 for all components
316: . comps  - An array of constrained component numbers, or NULL for all components
317: . label  - The DMLabel defining constrained points
318: . numids - The number of DMLabel ids for constrained points
319: . ids    - An array of ids for constrained points
320: . func   - A pointwise function giving boundary values
321: - ctx    - An optional user context for bcFunc

323:   Output Parameter:
324: . locX   - A local vector to receives the boundary values

326:   Level: developer

328: .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
329: @*/
330: PetscErrorCode DMPlexInsertBoundaryValuesEssential(DM dm, PetscReal time, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void *ctx, Vec locX)
331: {
332:   PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx);
333:   void            **ctxs;
334:   PetscInt          numFields;
335:   PetscErrorCode    ierr;

338:   DMGetNumFields(dm, &numFields);
339:   PetscCalloc2(numFields,&funcs,numFields,&ctxs);
340:   funcs[field] = func;
341:   ctxs[field]  = ctx;
342:   DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);
343:   PetscFree2(funcs,ctxs);
344:   return(0);
345: }

347: /*@C
348:   DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector

350:   Input Parameters:
351: + dm     - The DM, with a PetscDS that matches the problem being constrained
352: . time   - The time
353: . locU   - A local vector with the input solution values
354: . field  - The field to constrain
355: . Nc     - The number of constrained field components, or 0 for all components
356: . comps  - An array of constrained component numbers, or NULL for all components
357: . label  - The DMLabel defining constrained points
358: . numids - The number of DMLabel ids for constrained points
359: . ids    - An array of ids for constrained points
360: . func   - A pointwise function giving boundary values
361: - ctx    - An optional user context for bcFunc

363:   Output Parameter:
364: . locX   - A local vector to receives the boundary values

366:   Level: developer

368: .seealso: DMPlexInsertBoundaryValuesEssential(), DMAddBoundary()
369: @*/
370: PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
371:                                                         void (*func)(PetscInt, PetscInt, PetscInt,
372:                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
373:                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
374:                                                                      PetscReal, const PetscReal[], PetscInt, const PetscScalar[],
375:                                                                      PetscScalar[]),
376:                                                         void *ctx, Vec locX)
377: {
378:   void (**funcs)(PetscInt, PetscInt, PetscInt,
379:                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
380:                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
381:                  PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
382:   void            **ctxs;
383:   PetscInt          numFields;
384:   PetscErrorCode    ierr;

387:   DMGetNumFields(dm, &numFields);
388:   PetscCalloc2(numFields,&funcs,numFields,&ctxs);
389:   funcs[field] = func;
390:   ctxs[field]  = ctx;
391:   DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);
392:   PetscFree2(funcs,ctxs);
393:   return(0);
394: }

396: /*@C
397:   DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector

399:   Input Parameters:
400: + dm     - The DM, with a PetscDS that matches the problem being constrained
401: . time   - The time
402: . faceGeometry - A vector with the FVM face geometry information
403: . cellGeometry - A vector with the FVM cell geometry information
404: . Grad         - A vector with the FVM cell gradient information
405: . field  - The field to constrain
406: . Nc     - The number of constrained field components, or 0 for all components
407: . comps  - An array of constrained component numbers, or NULL for all components
408: . label  - The DMLabel defining constrained points
409: . numids - The number of DMLabel ids for constrained points
410: . ids    - An array of ids for constrained points
411: . func   - A pointwise function giving boundary values
412: - ctx    - An optional user context for bcFunc

414:   Output Parameter:
415: . locX   - A local vector to receives the boundary values

417:   Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary()

419:   Level: developer

421: .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
422: @*/
423: PetscErrorCode DMPlexInsertBoundaryValuesRiemann(DM dm, PetscReal time, Vec faceGeometry, Vec cellGeometry, Vec Grad, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
424:                                                  PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX)
425: {
426:   PetscDS            prob;
427:   PetscSF            sf;
428:   DM                 dmFace, dmCell, dmGrad;
429:   const PetscScalar *facegeom, *cellgeom = NULL, *grad;
430:   const PetscInt    *leaves;
431:   PetscScalar       *x, *fx;
432:   PetscInt           dim, nleaves, loc, fStart, fEnd, pdim, i;
433:   PetscErrorCode     ierr, ierru = 0;

436:   DMGetPointSF(dm, &sf);
437:   PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);
438:   nleaves = PetscMax(0, nleaves);
439:   DMGetDimension(dm, &dim);
440:   DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);
441:   DMGetDS(dm, &prob);
442:   VecGetDM(faceGeometry, &dmFace);
443:   VecGetArrayRead(faceGeometry, &facegeom);
444:   if (cellGeometry) {
445:     VecGetDM(cellGeometry, &dmCell);
446:     VecGetArrayRead(cellGeometry, &cellgeom);
447:   }
448:   if (Grad) {
449:     PetscFV fv;

451:     PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);
452:     VecGetDM(Grad, &dmGrad);
453:     VecGetArrayRead(Grad, &grad);
454:     PetscFVGetNumComponents(fv, &pdim);
455:     DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);
456:   }
457:   VecGetArray(locX, &x);
458:   for (i = 0; i < numids; ++i) {
459:     IS              faceIS;
460:     const PetscInt *faces;
461:     PetscInt        numFaces, f;

463:     DMLabelGetStratumIS(label, ids[i], &faceIS);
464:     if (!faceIS) continue; /* No points with that id on this process */
465:     ISGetLocalSize(faceIS, &numFaces);
466:     ISGetIndices(faceIS, &faces);
467:     for (f = 0; f < numFaces; ++f) {
468:       const PetscInt         face = faces[f], *cells;
469:       PetscFVFaceGeom        *fg;

471:       if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */
472:       PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);
473:       if (loc >= 0) continue;
474:       DMPlexPointLocalRead(dmFace, face, facegeom, &fg);
475:       DMPlexGetSupport(dm, face, &cells);
476:       if (Grad) {
477:         PetscFVCellGeom       *cg;
478:         PetscScalar           *cx, *cgrad;
479:         PetscScalar           *xG;
480:         PetscReal              dx[3];
481:         PetscInt               d;

483:         DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);
484:         DMPlexPointLocalRead(dm, cells[0], x, &cx);
485:         DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);
486:         DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);
487:         DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx);
488:         for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx);
489:         ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx);
490:         if (ierru) {
491:           ISRestoreIndices(faceIS, &faces);
492:           ISDestroy(&faceIS);
493:           goto cleanup;
494:         }
495:       } else {
496:         PetscScalar       *xI;
497:         PetscScalar       *xG;

499:         DMPlexPointLocalRead(dm, cells[0], x, &xI);
500:         DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);
501:         ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);
502:         if (ierru) {
503:           ISRestoreIndices(faceIS, &faces);
504:           ISDestroy(&faceIS);
505:           goto cleanup;
506:         }
507:       }
508:     }
509:     ISRestoreIndices(faceIS, &faces);
510:     ISDestroy(&faceIS);
511:   }
512:   cleanup:
513:   VecRestoreArray(locX, &x);
514:   if (Grad) {
515:     DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);
516:     VecRestoreArrayRead(Grad, &grad);
517:   }
518:   if (cellGeometry) {VecRestoreArrayRead(cellGeometry, &cellgeom);}
519:   VecRestoreArrayRead(faceGeometry, &facegeom);
520:   CHKERRQ(ierru);
521:   return(0);
522: }

524: PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
525: {
526:   PetscInt       numBd, b;

530:   PetscDSGetNumBoundary(dm->prob, &numBd);
531:   for (b = 0; b < numBd; ++b) {
532:     DMBoundaryConditionType type;
533:     const char             *labelname;
534:     DMLabel                 label;
535:     PetscInt                field, Nc;
536:     const PetscInt         *comps;
537:     PetscObject             obj;
538:     PetscClassId            id;
539:     void                    (*func)(void);
540:     PetscInt                numids;
541:     const PetscInt         *ids;
542:     void                   *ctx;

544:     DMGetBoundary(dm, b, &type, NULL, &labelname, &field, &Nc, &comps, &func, &numids, &ids, &ctx);
545:     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
546:     DMGetLabel(dm, labelname, &label);
547:     DMGetField(dm, field, &obj);
548:     PetscObjectGetClassId(obj, &id);
549:     if (id == PETSCFE_CLASSID) {
550:       switch (type) {
551:         /* for FEM, there is no insertion to be done for non-essential boundary conditions */
552:       case DM_BC_ESSENTIAL:
553:         DMPlexLabelAddCells(dm,label);
554:         DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);
555:         DMPlexLabelClearCells(dm,label);
556:         break;
557:       case DM_BC_ESSENTIAL_FIELD:
558:         DMPlexLabelAddCells(dm,label);
559:         DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids,
560:                                                         (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
561:                                                                   const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
562:                                                                   PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);
563:         DMPlexLabelClearCells(dm,label);
564:         break;
565:       default: break;
566:       }
567:     } else if (id == PETSCFV_CLASSID) {
568:       if (!faceGeomFVM) continue;
569:       DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids,
570:                                                (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);
571:     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
572:   }
573:   return(0);
574: }

576: /*@
577:   DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector

579:   Input Parameters:
580: + dm - The DM
581: . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
582: . time - The time
583: . faceGeomFVM - Face geometry data for FV discretizations
584: . cellGeomFVM - Cell geometry data for FV discretizations
585: - gradFVM - Gradient reconstruction data for FV discretizations

587:   Output Parameters:
588: . locX - Solution updated with boundary values

590:   Level: developer

592: .seealso: DMProjectFunctionLabelLocal()
593: @*/
594: PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
595: {

604:   PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));
605:   return(0);
606: }

608: PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
609: {
610:   Vec              localX;
611:   PetscErrorCode   ierr;

614:   DMGetLocalVector(dm, &localX);
615:   DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);
616:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);
617:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);
618:   DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);
619:   DMRestoreLocalVector(dm, &localX);
620:   return(0);
621: }

623: /*@C
624:   DMComputeL2Diff - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h.

626:   Input Parameters:
627: + dm     - The DM
628: . time   - The time
629: . funcs  - The functions to evaluate for each field component
630: . ctxs   - Optional array of contexts to pass to each function, or NULL.
631: - localX - The coefficient vector u_h, a local vector

633:   Output Parameter:
634: . diff - The diff ||u - u_h||_2

636:   Level: developer

638: .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff()
639: @*/
640: PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff)
641: {
642:   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
643:   PetscSection     section;
644:   PetscQuadrature  quad;
645:   PetscScalar     *funcVal, *interpolant;
646:   PetscReal       *coords, *detJ, *J;
647:   PetscReal        localDiff = 0.0;
648:   const PetscReal *quadWeights;
649:   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, cEndInterior, c, field, fieldOffset;
650:   PetscErrorCode   ierr;

653:   DMGetDimension(dm, &dim);
654:   DMGetCoordinateDim(dm, &coordDim);
655:   DMGetSection(dm, &section);
656:   PetscSectionGetNumFields(section, &numFields);
657:   for (field = 0; field < numFields; ++field) {
658:     PetscObject  obj;
659:     PetscClassId id;
660:     PetscInt     Nc;

662:     DMGetField(dm, field, &obj);
663:     PetscObjectGetClassId(obj, &id);
664:     if (id == PETSCFE_CLASSID) {
665:       PetscFE fe = (PetscFE) obj;

667:       PetscFEGetQuadrature(fe, &quad);
668:       PetscFEGetNumComponents(fe, &Nc);
669:     } else if (id == PETSCFV_CLASSID) {
670:       PetscFV fv = (PetscFV) obj;

672:       PetscFVGetQuadrature(fv, &quad);
673:       PetscFVGetNumComponents(fv, &Nc);
674:     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
675:     numComponents += Nc;
676:   }
677:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);
678:   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
679:   PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);
680:   DMPlexGetVTKCellHeight(dm, &cellHeight);
681:   DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);
682:   DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);
683:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
684:   for (c = cStart; c < cEnd; ++c) {
685:     PetscScalar *x = NULL;
686:     PetscReal    elemDiff = 0.0;
687:     PetscInt     qc = 0;

689:     DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);
690:     DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);

692:     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
693:       PetscObject  obj;
694:       PetscClassId id;
695:       void * const ctx = ctxs ? ctxs[field] : NULL;
696:       PetscInt     Nb, Nc, q, fc;

698:       DMGetField(dm, field, &obj);
699:       PetscObjectGetClassId(obj, &id);
700:       if (id == PETSCFE_CLASSID)      {PetscFEGetNumComponents((PetscFE) obj, &Nc);PetscFEGetDimension((PetscFE) obj, &Nb);}
701:       else if (id == PETSCFV_CLASSID) {PetscFVGetNumComponents((PetscFV) obj, &Nc);Nb = 1;}
702:       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
703:       if (debug) {
704:         char title[1024];
705:         PetscSNPrintf(title, 1023, "Solution for Field %d", field);
706:         DMPrintCellVector(c, title, Nb, &x[fieldOffset]);
707:       }
708:       for (q = 0; q < Nq; ++q) {
709:         if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", detJ[q], c, q);
710:         (*funcs[field])(coordDim, time, &coords[coordDim * q], Nc, funcVal, ctx);
711:         if (ierr) {
712:           PetscErrorCode ierr2;
713:           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
714:           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
715:           ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
716: 
717:         }
718:         if (id == PETSCFE_CLASSID)      {PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);}
719:         else if (id == PETSCFV_CLASSID) {PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);}
720:         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
721:         for (fc = 0; fc < Nc; ++fc) {
722:           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
723:           if (debug) {PetscPrintf(PETSC_COMM_SELF, "    elem %d field %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);}
724:           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
725:         }
726:       }
727:       fieldOffset += Nb;
728:       qc += Nc;
729:     }
730:     DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);
731:     if (debug) {PetscPrintf(PETSC_COMM_SELF, "  elem %d diff %g\n", c, elemDiff);}
732:     localDiff += elemDiff;
733:   }
734:   PetscFree5(funcVal,interpolant,coords,detJ,J);
735:   MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));
736:   *diff = PetscSqrtReal(*diff);
737:   return(0);
738: }

740: PetscErrorCode DMComputeL2GradientDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, const PetscReal n[], PetscReal *diff)
741: {
742:   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
743:   PetscSection     section;
744:   PetscQuadrature  quad;
745:   Vec              localX;
746:   PetscScalar     *funcVal, *interpolant;
747:   const PetscReal *quadPoints, *quadWeights;
748:   PetscReal       *coords, *realSpaceDer, *J, *invJ, *detJ;
749:   PetscReal        localDiff = 0.0;
750:   PetscInt         dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, cEndInterior, c, field, fieldOffset;
751:   PetscErrorCode   ierr;

754:   DMGetDimension(dm, &dim);
755:   DMGetCoordinateDim(dm, &coordDim);
756:   DMGetSection(dm, &section);
757:   PetscSectionGetNumFields(section, &numFields);
758:   DMGetLocalVector(dm, &localX);
759:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);
760:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);
761:   for (field = 0; field < numFields; ++field) {
762:     PetscFE  fe;
763:     PetscInt Nc;

765:     DMGetField(dm, field, (PetscObject *) &fe);
766:     PetscFEGetQuadrature(fe, &quad);
767:     PetscFEGetNumComponents(fe, &Nc);
768:     numComponents += Nc;
769:   }
770:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
771:   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
772:   /* DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX); */
773:   PetscMalloc7(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*Nq,&realSpaceDer,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ,numComponents,&interpolant,Nq,&detJ);
774:   DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);
775:   DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);
776:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
777:   for (c = cStart; c < cEnd; ++c) {
778:     PetscScalar *x = NULL;
779:     PetscReal    elemDiff = 0.0;
780:     PetscInt     qc = 0;

782:     DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, invJ, detJ);
783:     DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);

785:     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
786:       PetscFE          fe;
787:       void * const     ctx = ctxs ? ctxs[field] : NULL;
788:       PetscReal       *basisDer;
789:       PetscInt         Nb, Nc, q, fc;

791:       DMGetField(dm, field, (PetscObject *) &fe);
792:       PetscFEGetDimension(fe, &Nb);
793:       PetscFEGetNumComponents(fe, &Nc);
794:       PetscFEGetDefaultTabulation(fe, NULL, &basisDer, NULL);
795:       if (debug) {
796:         char title[1024];
797:         PetscSNPrintf(title, 1023, "Solution for Field %d", field);
798:         DMPrintCellVector(c, title, Nb, &x[fieldOffset]);
799:       }
800:       for (q = 0; q < Nq; ++q) {
801:         if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", detJ[q], c, q);
802:         (*funcs[field])(coordDim, time, &coords[q*coordDim], n, numFields, funcVal, ctx);
803:         if (ierr) {
804:           PetscErrorCode ierr2;
805:           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
806:           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
807:           ierr2 = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr2);
808: 
809:         }
810:         PetscFEInterpolateGradient_Static(fe, &x[fieldOffset], coordDim, invJ, n, q, interpolant);
811:         for (fc = 0; fc < Nc; ++fc) {
812:           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
813:           if (debug) {PetscPrintf(PETSC_COMM_SELF, "    elem %d fieldDer %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);}
814:           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
815:         }
816:       }
817:       fieldOffset += Nb;
818:       qc          += Nc;
819:     }
820:     DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);
821:     if (debug) {PetscPrintf(PETSC_COMM_SELF, "  elem %d diff %g\n", c, elemDiff);}
822:     localDiff += elemDiff;
823:   }
824:   PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);
825:   DMRestoreLocalVector(dm, &localX);
826:   MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));
827:   *diff = PetscSqrtReal(*diff);
828:   return(0);
829: }

831: PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
832: {
833:   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
834:   PetscSection     section;
835:   PetscQuadrature  quad;
836:   Vec              localX;
837:   PetscScalar     *funcVal, *interpolant;
838:   PetscReal       *coords, *detJ, *J;
839:   PetscReal       *localDiff;
840:   const PetscReal *quadPoints, *quadWeights;
841:   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset;
842:   PetscErrorCode   ierr;

845:   DMGetDimension(dm, &dim);
846:   DMGetCoordinateDim(dm, &coordDim);
847:   DMGetSection(dm, &section);
848:   PetscSectionGetNumFields(section, &numFields);
849:   DMGetLocalVector(dm, &localX);
850:   DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);
851:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);
852:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);
853:   for (field = 0; field < numFields; ++field) {
854:     PetscObject  obj;
855:     PetscClassId id;
856:     PetscInt     Nc;

858:     DMGetField(dm, field, &obj);
859:     PetscObjectGetClassId(obj, &id);
860:     if (id == PETSCFE_CLASSID) {
861:       PetscFE fe = (PetscFE) obj;

863:       PetscFEGetQuadrature(fe, &quad);
864:       PetscFEGetNumComponents(fe, &Nc);
865:     } else if (id == PETSCFV_CLASSID) {
866:       PetscFV fv = (PetscFV) obj;

868:       PetscFVGetQuadrature(fv, &quad);
869:       PetscFVGetNumComponents(fv, &Nc);
870:     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
871:     numComponents += Nc;
872:   }
873:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
874:   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
875:   PetscCalloc6(numFields,&localDiff,numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);
876:   DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);
877:   DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);
878:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
879:   for (c = cStart; c < cEnd; ++c) {
880:     PetscScalar *x = NULL;
881:     PetscInt     qc = 0;

883:     DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);
884:     DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);

886:     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
887:       PetscObject  obj;
888:       PetscClassId id;
889:       void * const ctx = ctxs ? ctxs[field] : NULL;
890:       PetscInt     Nb, Nc, q, fc;

892:       PetscReal       elemDiff = 0.0;

894:       DMGetField(dm, field, &obj);
895:       PetscObjectGetClassId(obj, &id);
896:       if (id == PETSCFE_CLASSID)      {PetscFEGetNumComponents((PetscFE) obj, &Nc);PetscFEGetDimension((PetscFE) obj, &Nb);}
897:       else if (id == PETSCFV_CLASSID) {PetscFVGetNumComponents((PetscFV) obj, &Nc);Nb = 1;}
898:       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
899:       if (debug) {
900:         char title[1024];
901:         PetscSNPrintf(title, 1023, "Solution for Field %d", field);
902:         DMPrintCellVector(c, title, Nb*Nc, &x[fieldOffset]);
903:       }
904:       for (q = 0; q < Nq; ++q) {
905:         if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature point %D", detJ, c, q);
906:         (*funcs[field])(coordDim, time, &coords[coordDim*q], numFields, funcVal, ctx);
907:         if (ierr) {
908:           PetscErrorCode ierr2;
909:           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
910:           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
911:           ierr2 = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
912: 
913:         }
914:         if (id == PETSCFE_CLASSID)      {PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);}
915:         else if (id == PETSCFV_CLASSID) {PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);}
916:         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
917:         for (fc = 0; fc < Nc; ++fc) {
918:           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
919:           if (debug) {PetscPrintf(PETSC_COMM_SELF, "    elem %d field %d point %g %g %g diff %g\n", c, field, coordDim > 0 ? coords[0] : 0., coordDim > 1 ? coords[1] : 0., coordDim > 2 ? coords[2] : 0., PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);}
920:           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
921:         }
922:       }
923:       fieldOffset += Nb;
924:       qc          += Nc;
925:       localDiff[field] += elemDiff;
926:     }
927:     DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);
928:   }
929:   DMRestoreLocalVector(dm, &localX);
930:   MPIU_Allreduce(localDiff, diff, numFields, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));
931:   for (field = 0; field < numFields; ++field) diff[field] = PetscSqrtReal(diff[field]);
932:   PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);
933:   return(0);
934: }

936: /*@C
937:   DMPlexComputeL2DiffVec - This function computes the cellwise L_2 difference between a function u and an FEM interpolant solution u_h, and stores it in a Vec.

939:   Input Parameters:
940: + dm    - The DM
941: . time  - The time
942: . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation
943: . ctxs  - Optional array of contexts to pass to each function, or NULL.
944: - X     - The coefficient vector u_h

946:   Output Parameter:
947: . D - A Vec which holds the difference ||u - u_h||_2 for each cell

949:   Level: developer

951: .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
952: @*/
953: PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D)
954: {
955:   PetscSection     section;
956:   PetscQuadrature  quad;
957:   Vec              localX;
958:   PetscScalar     *funcVal, *interpolant;
959:   PetscReal       *coords, *detJ, *J;
960:   const PetscReal *quadPoints, *quadWeights;
961:   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset;
962:   PetscErrorCode   ierr;

965:   VecSet(D, 0.0);
966:   DMGetDimension(dm, &dim);
967:   DMGetCoordinateDim(dm, &coordDim);
968:   DMGetSection(dm, &section);
969:   PetscSectionGetNumFields(section, &numFields);
970:   DMGetLocalVector(dm, &localX);
971:   DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);
972:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);
973:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);
974:   for (field = 0; field < numFields; ++field) {
975:     PetscObject  obj;
976:     PetscClassId id;
977:     PetscInt     Nc;

979:     DMGetField(dm, field, &obj);
980:     PetscObjectGetClassId(obj, &id);
981:     if (id == PETSCFE_CLASSID) {
982:       PetscFE fe = (PetscFE) obj;

984:       PetscFEGetQuadrature(fe, &quad);
985:       PetscFEGetNumComponents(fe, &Nc);
986:     } else if (id == PETSCFV_CLASSID) {
987:       PetscFV fv = (PetscFV) obj;

989:       PetscFVGetQuadrature(fv, &quad);
990:       PetscFVGetNumComponents(fv, &Nc);
991:     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
992:     numComponents += Nc;
993:   }
994:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
995:   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
996:   PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);
997:   DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);
998:   DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);
999:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1000:   for (c = cStart; c < cEnd; ++c) {
1001:     PetscScalar *x = NULL;
1002:     PetscScalar  elemDiff = 0.0;
1003:     PetscInt     qc = 0;

1005:     DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);
1006:     DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);

1008:     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1009:       PetscObject  obj;
1010:       PetscClassId id;
1011:       void * const ctx = ctxs ? ctxs[field] : NULL;
1012:       PetscInt     Nb, Nc, q, fc;

1014:       DMGetField(dm, field, &obj);
1015:       PetscObjectGetClassId(obj, &id);
1016:       if (id == PETSCFE_CLASSID)      {PetscFEGetNumComponents((PetscFE) obj, &Nc);PetscFEGetDimension((PetscFE) obj, &Nb);}
1017:       else if (id == PETSCFV_CLASSID) {PetscFVGetNumComponents((PetscFV) obj, &Nc);Nb = 1;}
1018:       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1019:       if (funcs[field]) {
1020:         for (q = 0; q < Nq; ++q) {
1021:           if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], c, q);
1022:           (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx);
1023:           if (ierr) {
1024:             PetscErrorCode ierr2;
1025:             ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1026:             ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
1027:             ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1028: 
1029:           }
1030:           if (id == PETSCFE_CLASSID)      {PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);}
1031:           else if (id == PETSCFV_CLASSID) {PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);}
1032:           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1033:           for (fc = 0; fc < Nc; ++fc) {
1034:             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1035:             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
1036:           }
1037:         }
1038:       }
1039:       fieldOffset += Nb;
1040:       qc          += Nc;
1041:     }
1042:     DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);
1043:     VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);
1044:   }
1045:   PetscFree5(funcVal,interpolant,coords,detJ,J);
1046:   DMRestoreLocalVector(dm, &localX);
1047:   VecSqrtAbs(D);
1048:   return(0);
1049: }

1051: /*@C
1052:   DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec.

1054:   Input Parameters:
1055: + dm - The DM
1056: - LocX  - The coefficient vector u_h

1058:   Output Parameter:
1059: . locC - A Vec which holds the Clement interpolant of the gradient

1061:   Notes:
1062:     Add citation to (Clement, 1975) and definition of the interpolant
1063:   \nabla u_h(v_i) = \sum_{T_i \in support(v_i)} |T_i| \nabla u_h(T_i) / \sum_{T_i \in support(v_i)} |T_i| where |T_i| is the cell volume

1065:   Level: developer

1067: .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1068: @*/
1069: PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC)
1070: {
1071:   DM_Plex         *mesh  = (DM_Plex *) dm->data;
1072:   PetscInt         debug = mesh->printFEM;
1073:   DM               dmC;
1074:   PetscSection     section;
1075:   PetscQuadrature  quad;
1076:   PetscScalar     *interpolant, *gradsum;
1077:   PetscReal       *coords, *detJ, *J, *invJ;
1078:   const PetscReal *quadPoints, *quadWeights;
1079:   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, vStart, vEnd, v, field, fieldOffset;
1080:   PetscErrorCode   ierr;

1083:   VecGetDM(locC, &dmC);
1084:   VecSet(locC, 0.0);
1085:   DMGetDimension(dm, &dim);
1086:   DMGetCoordinateDim(dm, &coordDim);
1087:   DMGetSection(dm, &section);
1088:   PetscSectionGetNumFields(section, &numFields);
1089:   for (field = 0; field < numFields; ++field) {
1090:     PetscObject  obj;
1091:     PetscClassId id;
1092:     PetscInt     Nc;

1094:     DMGetField(dm, field, &obj);
1095:     PetscObjectGetClassId(obj, &id);
1096:     if (id == PETSCFE_CLASSID) {
1097:       PetscFE fe = (PetscFE) obj;

1099:       PetscFEGetQuadrature(fe, &quad);
1100:       PetscFEGetNumComponents(fe, &Nc);
1101:     } else if (id == PETSCFV_CLASSID) {
1102:       PetscFV fv = (PetscFV) obj;

1104:       PetscFVGetQuadrature(fv, &quad);
1105:       PetscFVGetNumComponents(fv, &Nc);
1106:     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1107:     numComponents += Nc;
1108:   }
1109:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
1110:   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1111:   PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ);
1112:   DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);
1113:   DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);
1114:   DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);
1115:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1116:   for (v = vStart; v < vEnd; ++v) {
1117:     PetscScalar volsum = 0.0;
1118:     PetscInt   *star = NULL;
1119:     PetscInt    starSize, st, d, fc;

1121:     PetscMemzero(gradsum, coordDim*numComponents * sizeof(PetscScalar));
1122:     DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);
1123:     for (st = 0; st < starSize*2; st += 2) {
1124:       const PetscInt cell = star[st];
1125:       PetscScalar   *grad = &gradsum[coordDim*numComponents];
1126:       PetscScalar   *x    = NULL;
1127:       PetscReal      vol  = 0.0;

1129:       if ((cell < cStart) || (cell >= cEnd)) continue;
1130:       DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, J, invJ, detJ);
1131:       DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);
1132:       for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1133:         PetscObject  obj;
1134:         PetscClassId id;
1135:         PetscInt     Nb, Nc, q, qc = 0;

1137:         PetscMemzero(grad, coordDim*numComponents * sizeof(PetscScalar));
1138:         DMGetField(dm, field, &obj);
1139:         PetscObjectGetClassId(obj, &id);
1140:         if (id == PETSCFE_CLASSID)      {PetscFEGetNumComponents((PetscFE) obj, &Nc);PetscFEGetDimension((PetscFE) obj, &Nb);}
1141:         else if (id == PETSCFV_CLASSID) {PetscFVGetNumComponents((PetscFV) obj, &Nc);Nb = 1;}
1142:         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1143:         for (q = 0; q < Nq; ++q) {
1144:           if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], cell, q);
1145:           if (ierr) {
1146:             PetscErrorCode ierr2;
1147:             ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2);
1148:             ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2);
1149:             ierr2 = PetscFree4(interpolant,coords,detJ,J);CHKERRQ(ierr2);
1150: 
1151:           }
1152:           if (id == PETSCFE_CLASSID)      {PetscFEInterpolateGradient_Static((PetscFE) obj, &x[fieldOffset], coordDim, invJ, NULL, q, interpolant);}
1153:           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1154:           for (fc = 0; fc < Nc; ++fc) {
1155:             const PetscReal wt = quadWeights[q*qNc+qc+fc];

1157:             for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*detJ[q];
1158:           }
1159:           vol += quadWeights[q*qNc]*detJ[q];
1160:         }
1161:         fieldOffset += Nb;
1162:         qc          += Nc;
1163:       }
1164:       DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);
1165:       for (fc = 0; fc < numComponents; ++fc) {
1166:         for (d = 0; d < coordDim; ++d) {
1167:           gradsum[fc*coordDim+d] += grad[fc*coordDim+d];
1168:         }
1169:       }
1170:       volsum += vol;
1171:       if (debug) {
1172:         PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);
1173:         for (fc = 0; fc < numComponents; ++fc) {
1174:           for (d = 0; d < coordDim; ++d) {
1175:             if (fc || d > 0) {PetscPrintf(PETSC_COMM_SELF, ", ");}
1176:             PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));
1177:           }
1178:         }
1179:         PetscPrintf(PETSC_COMM_SELF, "]\n");
1180:       }
1181:     }
1182:     for (fc = 0; fc < numComponents; ++fc) {
1183:       for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum;
1184:     }
1185:     DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);
1186:     DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);
1187:   }
1188:   PetscFree6(gradsum,interpolant,coords,detJ,J,invJ);
1189:   return(0);
1190: }

1192: static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user)
1193: {
1194:   DM                 dmAux = NULL;
1195:   PetscDS            prob,    probAux = NULL;
1196:   PetscSection       section, sectionAux;
1197:   Vec                locX,    locA;
1198:   PetscInt           dim, numCells = cEnd - cStart, c, f;
1199:   PetscBool          useFVM = PETSC_FALSE;
1200:   /* DS */
1201:   PetscInt           Nf,    totDim,    *uOff, *uOff_x, numConstants;
1202:   PetscInt           NfAux, totDimAux, *aOff;
1203:   PetscScalar       *u, *a;
1204:   const PetscScalar *constants;
1205:   /* Geometry */
1206:   PetscFEGeom       *cgeomFEM;
1207:   DM                 dmGrad;
1208:   PetscQuadrature    affineQuad = NULL;
1209:   Vec                cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL;
1210:   PetscFVCellGeom   *cgeomFVM;
1211:   const PetscScalar *lgrad;
1212:   PetscInt           maxDegree;
1213:   DMField            coordField;
1214:   IS                 cellIS;
1215:   PetscErrorCode     ierr;

1218:   DMGetDS(dm, &prob);
1219:   DMGetDimension(dm, &dim);
1220:   DMGetSection(dm, &section);
1221:   PetscSectionGetNumFields(section, &Nf);
1222:   /* Determine which discretizations we have */
1223:   for (f = 0; f < Nf; ++f) {
1224:     PetscObject  obj;
1225:     PetscClassId id;

1227:     PetscDSGetDiscretization(prob, f, &obj);
1228:     PetscObjectGetClassId(obj, &id);
1229:     if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
1230:   }
1231:   /* Get local solution with boundary values */
1232:   DMGetLocalVector(dm, &locX);
1233:   DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);
1234:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);
1235:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);
1236:   /* Read DS information */
1237:   PetscDSGetTotalDimension(prob, &totDim);
1238:   PetscDSGetComponentOffsets(prob, &uOff);
1239:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
1240:   ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);
1241:   PetscDSGetConstants(prob, &numConstants, &constants);
1242:   /* Read Auxiliary DS information */
1243:   PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);
1244:   PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);
1245:   if (dmAux) {
1246:     DMGetDS(dmAux, &probAux);
1247:     PetscDSGetNumFields(probAux, &NfAux);
1248:     DMGetSection(dmAux, &sectionAux);
1249:     PetscDSGetTotalDimension(probAux, &totDimAux);
1250:     PetscDSGetComponentOffsets(probAux, &aOff);
1251:   }
1252:   /* Allocate data  arrays */
1253:   PetscCalloc1(numCells*totDim, &u);
1254:   if (dmAux) {PetscMalloc1(numCells*totDimAux, &a);}
1255:   /* Read out geometry */
1256:   DMGetCoordinateField(dm,&coordField);
1257:   DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);
1258:   if (maxDegree <= 1) {
1259:     DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);
1260:     if (affineQuad) {
1261:       DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);
1262:     }
1263:   }
1264:   if (useFVM) {
1265:     PetscFV   fv = NULL;
1266:     Vec       grad;
1267:     PetscInt  fStart, fEnd;
1268:     PetscBool compGrad;

1270:     for (f = 0; f < Nf; ++f) {
1271:       PetscObject  obj;
1272:       PetscClassId id;

1274:       PetscDSGetDiscretization(prob, f, &obj);
1275:       PetscObjectGetClassId(obj, &id);
1276:       if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
1277:     }
1278:     PetscFVGetComputeGradients(fv, &compGrad);
1279:     PetscFVSetComputeGradients(fv, PETSC_TRUE);
1280:     DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);
1281:     DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);
1282:     PetscFVSetComputeGradients(fv, compGrad);
1283:     VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);
1284:     /* Reconstruct and limit cell gradients */
1285:     DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);
1286:     DMGetGlobalVector(dmGrad, &grad);
1287:     DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);
1288:     /* Communicate gradient values */
1289:     DMGetLocalVector(dmGrad, &locGrad);
1290:     DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);
1291:     DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);
1292:     DMRestoreGlobalVector(dmGrad, &grad);
1293:     /* Handle non-essential (e.g. outflow) boundary values */
1294:     DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);
1295:     VecGetArrayRead(locGrad, &lgrad);
1296:   }
1297:   /* Read out data from inputs */
1298:   for (c = cStart; c < cEnd; ++c) {
1299:     PetscScalar *x = NULL;
1300:     PetscInt     i;

1302:     DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);
1303:     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
1304:     DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);
1305:     if (dmAux) {
1306:       DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);
1307:       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
1308:       DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);
1309:     }
1310:   }
1311:   /* Do integration for each field */
1312:   for (f = 0; f < Nf; ++f) {
1313:     PetscObject  obj;
1314:     PetscClassId id;
1315:     PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;

1317:     PetscDSGetDiscretization(prob, f, &obj);
1318:     PetscObjectGetClassId(obj, &id);
1319:     if (id == PETSCFE_CLASSID) {
1320:       PetscFE         fe = (PetscFE) obj;
1321:       PetscQuadrature q;
1322:       PetscFEGeom     *chunkGeom = NULL;
1323:       PetscInt        Nq, Nb;

1325:       PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);
1326:       PetscFEGetQuadrature(fe, &q);
1327:       PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);
1328:       PetscFEGetDimension(fe, &Nb);
1329:       blockSize = Nb*Nq;
1330:       batchSize = numBlocks * blockSize;
1331:       PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);
1332:       numChunks = numCells / (numBatches*batchSize);
1333:       Ne        = numChunks*numBatches*batchSize;
1334:       Nr        = numCells % (numBatches*batchSize);
1335:       offset    = numCells - Nr;
1336:       if (!affineQuad) {
1337:         DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);
1338:       }
1339:       PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);
1340:       PetscFEIntegrate(fe, prob, f, Ne, chunkGeom, u, probAux, a, cintegral);
1341:       PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);
1342:       PetscFEIntegrate(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);
1343:       PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);
1344:       if (!affineQuad) {
1345:         PetscFEGeomDestroy(&cgeomFEM);
1346:       }
1347:     } else if (id == PETSCFV_CLASSID) {
1348:       PetscInt       foff;
1349:       PetscPointFunc obj_func;
1350:       PetscScalar    lint;

1352:       PetscDSGetObjective(prob, f, &obj_func);
1353:       PetscDSGetFieldOffset(prob, f, &foff);
1354:       if (obj_func) {
1355:         for (c = 0; c < numCells; ++c) {
1356:           PetscScalar *u_x;

1358:           DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);
1359:           obj_func(dim, Nf, NfAux, uOff, uOff_x, &u[totDim*c+foff], NULL, u_x, aOff, NULL, &a[totDimAux*c], NULL, NULL, 0.0, cgeomFVM[c].centroid, numConstants, constants, &lint);
1360:           cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume;
1361:         }
1362:       }
1363:     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
1364:   }
1365:   /* Cleanup data arrays */
1366:   if (useFVM) {
1367:     VecRestoreArrayRead(locGrad, &lgrad);
1368:     VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);
1369:     DMRestoreLocalVector(dmGrad, &locGrad);
1370:     VecDestroy(&faceGeometryFVM);
1371:     VecDestroy(&cellGeometryFVM);
1372:     DMDestroy(&dmGrad);
1373:   }
1374:   if (dmAux) {PetscFree(a);}
1375:   PetscFree(u);
1376:   /* Cleanup */
1377:   if (affineQuad) {
1378:     PetscFEGeomDestroy(&cgeomFEM);
1379:   }
1380:   PetscQuadratureDestroy(&affineQuad);
1381:   ISDestroy(&cellIS);
1382:   DMRestoreLocalVector(dm, &locX);
1383:   return(0);
1384: }

1386: /*@
1387:   DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user

1389:   Input Parameters:
1390: + dm - The mesh
1391: . X  - Global input vector
1392: - user - The user context

1394:   Output Parameter:
1395: . integral - Integral for each field

1397:   Level: developer

1399: .seealso: DMPlexComputeResidualFEM()
1400: @*/
1401: PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user)
1402: {
1403:   DM_Plex       *mesh = (DM_Plex *) dm->data;
1404:   PetscScalar   *cintegral, *lintegral;
1405:   PetscInt       Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell;

1412:   PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);
1413:   DMGetNumFields(dm, &Nf);
1414:   DMPlexGetVTKCellHeight(dm, &cellHeight);
1415:   DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);
1416:   DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);
1417:   cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight];
1418:   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
1419:   PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);
1420:   DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);
1421:   /* Sum up values */
1422:   for (cell = cStart; cell < cEnd; ++cell) {
1423:     const PetscInt c = cell - cStart;

1425:     if (mesh->printFEM > 1) {DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);}
1426:     for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
1427:   }
1428:   MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));
1429:   if (mesh->printFEM) {
1430:     PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");
1431:     for (f = 0; f < Nf; ++f) {PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));}
1432:     PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");
1433:   }
1434:   PetscFree2(lintegral, cintegral);
1435:   PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);
1436:   return(0);
1437: }

1439: /*@
1440:   DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user

1442:   Input Parameters:
1443: + dm - The mesh
1444: . X  - Global input vector
1445: - user - The user context

1447:   Output Parameter:
1448: . integral - Cellwise integrals for each field

1450:   Level: developer

1452: .seealso: DMPlexComputeResidualFEM()
1453: @*/
1454: PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user)
1455: {
1456:   DM_Plex       *mesh = (DM_Plex *) dm->data;
1457:   DM             dmF;
1458:   PetscSection   sectionF;
1459:   PetscScalar   *cintegral, *af;
1460:   PetscInt       Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell;

1467:   PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);
1468:   DMGetNumFields(dm, &Nf);
1469:   DMPlexGetVTKCellHeight(dm, &cellHeight);
1470:   DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);
1471:   DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);
1472:   cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight];
1473:   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
1474:   PetscCalloc1((cEnd-cStart)*Nf, &cintegral);
1475:   DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);
1476:   /* Put values in F*/
1477:   VecGetDM(F, &dmF);
1478:   DMGetSection(dmF, &sectionF);
1479:   VecGetArray(F, &af);
1480:   for (cell = cStart; cell < cEnd; ++cell) {
1481:     const PetscInt c = cell - cStart;
1482:     PetscInt       dof, off;

1484:     if (mesh->printFEM > 1) {DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);}
1485:     PetscSectionGetDof(sectionF, cell, &dof);
1486:     PetscSectionGetOffset(sectionF, cell, &off);
1487:     if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf);
1488:     for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f];
1489:   }
1490:   VecRestoreArray(F, &af);
1491:   PetscFree(cintegral);
1492:   PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);
1493:   return(0);
1494: }

1496: static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS,
1497:                                                        void (*func)(PetscInt, PetscInt, PetscInt,
1498:                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1499:                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1500:                                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
1501:                                                        PetscScalar *fintegral, void *user)
1502: {
1503:   DM                 plex = NULL, plexA = NULL;
1504:   PetscDS            prob, probAux = NULL;
1505:   PetscSection       section, sectionAux = NULL;
1506:   Vec                locA = NULL;
1507:   DMField            coordField;
1508:   PetscInt           Nf,        totDim,        *uOff, *uOff_x;
1509:   PetscInt           NfAux = 0, totDimAux = 0, *aOff = NULL;
1510:   PetscScalar       *u, *a = NULL;
1511:   const PetscScalar *constants;
1512:   PetscInt           numConstants, f;
1513:   PetscErrorCode     ierr;

1516:   DMGetCoordinateField(dm, &coordField);
1517:   DMConvert(dm, DMPLEX, &plex);
1518:   DMGetDS(dm, &prob);
1519:   DMGetDefaultSection(dm, &section);
1520:   PetscSectionGetNumFields(section, &Nf);
1521:   /* Determine which discretizations we have */
1522:   for (f = 0; f < Nf; ++f) {
1523:     PetscObject  obj;
1524:     PetscClassId id;

1526:     PetscDSGetDiscretization(prob, f, &obj);
1527:     PetscObjectGetClassId(obj, &id);
1528:     if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f);
1529:   }
1530:   /* Read DS information */
1531:   PetscDSGetTotalDimension(prob, &totDim);
1532:   PetscDSGetComponentOffsets(prob, &uOff);
1533:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
1534:   PetscDSGetConstants(prob, &numConstants, &constants);
1535:   /* Read Auxiliary DS information */
1536:   PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);
1537:   if (locA) {
1538:     DM dmAux;

1540:     VecGetDM(locA, &dmAux);
1541:     DMConvert(dmAux, DMPLEX, &plexA);
1542:     DMGetDS(dmAux, &probAux);
1543:     PetscDSGetNumFields(probAux, &NfAux);
1544:     DMGetDefaultSection(dmAux, &sectionAux);
1545:     PetscDSGetTotalDimension(probAux, &totDimAux);
1546:     PetscDSGetComponentOffsets(probAux, &aOff);
1547:   }
1548:   /* Integrate over points */
1549:   {
1550:     PetscFEGeom    *fgeom, *chunkGeom = NULL;
1551:     PetscInt        maxDegree;
1552:     PetscQuadrature qGeom = NULL;
1553:     const PetscInt *points;
1554:     PetscInt        numFaces, face, Nq, field;
1555:     PetscInt        numChunks, chunkSize, chunk, Nr, offset;

1557:     ISGetLocalSize(pointIS, &numFaces);
1558:     ISGetIndices(pointIS, &points);
1559:     PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);
1560:     DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);
1561:     for (field = 0; field < Nf; ++field) {
1562:       PetscFE fe;

1564:       PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);
1565:       if (maxDegree <= 1) {DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);}
1566:       if (!qGeom) {
1567:         PetscFEGetFaceQuadrature(fe, &qGeom);
1568:         PetscObjectReference((PetscObject) qGeom);
1569:       }
1570:       PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);
1571:       DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);
1572:       for (face = 0; face < numFaces; ++face) {
1573:         const PetscInt point = points[face], *support, *cone;
1574:         PetscScalar    *x    = NULL;
1575:         PetscInt       i, coneSize, faceLoc;

1577:         DMPlexGetSupport(dm, point, &support);
1578:         DMPlexGetConeSize(dm, support[0], &coneSize);
1579:         DMPlexGetCone(dm, support[0], &cone);
1580:         for (faceLoc = 0; faceLoc < coneSize; ++faceLoc) if (cone[faceLoc] == point) break;
1581:         if (faceLoc == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of support[0] %D", face, support[0]);
1582:         fgeom->face[face][0] = faceLoc;
1583:         DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);
1584:         for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
1585:         DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);
1586:         if (locA) {
1587:           PetscInt subp;
1588:           DMPlexGetSubpoint(plexA, support[0], &subp);
1589:           DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);
1590:           for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
1591:           DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);
1592:         }
1593:       }
1594:       /* Get blocking */
1595:       {
1596:         PetscQuadrature q;
1597:         PetscInt        numBatches, batchSize, numBlocks, blockSize;
1598:         PetscInt        Nq, Nb;

1600:         PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);
1601:         PetscFEGetQuadrature(fe, &q);
1602:         PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);
1603:         PetscFEGetDimension(fe, &Nb);
1604:         blockSize = Nb*Nq;
1605:         batchSize = numBlocks * blockSize;
1606:         chunkSize = numBatches*batchSize;
1607:         PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);
1608:         numChunks = numFaces / chunkSize;
1609:         Nr        = numFaces % chunkSize;
1610:         offset    = numFaces - Nr;
1611:       }
1612:       /* Do integration for each field */
1613:       for (chunk = 0; chunk < numChunks; ++chunk) {
1614:         PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);
1615:         PetscFEIntegrateBd(fe, prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);
1616:         PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);
1617:       }
1618:       PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);
1619:       PetscFEIntegrateBd(fe, prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);
1620:       PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);
1621:       /* Cleanup data arrays */
1622:       DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);
1623:       PetscQuadratureDestroy(&qGeom);
1624:       PetscFree2(u, a);
1625:       ISRestoreIndices(pointIS, &points);
1626:     }
1627:   }
1628:   if (plex)  {DMDestroy(&plex);}
1629:   if (plexA) {DMDestroy(&plexA);}
1630:   return(0);
1631: }

1633: /*@
1634:   DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user

1636:   Input Parameters:
1637: + dm      - The mesh
1638: . X       - Global input vector
1639: . label   - The boundary DMLabel
1640: . numVals - The number of label values to use, or PETSC_DETERMINE for all values
1641: . vals    - The label values to use, or PETSC_NULL for all values
1642: . func    = The function to integrate along the boundary
1643: - user    - The user context

1645:   Output Parameter:
1646: . integral - Integral for each field

1648:   Level: developer

1650: .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM()
1651: @*/
1652: PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[],
1653:                                        void (*func)(PetscInt, PetscInt, PetscInt,
1654:                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1655:                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1656:                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
1657:                                        PetscScalar *integral, void *user)
1658: {
1659:   Vec            locX;
1660:   PetscSection   section;
1661:   DMLabel        depthLabel;
1662:   IS             facetIS;
1663:   PetscInt       dim, Nf, f, v;

1672:   PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);
1673:   DMPlexGetDepthLabel(dm, &depthLabel);
1674:   DMGetDimension(dm, &dim);
1675:   DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);
1676:   DMGetDefaultSection(dm, &section);
1677:   PetscSectionGetNumFields(section, &Nf);
1678:   /* Get local solution with boundary values */
1679:   DMGetLocalVector(dm, &locX);
1680:   DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);
1681:   DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);
1682:   DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);
1683:   /* Loop over label values */
1684:   PetscMemzero(integral, Nf * sizeof(PetscScalar));
1685:   for (v = 0; v < numVals; ++v) {
1686:     IS           pointIS;
1687:     PetscInt     numFaces, face;
1688:     PetscScalar *fintegral;

1690:     DMLabelGetStratumIS(label, vals[v], &pointIS);
1691:     if (!pointIS) continue; /* No points with that id on this process */
1692:     {
1693:       IS isectIS;

1695:       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
1696:       ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);
1697:       ISDestroy(&pointIS);
1698:       pointIS = isectIS;
1699:     }
1700:     ISGetLocalSize(pointIS, &numFaces);
1701:     PetscCalloc1(numFaces*Nf, &fintegral);
1702:     DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);
1703:     /* Sum point contributions into integral */
1704:     for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f];
1705:     PetscFree(fintegral);
1706:     ISDestroy(&pointIS);
1707:   }
1708:   DMRestoreLocalVector(dm, &locX);
1709:   ISDestroy(&facetIS);
1710:   PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);
1711:   return(0);
1712: }

1714: /*@
1715:   DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to the uniformly refined DM.

1717:   Input Parameters:
1718: + dmf  - The fine mesh
1719: . dmc  - The coarse mesh
1720: - user - The user context

1722:   Output Parameter:
1723: . In  - The interpolation matrix

1725:   Level: developer

1727: .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
1728: @*/
1729: PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, Mat In, void *user)
1730: {
1731:   DM_Plex          *mesh  = (DM_Plex *) dmc->data;
1732:   const char       *name  = "Interpolator";
1733:   PetscDS           prob;
1734:   PetscFE          *feRef;
1735:   PetscFV          *fvRef;
1736:   PetscSection      fsection, fglobalSection;
1737:   PetscSection      csection, cglobalSection;
1738:   PetscScalar      *elemMat;
1739:   PetscInt          dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, cEndInterior, c;
1740:   PetscInt          cTotDim, rTotDim = 0;
1741:   PetscErrorCode    ierr;

1744:   PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);
1745:   DMGetDimension(dmf, &dim);
1746:   DMGetSection(dmf, &fsection);
1747:   DMGetGlobalSection(dmf, &fglobalSection);
1748:   DMGetSection(dmc, &csection);
1749:   DMGetGlobalSection(dmc, &cglobalSection);
1750:   PetscSectionGetNumFields(fsection, &Nf);
1751:   DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);
1752:   DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);
1753:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1754:   DMGetDS(dmf, &prob);
1755:   PetscCalloc2(Nf,&feRef,Nf,&fvRef);
1756:   for (f = 0; f < Nf; ++f) {
1757:     PetscObject  obj;
1758:     PetscClassId id;
1759:     PetscInt     rNb = 0, Nc = 0;

1761:     PetscDSGetDiscretization(prob, f, &obj);
1762:     PetscObjectGetClassId(obj, &id);
1763:     if (id == PETSCFE_CLASSID) {
1764:       PetscFE fe = (PetscFE) obj;

1766:       PetscFERefine(fe, &feRef[f]);
1767:       PetscFEGetDimension(feRef[f], &rNb);
1768:       PetscFEGetNumComponents(fe, &Nc);
1769:     } else if (id == PETSCFV_CLASSID) {
1770:       PetscFV        fv = (PetscFV) obj;
1771:       PetscDualSpace Q;

1773:       PetscFVRefine(fv, &fvRef[f]);
1774:       PetscFVGetDualSpace(fvRef[f], &Q);
1775:       PetscDualSpaceGetDimension(Q, &rNb);
1776:       PetscFVGetNumComponents(fv, &Nc);
1777:     }
1778:     rTotDim += rNb;
1779:   }
1780:   PetscDSGetTotalDimension(prob, &cTotDim);
1781:   PetscMalloc1(rTotDim*cTotDim,&elemMat);
1782:   PetscMemzero(elemMat, rTotDim*cTotDim * sizeof(PetscScalar));
1783:   for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) {
1784:     PetscDualSpace   Qref;
1785:     PetscQuadrature  f;
1786:     const PetscReal *qpoints, *qweights;
1787:     PetscReal       *points;
1788:     PetscInt         npoints = 0, Nc, Np, fpdim, i, k, p, d;

1790:     /* Compose points from all dual basis functionals */
1791:     if (feRef[fieldI]) {
1792:       PetscFEGetDualSpace(feRef[fieldI], &Qref);
1793:       PetscFEGetNumComponents(feRef[fieldI], &Nc);
1794:     } else {
1795:       PetscFVGetDualSpace(fvRef[fieldI], &Qref);
1796:       PetscFVGetNumComponents(fvRef[fieldI], &Nc);
1797:     }
1798:     PetscDualSpaceGetDimension(Qref, &fpdim);
1799:     for (i = 0; i < fpdim; ++i) {
1800:       PetscDualSpaceGetFunctional(Qref, i, &f);
1801:       PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);
1802:       npoints += Np;
1803:     }
1804:     PetscMalloc1(npoints*dim,&points);
1805:     for (i = 0, k = 0; i < fpdim; ++i) {
1806:       PetscDualSpaceGetFunctional(Qref, i, &f);
1807:       PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);
1808:       for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d];
1809:     }

1811:     for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) {
1812:       PetscObject  obj;
1813:       PetscClassId id;
1814:       PetscReal   *B;
1815:       PetscInt     NcJ = 0, cpdim = 0, j, qNc;

1817:       PetscDSGetDiscretization(prob, fieldJ, &obj);
1818:       PetscObjectGetClassId(obj, &id);
1819:       if (id == PETSCFE_CLASSID) {
1820:         PetscFE fe = (PetscFE) obj;

1822:         /* Evaluate basis at points */
1823:         PetscFEGetNumComponents(fe, &NcJ);
1824:         PetscFEGetDimension(fe, &cpdim);
1825:         /* For now, fields only interpolate themselves */
1826:         if (fieldI == fieldJ) {
1827:           if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ);
1828:           PetscFEGetTabulation(fe, npoints, points, &B, NULL, NULL);
1829:           for (i = 0, k = 0; i < fpdim; ++i) {
1830:             PetscDualSpaceGetFunctional(Qref, i, &f);
1831:             PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);
1832:             if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
1833:             for (p = 0; p < Np; ++p, ++k) {
1834:               for (j = 0; j < cpdim; ++j) {
1835:                 /*
1836:                    cTotDim:            Total columns in element interpolation matrix, sum of number of dual basis functionals in each field
1837:                    offsetI, offsetJ:   Offsets into the larger element interpolation matrix for different fields
1838:                    fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals
1839:                    qNC, Nc, Ncj, c:    Number of components in this field
1840:                    Np, p:              Number of quad points in the fine grid functional i
1841:                    k:                  i*Np + p, overall point number for the interpolation
1842:                 */
1843:                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += B[k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c];
1844:               }
1845:             }
1846:           }
1847:           PetscFERestoreTabulation(fe, npoints, points, &B, NULL, NULL);
1848:         }
1849:       } else if (id == PETSCFV_CLASSID) {
1850:         PetscFV        fv = (PetscFV) obj;

1852:         /* Evaluate constant function at points */
1853:         PetscFVGetNumComponents(fv, &NcJ);
1854:         cpdim = 1;
1855:         /* For now, fields only interpolate themselves */
1856:         if (fieldI == fieldJ) {
1857:           if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %d does not match coarse field %d", Nc, NcJ);
1858:           for (i = 0, k = 0; i < fpdim; ++i) {
1859:             PetscDualSpaceGetFunctional(Qref, i, &f);
1860:             PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);
1861:             if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
1862:             for (p = 0; p < Np; ++p, ++k) {
1863:               for (j = 0; j < cpdim; ++j) {
1864:                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c];
1865:               }
1866:             }
1867:           }
1868:         }
1869:       }
1870:       offsetJ += cpdim;
1871:     }
1872:     offsetI += fpdim;
1873:     PetscFree(points);
1874:   }
1875:   if (mesh->printFEM > 1) {DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);}
1876:   /* Preallocate matrix */
1877:   {
1878:     Mat          preallocator;
1879:     PetscScalar *vals;
1880:     PetscInt    *cellCIndices, *cellFIndices;
1881:     PetscInt     locRows, locCols, cell;

1883:     MatGetLocalSize(In, &locRows, &locCols);
1884:     MatCreate(PetscObjectComm((PetscObject) In), &preallocator);
1885:     MatSetType(preallocator, MATPREALLOCATOR);
1886:     MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);
1887:     MatSetUp(preallocator);
1888:     PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);
1889:     for (cell = cStart; cell < cEnd; ++cell) {
1890:       DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);
1891:       MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);
1892:     }
1893:     PetscFree3(vals,cellCIndices,cellFIndices);
1894:     MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);
1895:     MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);
1896:     MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);
1897:     MatDestroy(&preallocator);
1898:   }
1899:   /* Fill matrix */
1900:   MatZeroEntries(In);
1901:   for (c = cStart; c < cEnd; ++c) {
1902:     DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);
1903:   }
1904:   for (f = 0; f < Nf; ++f) {PetscFEDestroy(&feRef[f]);}
1905:   PetscFree2(feRef,fvRef);
1906:   PetscFree(elemMat);
1907:   MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);
1908:   MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);
1909:   if (mesh->printFEM) {
1910:     PetscPrintf(PETSC_COMM_WORLD, "%s:\n", name);
1911:     MatChop(In, 1.0e-10);
1912:     MatView(In, PETSC_VIEWER_STDOUT_WORLD);
1913:   }
1914:   PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);
1915:   return(0);
1916: }

1918: PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user)
1919: {
1920:   SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness");
1921: }

1923: /*@
1924:   DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM.

1926:   Input Parameters:
1927: + dmf  - The fine mesh
1928: . dmc  - The coarse mesh
1929: - user - The user context

1931:   Output Parameter:
1932: . In  - The interpolation matrix

1934:   Level: developer

1936: .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
1937: @*/
1938: PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user)
1939: {
1940:   DM_Plex       *mesh = (DM_Plex *) dmf->data;
1941:   const char    *name = "Interpolator";
1942:   PetscDS        prob;
1943:   PetscSection   fsection, csection, globalFSection, globalCSection;
1944:   PetscHSetIJ    ht;
1945:   PetscLayout    rLayout;
1946:   PetscInt      *dnz, *onz;
1947:   PetscInt       locRows, rStart, rEnd;
1948:   PetscReal     *x, *v0, *J, *invJ, detJ;
1949:   PetscReal     *v0c, *Jc, *invJc, detJc;
1950:   PetscScalar   *elemMat;
1951:   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;

1955:   PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);
1956:   DMGetCoordinateDim(dmc, &dim);
1957:   DMGetDS(dmc, &prob);
1958:   PetscDSGetRefCoordArrays(prob, &x, NULL);
1959:   PetscDSGetNumFields(prob, &Nf);
1960:   PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);
1961:   PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);
1962:   DMGetSection(dmf, &fsection);
1963:   DMGetGlobalSection(dmf, &globalFSection);
1964:   DMGetSection(dmc, &csection);
1965:   DMGetGlobalSection(dmc, &globalCSection);
1966:   DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);
1967:   PetscDSGetTotalDimension(prob, &totDim);
1968:   PetscMalloc1(totDim, &elemMat);

1970:   MatGetLocalSize(In, &locRows, NULL);
1971:   PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);
1972:   PetscLayoutSetLocalSize(rLayout, locRows);
1973:   PetscLayoutSetBlockSize(rLayout, 1);
1974:   PetscLayoutSetUp(rLayout);
1975:   PetscLayoutGetRange(rLayout, &rStart, &rEnd);
1976:   PetscLayoutDestroy(&rLayout);
1977:   PetscCalloc2(locRows,&dnz,locRows,&onz);
1978:   PetscHSetIJCreate(&ht);
1979:   for (field = 0; field < Nf; ++field) {
1980:     PetscObject      obj;
1981:     PetscClassId     id;
1982:     PetscDualSpace   Q = NULL;
1983:     PetscQuadrature  f;
1984:     const PetscReal *qpoints;
1985:     PetscInt         Nc, Np, fpdim, i, d;

1987:     PetscDSGetDiscretization(prob, field, &obj);
1988:     PetscObjectGetClassId(obj, &id);
1989:     if (id == PETSCFE_CLASSID) {
1990:       PetscFE fe = (PetscFE) obj;

1992:       PetscFEGetDualSpace(fe, &Q);
1993:       PetscFEGetNumComponents(fe, &Nc);
1994:     } else if (id == PETSCFV_CLASSID) {
1995:       PetscFV fv = (PetscFV) obj;

1997:       PetscFVGetDualSpace(fv, &Q);
1998:       Nc   = 1;
1999:     }
2000:     PetscDualSpaceGetDimension(Q, &fpdim);
2001:     /* For each fine grid cell */
2002:     for (cell = cStart; cell < cEnd; ++cell) {
2003:       PetscInt *findices,   *cindices;
2004:       PetscInt  numFIndices, numCIndices;

2006:       DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2007:       DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);
2008:       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim);
2009:       for (i = 0; i < fpdim; ++i) {
2010:         Vec             pointVec;
2011:         PetscScalar    *pV;
2012:         PetscSF         coarseCellSF = NULL;
2013:         const PetscSFNode *coarseCells;
2014:         PetscInt        numCoarseCells, q, c;

2016:         /* Get points from the dual basis functional quadrature */
2017:         PetscDualSpaceGetFunctional(Q, i, &f);
2018:         PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);
2019:         VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);
2020:         VecSetBlockSize(pointVec, dim);
2021:         VecGetArray(pointVec, &pV);
2022:         for (q = 0; q < Np; ++q) {
2023:           const PetscReal xi0[3] = {-1., -1., -1.};

2025:           /* Transform point to real space */
2026:           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2027:           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2028:         }
2029:         VecRestoreArray(pointVec, &pV);
2030:         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2031:         /* OPT: Pack all quad points from fine cell */
2032:         DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);
2033:         PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");
2034:         /* Update preallocation info */
2035:         PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);
2036:         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2037:         {
2038:           PetscHashIJKey key;
2039:           PetscBool      missing;

2041:           key.i = findices[i];
2042:           if (key.i >= 0) {
2043:             /* Get indices for coarse elements */
2044:             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2045:               DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2046:               for (c = 0; c < numCIndices; ++c) {
2047:                 key.j = cindices[c];
2048:                 if (key.j < 0) continue;
2049:                 PetscHSetIJQueryAdd(ht, key, &missing);
2050:                 if (missing) {
2051:                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2052:                   else                                     ++onz[key.i-rStart];
2053:                 }
2054:               }
2055:               DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2056:             }
2057:           }
2058:         }
2059:         PetscSFDestroy(&coarseCellSF);
2060:         VecDestroy(&pointVec);
2061:       }
2062:       DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2063:     }
2064:   }
2065:   PetscHSetIJDestroy(&ht);
2066:   MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);
2067:   MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);
2068:   PetscFree2(dnz,onz);
2069:   for (field = 0; field < Nf; ++field) {
2070:     PetscObject      obj;
2071:     PetscClassId     id;
2072:     PetscDualSpace   Q = NULL;
2073:     PetscQuadrature  f;
2074:     const PetscReal *qpoints, *qweights;
2075:     PetscInt         Nc, qNc, Np, fpdim, i, d;

2077:     PetscDSGetDiscretization(prob, field, &obj);
2078:     PetscObjectGetClassId(obj, &id);
2079:     if (id == PETSCFE_CLASSID) {
2080:       PetscFE fe = (PetscFE) obj;

2082:       PetscFEGetDualSpace(fe, &Q);
2083:       PetscFEGetNumComponents(fe, &Nc);
2084:     } else if (id == PETSCFV_CLASSID) {
2085:       PetscFV fv = (PetscFV) obj;

2087:       PetscFVGetDualSpace(fv, &Q);
2088:       Nc   = 1;
2089:     } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %d",field);
2090:     PetscDualSpaceGetDimension(Q, &fpdim);
2091:     /* For each fine grid cell */
2092:     for (cell = cStart; cell < cEnd; ++cell) {
2093:       PetscInt *findices,   *cindices;
2094:       PetscInt  numFIndices, numCIndices;

2096:       DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2097:       DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);
2098:       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim);
2099:       for (i = 0; i < fpdim; ++i) {
2100:         Vec             pointVec;
2101:         PetscScalar    *pV;
2102:         PetscSF         coarseCellSF = NULL;
2103:         const PetscSFNode *coarseCells;
2104:         PetscInt        numCoarseCells, cpdim, q, c, j;

2106:         /* Get points from the dual basis functional quadrature */
2107:         PetscDualSpaceGetFunctional(Q, i, &f);
2108:         PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);
2109:         if (qNc != Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, Nc);
2110:         VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);
2111:         VecSetBlockSize(pointVec, dim);
2112:         VecGetArray(pointVec, &pV);
2113:         for (q = 0; q < Np; ++q) {
2114:           const PetscReal xi0[3] = {-1., -1., -1.};

2116:           /* Transform point to real space */
2117:           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2118:           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2119:         }
2120:         VecRestoreArray(pointVec, &pV);
2121:         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2122:         /* OPT: Read this out from preallocation information */
2123:         DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);
2124:         /* Update preallocation info */
2125:         PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);
2126:         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2127:         VecGetArray(pointVec, &pV);
2128:         for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2129:           PetscReal pVReal[3];
2130:           const PetscReal xi0[3] = {-1., -1., -1.};

2132:           DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2133:           /* Transform points from real space to coarse reference space */
2134:           DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);
2135:           for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2136:           CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);

2138:           if (id == PETSCFE_CLASSID) {
2139:             PetscFE    fe = (PetscFE) obj;
2140:             PetscReal *B;

2142:             /* Evaluate coarse basis on contained point */
2143:             PetscFEGetDimension(fe, &cpdim);
2144:             PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);
2145:             PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));
2146:             /* Get elemMat entries by multiplying by weight */
2147:             for (j = 0; j < cpdim; ++j) {
2148:               for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*qweights[ccell*qNc + c];
2149:             }
2150:             PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);
2151:           } else {
2152:             cpdim = 1;
2153:             for (j = 0; j < cpdim; ++j) {
2154:               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c];
2155:             }
2156:           }
2157:           /* Update interpolator */
2158:           if (mesh->printFEM > 1) {DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);}
2159:           if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2160:           MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);
2161:           DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2162:         }
2163:         VecRestoreArray(pointVec, &pV);
2164:         PetscSFDestroy(&coarseCellSF);
2165:         VecDestroy(&pointVec);
2166:       }
2167:       DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2168:     }
2169:   }
2170:   PetscFree3(v0,J,invJ);
2171:   PetscFree3(v0c,Jc,invJc);
2172:   PetscFree(elemMat);
2173:   MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);
2174:   MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);
2175:   PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);
2176:   return(0);
2177: }

2179: /*@
2180:   DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM.

2182:   Input Parameters:
2183: + dmf  - The fine mesh
2184: . dmc  - The coarse mesh
2185: - user - The user context

2187:   Output Parameter:
2188: . mass  - The mass matrix

2190:   Level: developer

2192: .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2193: @*/
2194: PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user)
2195: {
2196:   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2197:   const char    *name = "Mass Matrix";
2198:   PetscDS        prob;
2199:   PetscSection   fsection, csection, globalFSection, globalCSection;
2200:   PetscHSetIJ    ht;
2201:   PetscLayout    rLayout;
2202:   PetscInt      *dnz, *onz;
2203:   PetscInt       locRows, rStart, rEnd;
2204:   PetscReal     *x, *v0, *J, *invJ, detJ;
2205:   PetscReal     *v0c, *Jc, *invJc, detJc;
2206:   PetscScalar   *elemMat;
2207:   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;

2211:   DMGetCoordinateDim(dmc, &dim);
2212:   DMGetDS(dmc, &prob);
2213:   PetscDSGetRefCoordArrays(prob, &x, NULL);
2214:   PetscDSGetNumFields(prob, &Nf);
2215:   PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);
2216:   PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);
2217:   DMGetSection(dmf, &fsection);
2218:   DMGetGlobalSection(dmf, &globalFSection);
2219:   DMGetSection(dmc, &csection);
2220:   DMGetGlobalSection(dmc, &globalCSection);
2221:   DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);
2222:   PetscDSGetTotalDimension(prob, &totDim);
2223:   PetscMalloc1(totDim, &elemMat);

2225:   MatGetLocalSize(mass, &locRows, NULL);
2226:   PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);
2227:   PetscLayoutSetLocalSize(rLayout, locRows);
2228:   PetscLayoutSetBlockSize(rLayout, 1);
2229:   PetscLayoutSetUp(rLayout);
2230:   PetscLayoutGetRange(rLayout, &rStart, &rEnd);
2231:   PetscLayoutDestroy(&rLayout);
2232:   PetscCalloc2(locRows,&dnz,locRows,&onz);
2233:   PetscHSetIJCreate(&ht);
2234:   for (field = 0; field < Nf; ++field) {
2235:     PetscObject      obj;
2236:     PetscClassId     id;
2237:     PetscQuadrature  quad;
2238:     const PetscReal *qpoints;
2239:     PetscInt         Nq, Nc, i, d;

2241:     PetscDSGetDiscretization(prob, field, &obj);
2242:     PetscObjectGetClassId(obj, &id);
2243:     if (id == PETSCFE_CLASSID) {PetscFEGetQuadrature((PetscFE) obj, &quad);}
2244:     else                       {PetscFVGetQuadrature((PetscFV) obj, &quad);}
2245:     PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);
2246:     /* For each fine grid cell */
2247:     for (cell = cStart; cell < cEnd; ++cell) {
2248:       Vec                pointVec;
2249:       PetscScalar       *pV;
2250:       PetscSF            coarseCellSF = NULL;
2251:       const PetscSFNode *coarseCells;
2252:       PetscInt           numCoarseCells, q, c;
2253:       PetscInt          *findices,   *cindices;
2254:       PetscInt           numFIndices, numCIndices;

2256:       DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2257:       DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);
2258:       /* Get points from the quadrature */
2259:       VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);
2260:       VecSetBlockSize(pointVec, dim);
2261:       VecGetArray(pointVec, &pV);
2262:       for (q = 0; q < Nq; ++q) {
2263:         const PetscReal xi0[3] = {-1., -1., -1.};

2265:         /* Transform point to real space */
2266:         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2267:         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2268:       }
2269:       VecRestoreArray(pointVec, &pV);
2270:       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2271:       DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);
2272:       PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");
2273:       /* Update preallocation info */
2274:       PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);
2275:       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2276:       {
2277:         PetscHashIJKey key;
2278:         PetscBool      missing;

2280:         for (i = 0; i < numFIndices; ++i) {
2281:           key.i = findices[i];
2282:           if (key.i >= 0) {
2283:             /* Get indices for coarse elements */
2284:             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2285:               DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2286:               for (c = 0; c < numCIndices; ++c) {
2287:                 key.j = cindices[c];
2288:                 if (key.j < 0) continue;
2289:                 PetscHSetIJQueryAdd(ht, key, &missing);
2290:                 if (missing) {
2291:                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2292:                   else                                     ++onz[key.i-rStart];
2293:                 }
2294:               }
2295:               DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2296:             }
2297:           }
2298:         }
2299:       }
2300:       PetscSFDestroy(&coarseCellSF);
2301:       VecDestroy(&pointVec);
2302:       DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2303:     }
2304:   }
2305:   PetscHSetIJDestroy(&ht);
2306:   MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);
2307:   MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);
2308:   PetscFree2(dnz,onz);
2309:   for (field = 0; field < Nf; ++field) {
2310:     PetscObject      obj;
2311:     PetscClassId     id;
2312:     PetscQuadrature  quad;
2313:     PetscReal       *Bfine;
2314:     const PetscReal *qpoints, *qweights;
2315:     PetscInt         Nq, Nc, i, d;

2317:     PetscDSGetDiscretization(prob, field, &obj);
2318:     PetscObjectGetClassId(obj, &id);
2319:     if (id == PETSCFE_CLASSID) {PetscFEGetQuadrature((PetscFE) obj, &quad);PetscFEGetDefaultTabulation((PetscFE) obj, &Bfine, NULL, NULL);}
2320:     else                       {PetscFVGetQuadrature((PetscFV) obj, &quad);}
2321:     PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);
2322:     /* For each fine grid cell */
2323:     for (cell = cStart; cell < cEnd; ++cell) {
2324:       Vec                pointVec;
2325:       PetscScalar       *pV;
2326:       PetscSF            coarseCellSF = NULL;
2327:       const PetscSFNode *coarseCells;
2328:       PetscInt           numCoarseCells, cpdim, q, c, j;
2329:       PetscInt          *findices,   *cindices;
2330:       PetscInt           numFIndices, numCIndices;

2332:       DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2333:       DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);
2334:       /* Get points from the quadrature */
2335:       VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);
2336:       VecSetBlockSize(pointVec, dim);
2337:       VecGetArray(pointVec, &pV);
2338:       for (q = 0; q < Nq; ++q) {
2339:         const PetscReal xi0[3] = {-1., -1., -1.};

2341:         /* Transform point to real space */
2342:         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2343:         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2344:       }
2345:       VecRestoreArray(pointVec, &pV);
2346:       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2347:       DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);
2348:       /* Update matrix */
2349:       PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);
2350:       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2351:       VecGetArray(pointVec, &pV);
2352:       for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2353:         PetscReal pVReal[3];
2354:         const PetscReal xi0[3] = {-1., -1., -1.};


2357:         DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2358:         /* Transform points from real space to coarse reference space */
2359:         DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);
2360:         for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2361:         CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);

2363:         if (id == PETSCFE_CLASSID) {
2364:           PetscFE    fe = (PetscFE) obj;
2365:           PetscReal *B;

2367:           /* Evaluate coarse basis on contained point */
2368:           PetscFEGetDimension(fe, &cpdim);
2369:           PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);
2370:           /* Get elemMat entries by multiplying by weight */
2371:           for (i = 0; i < numFIndices; ++i) {
2372:             PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));
2373:             for (j = 0; j < cpdim; ++j) {
2374:               for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*Bfine[(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ;
2375:             }
2376:             /* Update interpolator */
2377:             if (mesh->printFEM > 1) {DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);}
2378:             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2379:             MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);
2380:           }
2381:           PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);
2382:         } else {
2383:           cpdim = 1;
2384:           for (i = 0; i < numFIndices; ++i) {
2385:             PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));
2386:             for (j = 0; j < cpdim; ++j) {
2387:               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ;
2388:             }
2389:             /* Update interpolator */
2390:             if (mesh->printFEM > 1) {DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);}
2391:             PetscPrintf(PETSC_COMM_SELF, "Nq: %d %d Nf: %d %d Nc: %d %d\n", ccell, Nq, i, numFIndices, j, numCIndices);
2392:             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2393:             MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);
2394:           }
2395:         }
2396:         DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);
2397:       }
2398:       VecRestoreArray(pointVec, &pV);
2399:       PetscSFDestroy(&coarseCellSF);
2400:       VecDestroy(&pointVec);
2401:       DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);
2402:     }
2403:   }
2404:   PetscFree3(v0,J,invJ);
2405:   PetscFree3(v0c,Jc,invJc);
2406:   PetscFree(elemMat);
2407:   MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);
2408:   MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);
2409:   return(0);
2410: }

2412: /*@
2413:   DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns

2415:   Input Parameters:
2416: + dmc  - The coarse mesh
2417: - dmf  - The fine mesh
2418: - user - The user context

2420:   Output Parameter:
2421: . sc   - The mapping

2423:   Level: developer

2425: .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
2426: @*/
2427: PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user)
2428: {
2429:   PetscDS        prob;
2430:   PetscFE       *feRef;
2431:   PetscFV       *fvRef;
2432:   Vec            fv, cv;
2433:   IS             fis, cis;
2434:   PetscSection   fsection, fglobalSection, csection, cglobalSection;
2435:   PetscInt      *cmap, *cellCIndices, *cellFIndices, *cindices, *findices;
2436:   PetscInt       cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, cEndInterior, c, dim, d, startC, endC, offsetC, offsetF, m;
2437:   PetscBool     *needAvg;

2441:   PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);
2442:   DMGetDimension(dmf, &dim);
2443:   DMGetSection(dmf, &fsection);
2444:   DMGetGlobalSection(dmf, &fglobalSection);
2445:   DMGetSection(dmc, &csection);
2446:   DMGetGlobalSection(dmc, &cglobalSection);
2447:   PetscSectionGetNumFields(fsection, &Nf);
2448:   DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);
2449:   DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);
2450:   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
2451:   DMGetDS(dmc, &prob);
2452:   PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);
2453:   for (f = 0; f < Nf; ++f) {
2454:     PetscObject  obj;
2455:     PetscClassId id;
2456:     PetscInt     fNb = 0, Nc = 0;

2458:     PetscDSGetDiscretization(prob, f, &obj);
2459:     PetscObjectGetClassId(obj, &id);
2460:     if (id == PETSCFE_CLASSID) {
2461:       PetscFE    fe = (PetscFE) obj;
2462:       PetscSpace sp;
2463:       PetscInt   maxDegree;

2465:       PetscFERefine(fe, &feRef[f]);
2466:       PetscFEGetDimension(feRef[f], &fNb);
2467:       PetscFEGetNumComponents(fe, &Nc);
2468:       PetscFEGetBasisSpace(fe, &sp);
2469:       PetscSpaceGetDegree(sp, NULL, &maxDegree);
2470:       if (!maxDegree) needAvg[f] = PETSC_TRUE;
2471:     } else if (id == PETSCFV_CLASSID) {
2472:       PetscFV        fv = (PetscFV) obj;
2473:       PetscDualSpace Q;

2475:       PetscFVRefine(fv, &fvRef[f]);
2476:       PetscFVGetDualSpace(fvRef[f], &Q);
2477:       PetscDualSpaceGetDimension(Q, &fNb);
2478:       PetscFVGetNumComponents(fv, &Nc);
2479:       needAvg[f] = PETSC_TRUE;
2480:     }
2481:     fTotDim += fNb;
2482:   }
2483:   PetscDSGetTotalDimension(prob, &cTotDim);
2484:   PetscMalloc1(cTotDim,&cmap);
2485:   for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) {
2486:     PetscFE        feC;
2487:     PetscFV        fvC;
2488:     PetscDualSpace QF, QC;
2489:     PetscInt       order = -1, NcF, NcC, fpdim, cpdim;

2491:     if (feRef[field]) {
2492:       PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);
2493:       PetscFEGetNumComponents(feC, &NcC);
2494:       PetscFEGetNumComponents(feRef[field], &NcF);
2495:       PetscFEGetDualSpace(feRef[field], &QF);
2496:       PetscDualSpaceGetOrder(QF, &order);
2497:       PetscDualSpaceGetDimension(QF, &fpdim);
2498:       PetscFEGetDualSpace(feC, &QC);
2499:       PetscDualSpaceGetDimension(QC, &cpdim);
2500:     } else {
2501:       PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);
2502:       PetscFVGetNumComponents(fvC, &NcC);
2503:       PetscFVGetNumComponents(fvRef[field], &NcF);
2504:       PetscFVGetDualSpace(fvRef[field], &QF);
2505:       PetscDualSpaceGetDimension(QF, &fpdim);
2506:       PetscFVGetDualSpace(fvC, &QC);
2507:       PetscDualSpaceGetDimension(QC, &cpdim);
2508:     }
2509:     if (NcF != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %d does not match coarse field %d", NcF, NcC);
2510:     for (c = 0; c < cpdim; ++c) {
2511:       PetscQuadrature  cfunc;
2512:       const PetscReal *cqpoints, *cqweights;
2513:       PetscInt         NqcC, NpC;
2514:       PetscBool        found = PETSC_FALSE;

2516:       PetscDualSpaceGetFunctional(QC, c, &cfunc);
2517:       PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);
2518:       if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcC, NcC);
2519:       if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments");
2520:       for (f = 0; f < fpdim; ++f) {
2521:         PetscQuadrature  ffunc;
2522:         const PetscReal *fqpoints, *fqweights;
2523:         PetscReal        sum = 0.0;
2524:         PetscInt         NqcF, NpF;

2526:         PetscDualSpaceGetFunctional(QF, f, &ffunc);
2527:         PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);
2528:         if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcF, NcF);
2529:         if (NpC != NpF) continue;
2530:         for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]);
2531:         if (sum > 1.0e-9) continue;
2532:         for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]);
2533:         if (sum < 1.0e-9) continue;
2534:         cmap[offsetC+c] = offsetF+f;
2535:         found = PETSC_TRUE;
2536:         break;
2537:       }
2538:       if (!found) {
2539:         /* TODO We really want the average here, but some asshole put VecScatter in the interface */
2540:         if (fvRef[field] || (feRef[field] && order == 0)) {
2541:           cmap[offsetC+c] = offsetF+0;
2542:         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection");
2543:       }
2544:     }
2545:     offsetC += cpdim;
2546:     offsetF += fpdim;
2547:   }
2548:   for (f = 0; f < Nf; ++f) {PetscFEDestroy(&feRef[f]);PetscFVDestroy(&fvRef[f]);}
2549:   PetscFree3(feRef,fvRef,needAvg);

2551:   DMGetGlobalVector(dmf, &fv);
2552:   DMGetGlobalVector(dmc, &cv);
2553:   VecGetOwnershipRange(cv, &startC, &endC);
2554:   PetscSectionGetConstrainedStorageSize(cglobalSection, &m);
2555:   PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);
2556:   PetscMalloc1(m,&cindices);
2557:   PetscMalloc1(m,&findices);
2558:   for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
2559:   for (c = cStart; c < cEnd; ++c) {
2560:     DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);
2561:     for (d = 0; d < cTotDim; ++d) {
2562:       if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue;
2563:       if ((findices[cellCIndices[d]-startC] >= 0) && (findices[cellCIndices[d]-startC] != cellFIndices[cmap[d]])) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Coarse dof %d maps to both %d and %d", cindices[cellCIndices[d]-startC], findices[cellCIndices[d]-startC], cellFIndices[cmap[d]]);
2564:       cindices[cellCIndices[d]-startC] = cellCIndices[d];
2565:       findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]];
2566:     }
2567:   }
2568:   PetscFree(cmap);
2569:   PetscFree2(cellCIndices,cellFIndices);

2571:   ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);
2572:   ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);
2573:   VecScatterCreate(cv, cis, fv, fis, sc);
2574:   ISDestroy(&cis);
2575:   ISDestroy(&fis);
2576:   DMRestoreGlobalVector(dmf, &fv);
2577:   DMRestoreGlobalVector(dmc, &cv);
2578:   PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);
2579:   return(0);
2580: }

2582: PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
2583: {
2584:   char            composeStr[33] = {0};
2585:   PetscObjectId   id;
2586:   PetscContainer  container;
2587:   PetscErrorCode  ierr;

2590:   PetscObjectGetId((PetscObject)quad,&id);
2591:   PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);
2592:   PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);
2593:   if (container) {
2594:     PetscContainerGetPointer(container, (void **) geom);
2595:   } else {
2596:     DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);
2597:     PetscContainerCreate(PETSC_COMM_SELF,&container);
2598:     PetscContainerSetPointer(container, (void *) *geom);
2599:     PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);
2600:     PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);
2601:     PetscContainerDestroy(&container);
2602:   }
2603:   return(0);
2604: }

2606: PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
2607: {
2609:   *geom = NULL;
2610:   return(0);
2611: }

2613: /*
2614:   We always assemble JacP, and if the matrix is different from Jac and two different sets of point functions are provided, we also assemble Jac

2616:   X   - The local solution vector
2617:   X_t - The local solution time derviative vector, or NULL
2618: */
2619: PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS,
2620:                                                     PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx)
2621: {
2622:   DM_Plex         *mesh  = (DM_Plex *) dm->data;
2623:   const char      *name = "Jacobian", *nameP = "JacobianPre";
2624:   DM               dmAux = NULL;
2625:   PetscDS          prob,   probAux = NULL;
2626:   PetscSection     sectionAux = NULL;
2627:   Vec              A;
2628:   DMField          coordField;
2629:   PetscFEGeom     *cgeomFEM;
2630:   PetscQuadrature  qGeom = NULL;
2631:   Mat              J = Jac, JP = JacP;
2632:   PetscScalar     *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL;
2633:   PetscBool        hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE;
2634:   const PetscInt  *cells;
2635:   PetscInt         Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0;
2636:   PetscErrorCode   ierr;

2639:   CHKMEMQ;
2640:   ISGetLocalSize(cellIS, &numCells);
2641:   ISGetPointRange(cellIS, &cStart, &cEnd, &cells);
2642:   PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);
2643:   DMGetDS(dm, &prob);
2644:   PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);
2645:   PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);
2646:   if (dmAux) {
2647:     DMGetDefaultSection(dmAux, &sectionAux);
2648:     DMGetDS(dmAux, &probAux);
2649:   }
2650:   /* Get flags */
2651:   PetscDSGetNumFields(prob, &Nf);
2652:   DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);
2653:   for (fieldI = 0; fieldI < Nf; ++fieldI) {
2654:     PetscObject  disc;
2655:     PetscClassId id;
2656:     PetscDSGetDiscretization(prob, fieldI, &disc);
2657:     PetscObjectGetClassId(disc, &id);
2658:     if (id == PETSCFE_CLASSID)      {isFE[fieldI] = PETSC_TRUE;}
2659:     else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;}
2660:   }
2661:   PetscDSHasJacobian(prob, &hasJac);
2662:   PetscDSHasJacobianPreconditioner(prob, &hasPrec);
2663:   PetscDSHasDynamicJacobian(prob, &hasDyn);
2664:   assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE;
2665:   hasDyn      = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
2666:   PetscObjectTypeCompare((PetscObject) Jac,  MATIS, &isMatIS);
2667:   PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);
2668:   /* Setup input data and temp arrays (should be DMGetWorkArray) */
2669:   if (isMatISP || isMatISP) {DMPlexGetSubdomainSection(dm, &globalSection);}
2670:   if (isMatIS)  {MatISGetLocalMat(Jac,  &J);}
2671:   if (isMatISP) {MatISGetLocalMat(JacP, &JP);}
2672:   if (hasFV)    {MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);} /* No allocated space for FV stuff, so ignore the zero entries */
2673:   PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);
2674:   PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);
2675:   PetscDSGetTotalDimension(prob, &totDim);
2676:   if (probAux) {PetscDSGetTotalDimension(probAux, &totDimAux);}
2677:   CHKMEMQ;
2678:   /* Compute batch sizes */
2679:   if (isFE[0]) {
2680:     PetscFE         fe;
2681:     PetscQuadrature q;
2682:     PetscInt        numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb;

2684:     PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);
2685:     PetscFEGetQuadrature(fe, &q);
2686:     PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);
2687:     PetscFEGetDimension(fe, &Nb);
2688:     PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);
2689:     blockSize = Nb*numQuadPoints;
2690:     batchSize = numBlocks  * blockSize;
2691:     chunkSize = numBatches * batchSize;
2692:     numChunks = numCells / chunkSize + numCells % chunkSize;
2693:     PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);
2694:   } else {
2695:     chunkSize = numCells;
2696:     numChunks = 1;
2697:   }
2698:   /* Get work space */
2699:   wsz  = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize;
2700:   DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);
2701:   PetscMemzero(work, wsz * sizeof(PetscScalar));
2702:   off      = 0;
2703:   u        = X       ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
2704:   u_t      = X_t     ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
2705:   a        = dmAux   ? (sz = chunkSize*totDimAux,     off += sz, work+off-sz) : NULL;
2706:   elemMat  = hasJac  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
2707:   elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
2708:   elemMatD = hasDyn  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
2709:   if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz);
2710:   /* Setup geometry */
2711:   DMGetCoordinateField(dm, &coordField);
2712:   DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);
2713:   if (maxDegree <= 1) {DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);}
2714:   if (!qGeom) {
2715:     PetscFE fe;

2717:     PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);
2718:     PetscFEGetQuadrature(fe, &qGeom);
2719:     PetscObjectReference((PetscObject) qGeom);
2720:   }
2721:   DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);
2722:   /* Compute volume integrals */
2723:   if (assembleJac) {MatZeroEntries(J);}
2724:   MatZeroEntries(JP);
2725:   for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) {
2726:     const PetscInt   Ncell = PetscMin(chunkSize, numCells - offCell);
2727:     PetscInt         c;

2729:     /* Extract values */
2730:     for (c = 0; c < Ncell; ++c) {
2731:       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
2732:       PetscScalar   *x = NULL,  *x_t = NULL;
2733:       PetscInt       i;

2735:       if (X) {
2736:         DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);
2737:         for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
2738:         DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);
2739:       }
2740:       if (X_t) {
2741:         DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);
2742:         for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
2743:         DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);
2744:       }
2745:       if (dmAux) {
2746:         DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);
2747:         for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
2748:         DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);
2749:       }
2750:     }
2751:     CHKMEMQ;
2752:     for (fieldI = 0; fieldI < Nf; ++fieldI) {
2753:       PetscFE fe;
2754:       PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);
2755:       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
2756:         if (hasJac)  {PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN,     fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);}
2757:         if (hasPrec) {PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);}
2758:         if (hasDyn)  {PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);}
2759:       }
2760:       /* For finite volume, add the identity */
2761:       if (!isFE[fieldI]) {
2762:         PetscFV  fv;
2763:         PetscInt eOffset = 0, Nc, fc, foff;

2765:         PetscDSGetFieldOffset(prob, fieldI, &foff);
2766:         PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);
2767:         PetscFVGetNumComponents(fv, &Nc);
2768:         for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) {
2769:           for (fc = 0; fc < Nc; ++fc) {
2770:             const PetscInt i = foff + fc;
2771:             if (hasJac)  {elemMat [eOffset+i*totDim+i] = 1.0;}
2772:             if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;}
2773:           }
2774:         }
2775:       }
2776:     }
2777:     CHKMEMQ;
2778:     /*   Add contribution from X_t */
2779:     if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
2780:     /* Insert values into matrix */
2781:     for (c = 0; c < Ncell; ++c) {
2782:       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
2783:       if (mesh->printFEM > 1) {
2784:         if (hasJac)  {DMPrintCellMatrix(cell, name,  totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);}
2785:         if (hasPrec) {DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);}
2786:       }
2787:       if (assembleJac) {DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);}
2788:       DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);
2789:     }
2790:     CHKMEMQ;
2791:   }
2792:   /* Cleanup */
2793:   DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);
2794:   PetscQuadratureDestroy(&qGeom);
2795:   if (hasFV) {MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);}
2796:   DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);
2797:   DMRestoreWorkArray(dm, ((1 + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize, MPIU_SCALAR, &work);
2798:   /* Compute boundary integrals */
2799:   /* DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx); */
2800:   /* Assemble matrix */
2801:   if (assembleJac) {MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);}
2802:   MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);
2803:   PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);
2804:   CHKMEMQ;
2805:   return(0);
2806: }