xref: /petsc/src/dm/impls/plex/plexfem.c (revision 87050cfd2c0579ea516b8fcfef1cf8502bc01bdc)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petscsf.h>
3 #include <petscsnes.h>
4 
5 #include <petsc/private/hashsetij.h>
6 #include <petsc/private/petscfeimpl.h>
7 #include <petsc/private/petscfvimpl.h>
8 
9 static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx)
10 {
11   PetscFEGeom *geom = (PetscFEGeom *) ctx;
12   PetscErrorCode ierr;
13 
14   PetscFunctionBegin;
15   ierr = PetscFEGeomDestroy(&geom);CHKERRQ(ierr);
16   PetscFunctionReturn(0);
17 }
18 
19 static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
20 {
21   char            composeStr[33] = {0};
22   PetscObjectId   id;
23   PetscContainer  container;
24   PetscErrorCode  ierr;
25 
26   PetscFunctionBegin;
27   ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
28   ierr = PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);CHKERRQ(ierr);
29   ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
30   if (container) {
31     ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
32   } else {
33     ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
34     ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
35     ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
36     ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
37     ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
38     ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
39   }
40   PetscFunctionReturn(0);
41 }
42 
43 static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
44 {
45   PetscFunctionBegin;
46   *geom = NULL;
47   PetscFunctionReturn(0);
48 }
49 
50 /*@
51   DMPlexGetScale - Get the scale for the specified fundamental unit
52 
53   Not collective
54 
55   Input Arguments:
56 + dm   - the DM
57 - unit - The SI unit
58 
59   Output Argument:
60 . scale - The value used to scale all quantities with this unit
61 
62   Level: advanced
63 
64 .seealso: DMPlexSetScale(), PetscUnit
65 @*/
66 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale)
67 {
68   DM_Plex *mesh = (DM_Plex*) dm->data;
69 
70   PetscFunctionBegin;
71   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
72   PetscValidPointer(scale, 3);
73   *scale = mesh->scale[unit];
74   PetscFunctionReturn(0);
75 }
76 
77 /*@
78   DMPlexSetScale - Set the scale for the specified fundamental unit
79 
80   Not collective
81 
82   Input Arguments:
83 + dm   - the DM
84 . unit - The SI unit
85 - scale - The value used to scale all quantities with this unit
86 
87   Level: advanced
88 
89 .seealso: DMPlexGetScale(), PetscUnit
90 @*/
91 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale)
92 {
93   DM_Plex *mesh = (DM_Plex*) dm->data;
94 
95   PetscFunctionBegin;
96   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
97   mesh->scale[unit] = scale;
98   PetscFunctionReturn(0);
99 }
100 
101 static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *mode, void *ctx)
102 {
103   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}}};
104   PetscInt *ctxInt  = (PetscInt *) ctx;
105   PetscInt  dim2    = ctxInt[0];
106   PetscInt  d       = ctxInt[1];
107   PetscInt  i, j, k = dim > 2 ? d - dim : d;
108 
109   PetscFunctionBegin;
110   if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %d does not match context dimension %d", dim, dim2);
111   for (i = 0; i < dim; i++) mode[i] = 0.;
112   if (d < dim) {
113     mode[d] = 1.; /* Translation along axis d */
114   } else {
115     for (i = 0; i < dim; i++) {
116       for (j = 0; j < dim; j++) {
117         mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */
118       }
119     }
120   }
121   PetscFunctionReturn(0);
122 }
123 
124 /*@
125   DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation
126 
127   Collective on DM
128 
129   Input Arguments:
130 . dm - the DM
131 
132   Output Argument:
133 . sp - the null space
134 
135   Note: This is necessary to provide a suitable coarse space for algebraic multigrid
136 
137   Level: advanced
138 
139 .seealso: MatNullSpaceCreate(), PCGAMG
140 @*/
141 PetscErrorCode DMPlexCreateRigidBody(DM dm, MatNullSpace *sp)
142 {
143   MPI_Comm       comm;
144   Vec            mode[6];
145   PetscSection   section, globalSection;
146   PetscInt       dim, dimEmbed, n, m, mmin, d, i, j;
147   PetscErrorCode ierr;
148 
149   PetscFunctionBegin;
150   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
151   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
152   ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
153   if (dim == 1) {
154     ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr);
155     PetscFunctionReturn(0);
156   }
157   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
158   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
159   ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
160   m    = (dim*(dim+1))/2;
161   ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
162   ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
163   ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
164   ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr);
165   mmin = PetscMin(m, n);
166   for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
167   for (d = 0; d < m; d++) {
168     PetscInt         ctx[2];
169     PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
170     void            *voidctx = (void *) (&ctx[0]);
171 
172     ctx[0] = dimEmbed;
173     ctx[1] = d;
174     ierr = DMProjectFunction(dm, 0.0, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
175   }
176   for (i = 0; i < PetscMin(dim, mmin); ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);}
177   /* Orthonormalize system */
178   for (i = dim; i < mmin; ++i) {
179     PetscScalar dots[6];
180 
181     ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr);
182     for (j = 0; j < i; ++j) dots[j] *= -1.0;
183     ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr);
184     ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
185   }
186   ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr);
187   for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
188   PetscFunctionReturn(0);
189 }
190 
191 /*@
192   DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation
193 
194   Collective on DM
195 
196   Input Arguments:
197 + dm    - the DM
198 . nb    - The number of bodies
199 . label - The DMLabel marking each domain
200 . nids  - The number of ids per body
201 - ids   - An array of the label ids in sequence for each domain
202 
203   Output Argument:
204 . sp - the null space
205 
206   Note: This is necessary to provide a suitable coarse space for algebraic multigrid
207 
208   Level: advanced
209 
210 .seealso: MatNullSpaceCreate()
211 @*/
212 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp)
213 {
214   MPI_Comm       comm;
215   PetscSection   section, globalSection;
216   Vec           *mode;
217   PetscScalar   *dots;
218   PetscInt       dim, dimEmbed, n, m, b, d, i, j, off;
219   PetscErrorCode ierr;
220 
221   PetscFunctionBegin;
222   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
223   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
224   ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
225   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
226   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
227   ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
228   m    = nb * (dim*(dim+1))/2;
229   ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr);
230   ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
231   ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
232   ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
233   for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
234   for (b = 0, off = 0; b < nb; ++b) {
235     for (d = 0; d < m/nb; ++d) {
236       PetscInt         ctx[2];
237       PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
238       void            *voidctx = (void *) (&ctx[0]);
239 
240       ctx[0] = dimEmbed;
241       ctx[1] = d;
242       ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
243       off   += nids[b];
244     }
245   }
246   for (i = 0; i < dim; ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);}
247   /* Orthonormalize system */
248   for (i = 0; i < m; ++i) {
249     ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr);
250     for (j = 0; j < i; ++j) dots[j] *= -1.0;
251     ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr);
252     ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
253   }
254   ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr);
255   for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
256   ierr = PetscFree2(mode, dots);CHKERRQ(ierr);
257   PetscFunctionReturn(0);
258 }
259 
260 /*@
261   DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs
262   are computed by associating the basis function with one of the mesh points in its transitively-closed support, and
263   evaluating the dual space basis of that point.  A basis function is associated with the point in its
264   transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum
265   projection height, which is set with this function.  By default, the maximum projection height is zero, which means
266   that only mesh cells are used to project basis functions.  A height of one, for example, evaluates a cell-interior
267   basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face.
268 
269   Input Parameters:
270 + dm - the DMPlex object
271 - height - the maximum projection height >= 0
272 
273   Level: advanced
274 
275 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
276 @*/
277 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height)
278 {
279   DM_Plex *plex = (DM_Plex *) dm->data;
280 
281   PetscFunctionBegin;
282   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
283   plex->maxProjectionHeight = height;
284   PetscFunctionReturn(0);
285 }
286 
287 /*@
288   DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in
289   DMPlexProjectXXXLocal() functions.
290 
291   Input Parameters:
292 . dm - the DMPlex object
293 
294   Output Parameters:
295 . height - the maximum projection height
296 
297   Level: intermediate
298 
299 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
300 @*/
301 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height)
302 {
303   DM_Plex *plex = (DM_Plex *) dm->data;
304 
305   PetscFunctionBegin;
306   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
307   *height = plex->maxProjectionHeight;
308   PetscFunctionReturn(0);
309 }
310 
311 /*@C
312   DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector
313 
314   Input Parameters:
315 + dm     - The DM, with a PetscDS that matches the problem being constrained
316 . time   - The time
317 . field  - The field to constrain
318 . Nc     - The number of constrained field components, or 0 for all components
319 . comps  - An array of constrained component numbers, or NULL for all components
320 . label  - The DMLabel defining constrained points
321 . numids - The number of DMLabel ids for constrained points
322 . ids    - An array of ids for constrained points
323 . func   - A pointwise function giving boundary values
324 - ctx    - An optional user context for bcFunc
325 
326   Output Parameter:
327 . locX   - A local vector to receives the boundary values
328 
329   Level: developer
330 
331 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
332 @*/
333 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)
334 {
335   PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx);
336   void            **ctxs;
337   PetscInt          numFields;
338   PetscErrorCode    ierr;
339 
340   PetscFunctionBegin;
341   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
342   ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
343   funcs[field] = func;
344   ctxs[field]  = ctx;
345   ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
346   ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
347   PetscFunctionReturn(0);
348 }
349 
350 /*@C
351   DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector
352 
353   Input Parameters:
354 + dm     - The DM, with a PetscDS that matches the problem being constrained
355 . time   - The time
356 . locU   - A local vector with the input solution values
357 . field  - The field to constrain
358 . Nc     - The number of constrained field components, or 0 for all components
359 . comps  - An array of constrained component numbers, or NULL for all components
360 . label  - The DMLabel defining constrained points
361 . numids - The number of DMLabel ids for constrained points
362 . ids    - An array of ids for constrained points
363 . func   - A pointwise function giving boundary values
364 - ctx    - An optional user context for bcFunc
365 
366   Output Parameter:
367 . locX   - A local vector to receives the boundary values
368 
369   Level: developer
370 
371 .seealso: DMPlexInsertBoundaryValuesEssential(), DMAddBoundary()
372 @*/
373 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
374                                                         void (*func)(PetscInt, PetscInt, PetscInt,
375                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
376                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
377                                                                      PetscReal, const PetscReal[], PetscInt, const PetscScalar[],
378                                                                      PetscScalar[]),
379                                                         void *ctx, Vec locX)
380 {
381   void (**funcs)(PetscInt, PetscInt, PetscInt,
382                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
383                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
384                  PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
385   void            **ctxs;
386   PetscInt          numFields;
387   PetscErrorCode    ierr;
388 
389   PetscFunctionBegin;
390   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
391   ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
392   funcs[field] = func;
393   ctxs[field]  = ctx;
394   ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
395   ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
396   PetscFunctionReturn(0);
397 }
398 
399 /*@C
400   DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector
401 
402   Input Parameters:
403 + dm     - The DM, with a PetscDS that matches the problem being constrained
404 . time   - The time
405 . faceGeometry - A vector with the FVM face geometry information
406 . cellGeometry - A vector with the FVM cell geometry information
407 . Grad         - A vector with the FVM cell gradient information
408 . field  - The field to constrain
409 . Nc     - The number of constrained field components, or 0 for all components
410 . comps  - An array of constrained component numbers, or NULL for all components
411 . label  - The DMLabel defining constrained points
412 . numids - The number of DMLabel ids for constrained points
413 . ids    - An array of ids for constrained points
414 . func   - A pointwise function giving boundary values
415 - ctx    - An optional user context for bcFunc
416 
417   Output Parameter:
418 . locX   - A local vector to receives the boundary values
419 
420   Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary()
421 
422   Level: developer
423 
424 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
425 @*/
426 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[],
427                                                  PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX)
428 {
429   PetscDS            prob;
430   PetscSF            sf;
431   DM                 dmFace, dmCell, dmGrad;
432   const PetscScalar *facegeom, *cellgeom = NULL, *grad;
433   const PetscInt    *leaves;
434   PetscScalar       *x, *fx;
435   PetscInt           dim, nleaves, loc, fStart, fEnd, pdim, i;
436   PetscErrorCode     ierr, ierru = 0;
437 
438   PetscFunctionBegin;
439   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
440   ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr);
441   nleaves = PetscMax(0, nleaves);
442   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
443   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
444   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
445   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
446   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
447   if (cellGeometry) {
448     ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
449     ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
450   }
451   if (Grad) {
452     PetscFV fv;
453 
454     ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr);
455     ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr);
456     ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr);
457     ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
458     ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
459   }
460   ierr = VecGetArray(locX, &x);CHKERRQ(ierr);
461   for (i = 0; i < numids; ++i) {
462     IS              faceIS;
463     const PetscInt *faces;
464     PetscInt        numFaces, f;
465 
466     ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr);
467     if (!faceIS) continue; /* No points with that id on this process */
468     ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
469     ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
470     for (f = 0; f < numFaces; ++f) {
471       const PetscInt         face = faces[f], *cells;
472       PetscFVFaceGeom        *fg;
473 
474       if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */
475       ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr);
476       if (loc >= 0) continue;
477       ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
478       ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
479       if (Grad) {
480         PetscFVCellGeom       *cg;
481         PetscScalar           *cx, *cgrad;
482         PetscScalar           *xG;
483         PetscReal              dx[3];
484         PetscInt               d;
485 
486         ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr);
487         ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr);
488         ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr);
489         ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
490         DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx);
491         for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx);
492         ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx);
493         if (ierru) {
494           ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
495           ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
496           goto cleanup;
497         }
498       } else {
499         PetscScalar       *xI;
500         PetscScalar       *xG;
501 
502         ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr);
503         ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
504         ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);
505         if (ierru) {
506           ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
507           ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
508           goto cleanup;
509         }
510       }
511     }
512     ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
513     ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
514   }
515   cleanup:
516   ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr);
517   if (Grad) {
518     ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
519     ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr);
520   }
521   if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);}
522   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
523   CHKERRQ(ierru);
524   PetscFunctionReturn(0);
525 }
526 
527 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
528 {
529   PetscInt       numBd, b;
530   PetscErrorCode ierr;
531 
532   PetscFunctionBegin;
533   ierr = PetscDSGetNumBoundary(dm->prob, &numBd);CHKERRQ(ierr);
534   for (b = 0; b < numBd; ++b) {
535     DMBoundaryConditionType type;
536     const char             *labelname;
537     DMLabel                 label;
538     PetscInt                field, Nc;
539     const PetscInt         *comps;
540     PetscObject             obj;
541     PetscClassId            id;
542     void                    (*func)(void);
543     PetscInt                numids;
544     const PetscInt         *ids;
545     void                   *ctx;
546 
547     ierr = DMGetBoundary(dm, b, &type, NULL, &labelname, &field, &Nc, &comps, &func, &numids, &ids, &ctx);CHKERRQ(ierr);
548     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
549     ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr);
550     ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
551     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
552     if (id == PETSCFE_CLASSID) {
553       switch (type) {
554         /* for FEM, there is no insertion to be done for non-essential boundary conditions */
555       case DM_BC_ESSENTIAL:
556         ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
557         ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);CHKERRQ(ierr);
558         ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
559         break;
560       case DM_BC_ESSENTIAL_FIELD:
561         ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
562         ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids,
563                                                         (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
564                                                                   const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
565                                                                   PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);CHKERRQ(ierr);
566         ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
567         break;
568       default: break;
569       }
570     } else if (id == PETSCFV_CLASSID) {
571       if (!faceGeomFVM) continue;
572       ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids,
573                                                (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);CHKERRQ(ierr);
574     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
575   }
576   PetscFunctionReturn(0);
577 }
578 
579 /*@
580   DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector
581 
582   Input Parameters:
583 + dm - The DM
584 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
585 . time - The time
586 . faceGeomFVM - Face geometry data for FV discretizations
587 . cellGeomFVM - Cell geometry data for FV discretizations
588 - gradFVM - Gradient reconstruction data for FV discretizations
589 
590   Output Parameters:
591 . locX - Solution updated with boundary values
592 
593   Level: developer
594 
595 .seealso: DMProjectFunctionLabelLocal()
596 @*/
597 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
598 {
599   PetscErrorCode ierr;
600 
601   PetscFunctionBegin;
602   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
603   PetscValidHeaderSpecific(locX, VEC_CLASSID, 2);
604   if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);}
605   if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);}
606   if (gradFVM)     {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);}
607   ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr);
608   PetscFunctionReturn(0);
609 }
610 
611 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
612 {
613   Vec              localX;
614   PetscErrorCode   ierr;
615 
616   PetscFunctionBegin;
617   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
618   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr);
619   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
620   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
621   ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr);
622   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
623   PetscFunctionReturn(0);
624 }
625 
626 /*@C
627   DMComputeL2Diff - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h.
628 
629   Input Parameters:
630 + dm     - The DM
631 . time   - The time
632 . funcs  - The functions to evaluate for each field component
633 . ctxs   - Optional array of contexts to pass to each function, or NULL.
634 - localX - The coefficient vector u_h, a local vector
635 
636   Output Parameter:
637 . diff - The diff ||u - u_h||_2
638 
639   Level: developer
640 
641 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff()
642 @*/
643 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff)
644 {
645   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
646   PetscSection     section;
647   PetscQuadrature  quad;
648   PetscScalar     *funcVal, *interpolant;
649   PetscReal       *coords, *detJ, *J;
650   PetscReal        localDiff = 0.0;
651   const PetscReal *quadWeights;
652   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, cEndInterior, c, field, fieldOffset;
653   PetscErrorCode   ierr;
654 
655   PetscFunctionBegin;
656   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
657   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
658   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
659   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
660   for (field = 0; field < numFields; ++field) {
661     PetscObject  obj;
662     PetscClassId id;
663     PetscInt     Nc;
664 
665     ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
666     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
667     if (id == PETSCFE_CLASSID) {
668       PetscFE fe = (PetscFE) obj;
669 
670       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
671       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
672     } else if (id == PETSCFV_CLASSID) {
673       PetscFV fv = (PetscFV) obj;
674 
675       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
676       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
677     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
678     numComponents += Nc;
679   }
680   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr);
681   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
682   ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr);
683   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
684   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
685   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
686   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
687   for (c = cStart; c < cEnd; ++c) {
688     PetscScalar *x = NULL;
689     PetscReal    elemDiff = 0.0;
690     PetscInt     qc = 0;
691 
692     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr);
693     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
694 
695     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
696       PetscObject  obj;
697       PetscClassId id;
698       void * const ctx = ctxs ? ctxs[field] : NULL;
699       PetscInt     Nb, Nc, q, fc;
700 
701       ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
702       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
703       if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
704       else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
705       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
706       if (debug) {
707         char title[1024];
708         ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr);
709         ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
710       }
711       for (q = 0; q < Nq; ++q) {
712         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);
713         ierr = (*funcs[field])(coordDim, time, &coords[coordDim * q], Nc, funcVal, ctx);
714         if (ierr) {
715           PetscErrorCode ierr2;
716           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
717           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
718           ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
719           CHKERRQ(ierr);
720         }
721         if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
722         else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
723         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
724         for (fc = 0; fc < Nc; ++fc) {
725           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
726           if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    elem %d field %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);}
727           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
728         }
729       }
730       fieldOffset += Nb;
731       qc += Nc;
732     }
733     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
734     if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);}
735     localDiff += elemDiff;
736   }
737   ierr  = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr);
738   ierr  = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
739   *diff = PetscSqrtReal(*diff);
740   PetscFunctionReturn(0);
741 }
742 
743 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)
744 {
745   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
746   PetscSection     section;
747   PetscQuadrature  quad;
748   Vec              localX;
749   PetscScalar     *funcVal, *interpolant;
750   const PetscReal *quadPoints, *quadWeights;
751   PetscReal       *coords, *realSpaceDer, *J, *invJ, *detJ;
752   PetscReal        localDiff = 0.0;
753   PetscInt         dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, cEndInterior, c, field, fieldOffset;
754   PetscErrorCode   ierr;
755 
756   PetscFunctionBegin;
757   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
758   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
759   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
760   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
761   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
762   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
763   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
764   for (field = 0; field < numFields; ++field) {
765     PetscFE  fe;
766     PetscInt Nc;
767 
768     ierr = DMGetField(dm, field, (PetscObject *) &fe);CHKERRQ(ierr);
769     ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
770     ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
771     numComponents += Nc;
772   }
773   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
774   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
775   /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */
776   ierr = PetscMalloc7(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*Nq,&realSpaceDer,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ,numComponents,&interpolant,Nq,&detJ);CHKERRQ(ierr);
777   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
778   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
779   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
780   for (c = cStart; c < cEnd; ++c) {
781     PetscScalar *x = NULL;
782     PetscReal    elemDiff = 0.0;
783     PetscInt     qc = 0;
784 
785     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, invJ, detJ);CHKERRQ(ierr);
786     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
787 
788     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
789       PetscFE          fe;
790       void * const     ctx = ctxs ? ctxs[field] : NULL;
791       PetscReal       *basisDer;
792       PetscInt         Nb, Nc, q, fc;
793 
794       ierr = DMGetField(dm, field, (PetscObject *) &fe);CHKERRQ(ierr);
795       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
796       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
797       ierr = PetscFEGetDefaultTabulation(fe, NULL, &basisDer, NULL);CHKERRQ(ierr);
798       if (debug) {
799         char title[1024];
800         ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr);
801         ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
802       }
803       for (q = 0; q < Nq; ++q) {
804         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);
805         ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], n, numFields, funcVal, ctx);
806         if (ierr) {
807           PetscErrorCode ierr2;
808           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
809           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
810           ierr2 = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr2);
811           CHKERRQ(ierr);
812         }
813         ierr = PetscFEInterpolateGradient_Static(fe, &x[fieldOffset], coordDim, invJ, n, q, interpolant);CHKERRQ(ierr);
814         for (fc = 0; fc < Nc; ++fc) {
815           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
816           if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    elem %d fieldDer %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);}
817           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
818         }
819       }
820       fieldOffset += Nb;
821       qc          += Nc;
822     }
823     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
824     if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);}
825     localDiff += elemDiff;
826   }
827   ierr  = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr);
828   ierr  = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
829   ierr  = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
830   *diff = PetscSqrtReal(*diff);
831   PetscFunctionReturn(0);
832 }
833 
834 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
835 {
836   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
837   PetscSection     section;
838   PetscQuadrature  quad;
839   Vec              localX;
840   PetscScalar     *funcVal, *interpolant;
841   PetscReal       *coords, *detJ, *J;
842   PetscReal       *localDiff;
843   const PetscReal *quadPoints, *quadWeights;
844   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset;
845   PetscErrorCode   ierr;
846 
847   PetscFunctionBegin;
848   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
849   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
850   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
851   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
852   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
853   ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
854   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
855   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
856   for (field = 0; field < numFields; ++field) {
857     PetscObject  obj;
858     PetscClassId id;
859     PetscInt     Nc;
860 
861     ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
862     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
863     if (id == PETSCFE_CLASSID) {
864       PetscFE fe = (PetscFE) obj;
865 
866       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
867       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
868     } else if (id == PETSCFV_CLASSID) {
869       PetscFV fv = (PetscFV) obj;
870 
871       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
872       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
873     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
874     numComponents += Nc;
875   }
876   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
877   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
878   ierr = PetscCalloc6(numFields,&localDiff,numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr);
879   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
880   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
881   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
882   for (c = cStart; c < cEnd; ++c) {
883     PetscScalar *x = NULL;
884     PetscInt     qc = 0;
885 
886     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr);
887     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
888 
889     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
890       PetscObject  obj;
891       PetscClassId id;
892       void * const ctx = ctxs ? ctxs[field] : NULL;
893       PetscInt     Nb, Nc, q, fc;
894 
895       PetscReal       elemDiff = 0.0;
896 
897       ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
898       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
899       if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
900       else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
901       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
902       if (debug) {
903         char title[1024];
904         ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr);
905         ierr = DMPrintCellVector(c, title, Nb*Nc, &x[fieldOffset]);CHKERRQ(ierr);
906       }
907       for (q = 0; q < Nq; ++q) {
908         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);
909         ierr = (*funcs[field])(coordDim, time, &coords[coordDim*q], numFields, funcVal, ctx);
910         if (ierr) {
911           PetscErrorCode ierr2;
912           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
913           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
914           ierr2 = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
915           CHKERRQ(ierr);
916         }
917         if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
918         else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
919         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
920         for (fc = 0; fc < Nc; ++fc) {
921           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
922           if (debug) {ierr = 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]);CHKERRQ(ierr);}
923           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
924         }
925       }
926       fieldOffset += Nb;
927       qc          += Nc;
928       localDiff[field] += elemDiff;
929     }
930     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
931   }
932   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
933   ierr = MPIU_Allreduce(localDiff, diff, numFields, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
934   for (field = 0; field < numFields; ++field) diff[field] = PetscSqrtReal(diff[field]);
935   ierr = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr);
936   PetscFunctionReturn(0);
937 }
938 
939 /*@C
940   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.
941 
942   Input Parameters:
943 + dm    - The DM
944 . time  - The time
945 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation
946 . ctxs  - Optional array of contexts to pass to each function, or NULL.
947 - X     - The coefficient vector u_h
948 
949   Output Parameter:
950 . D - A Vec which holds the difference ||u - u_h||_2 for each cell
951 
952   Level: developer
953 
954 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
955 @*/
956 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D)
957 {
958   PetscSection     section;
959   PetscQuadrature  quad;
960   Vec              localX;
961   PetscScalar     *funcVal, *interpolant;
962   PetscReal       *coords, *detJ, *J;
963   const PetscReal *quadPoints, *quadWeights;
964   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset;
965   PetscErrorCode   ierr;
966 
967   PetscFunctionBegin;
968   ierr = VecSet(D, 0.0);CHKERRQ(ierr);
969   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
970   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
971   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
972   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
973   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
974   ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
975   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
976   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
977   for (field = 0; field < numFields; ++field) {
978     PetscObject  obj;
979     PetscClassId id;
980     PetscInt     Nc;
981 
982     ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
983     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
984     if (id == PETSCFE_CLASSID) {
985       PetscFE fe = (PetscFE) obj;
986 
987       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
988       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
989     } else if (id == PETSCFV_CLASSID) {
990       PetscFV fv = (PetscFV) obj;
991 
992       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
993       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
994     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
995     numComponents += Nc;
996   }
997   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
998   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
999   ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr);
1000   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1001   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
1002   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1003   for (c = cStart; c < cEnd; ++c) {
1004     PetscScalar *x = NULL;
1005     PetscScalar  elemDiff = 0.0;
1006     PetscInt     qc = 0;
1007 
1008     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr);
1009     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1010 
1011     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1012       PetscObject  obj;
1013       PetscClassId id;
1014       void * const ctx = ctxs ? ctxs[field] : NULL;
1015       PetscInt     Nb, Nc, q, fc;
1016 
1017       ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
1018       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1019       if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1020       else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1021       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1022       if (funcs[field]) {
1023         for (q = 0; q < Nq; ++q) {
1024           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);
1025           ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx);
1026           if (ierr) {
1027             PetscErrorCode ierr2;
1028             ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1029             ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2);
1030             ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1031             CHKERRQ(ierr);
1032           }
1033           if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1034           else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1035           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1036           for (fc = 0; fc < Nc; ++fc) {
1037             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1038             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q];
1039           }
1040         }
1041       }
1042       fieldOffset += Nb;
1043       qc          += Nc;
1044     }
1045     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1046     ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr);
1047   }
1048   ierr = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr);
1049   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1050   ierr = VecSqrtAbs(D);CHKERRQ(ierr);
1051   PetscFunctionReturn(0);
1052 }
1053 
1054 /*@C
1055   DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec.
1056 
1057   Input Parameters:
1058 + dm - The DM
1059 - LocX  - The coefficient vector u_h
1060 
1061   Output Parameter:
1062 . locC - A Vec which holds the Clement interpolant of the gradient
1063 
1064   Notes:
1065     Add citation to (Clement, 1975) and definition of the interpolant
1066   \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
1067 
1068   Level: developer
1069 
1070 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1071 @*/
1072 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC)
1073 {
1074   DM_Plex         *mesh  = (DM_Plex *) dm->data;
1075   PetscInt         debug = mesh->printFEM;
1076   DM               dmC;
1077   PetscSection     section;
1078   PetscQuadrature  quad;
1079   PetscScalar     *interpolant, *gradsum;
1080   PetscReal       *coords, *detJ, *J, *invJ;
1081   const PetscReal *quadPoints, *quadWeights;
1082   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, vStart, vEnd, v, field, fieldOffset;
1083   PetscErrorCode   ierr;
1084 
1085   PetscFunctionBegin;
1086   ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr);
1087   ierr = VecSet(locC, 0.0);CHKERRQ(ierr);
1088   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1089   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1090   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
1091   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1092   for (field = 0; field < numFields; ++field) {
1093     PetscObject  obj;
1094     PetscClassId id;
1095     PetscInt     Nc;
1096 
1097     ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
1098     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1099     if (id == PETSCFE_CLASSID) {
1100       PetscFE fe = (PetscFE) obj;
1101 
1102       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1103       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1104     } else if (id == PETSCFV_CLASSID) {
1105       PetscFV fv = (PetscFV) obj;
1106 
1107       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1108       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1109     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1110     numComponents += Nc;
1111   }
1112   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1113   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1114   ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ);CHKERRQ(ierr);
1115   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
1116   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1117   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
1118   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1119   for (v = vStart; v < vEnd; ++v) {
1120     PetscScalar volsum = 0.0;
1121     PetscInt   *star = NULL;
1122     PetscInt    starSize, st, d, fc;
1123 
1124     ierr = PetscMemzero(gradsum, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr);
1125     ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1126     for (st = 0; st < starSize*2; st += 2) {
1127       const PetscInt cell = star[st];
1128       PetscScalar   *grad = &gradsum[coordDim*numComponents];
1129       PetscScalar   *x    = NULL;
1130       PetscReal      vol  = 0.0;
1131 
1132       if ((cell < cStart) || (cell >= cEnd)) continue;
1133       ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, J, invJ, detJ);CHKERRQ(ierr);
1134       ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1135       for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1136         PetscObject  obj;
1137         PetscClassId id;
1138         PetscInt     Nb, Nc, q, qc = 0;
1139 
1140         ierr = PetscMemzero(grad, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr);
1141         ierr = DMGetField(dm, field, &obj);CHKERRQ(ierr);
1142         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1143         if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1144         else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1145         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1146         for (q = 0; q < Nq; ++q) {
1147           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);
1148           if (ierr) {
1149             PetscErrorCode ierr2;
1150             ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2);
1151             ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2);
1152             ierr2 = PetscFree4(interpolant,coords,detJ,J);CHKERRQ(ierr2);
1153             CHKERRQ(ierr);
1154           }
1155           if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, &x[fieldOffset], coordDim, invJ, NULL, q, interpolant);CHKERRQ(ierr);}
1156           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field);
1157           for (fc = 0; fc < Nc; ++fc) {
1158             const PetscReal wt = quadWeights[q*qNc+qc+fc];
1159 
1160             for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*detJ[q];
1161           }
1162           vol += quadWeights[q*qNc]*detJ[q];
1163         }
1164         fieldOffset += Nb;
1165         qc          += Nc;
1166       }
1167       ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1168       for (fc = 0; fc < numComponents; ++fc) {
1169         for (d = 0; d < coordDim; ++d) {
1170           gradsum[fc*coordDim+d] += grad[fc*coordDim+d];
1171         }
1172       }
1173       volsum += vol;
1174       if (debug) {
1175         ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr);
1176         for (fc = 0; fc < numComponents; ++fc) {
1177           for (d = 0; d < coordDim; ++d) {
1178             if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);}
1179             ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr);
1180           }
1181         }
1182         ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr);
1183       }
1184     }
1185     for (fc = 0; fc < numComponents; ++fc) {
1186       for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum;
1187     }
1188     ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1189     ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr);
1190   }
1191   ierr = PetscFree6(gradsum,interpolant,coords,detJ,J,invJ);CHKERRQ(ierr);
1192   PetscFunctionReturn(0);
1193 }
1194 
1195 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user)
1196 {
1197   DM                 dmAux = NULL;
1198   PetscDS            prob,    probAux = NULL;
1199   PetscSection       section, sectionAux;
1200   Vec                locX,    locA;
1201   PetscInt           dim, numCells = cEnd - cStart, c, f;
1202   PetscBool          useFVM = PETSC_FALSE;
1203   /* DS */
1204   PetscInt           Nf,    totDim,    *uOff, *uOff_x, numConstants;
1205   PetscInt           NfAux, totDimAux, *aOff;
1206   PetscScalar       *u, *a;
1207   const PetscScalar *constants;
1208   /* Geometry */
1209   PetscFEGeom       *cgeomFEM;
1210   DM                 dmGrad;
1211   PetscQuadrature    affineQuad = NULL;
1212   Vec                cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL;
1213   PetscFVCellGeom   *cgeomFVM;
1214   const PetscScalar *lgrad;
1215   PetscInt           maxDegree;
1216   DMField            coordField;
1217   IS                 cellIS;
1218   PetscErrorCode     ierr;
1219 
1220   PetscFunctionBegin;
1221   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1222   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1223   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
1224   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1225   /* Determine which discretizations we have */
1226   for (f = 0; f < Nf; ++f) {
1227     PetscObject  obj;
1228     PetscClassId id;
1229 
1230     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1231     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1232     if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
1233   }
1234   /* Get local solution with boundary values */
1235   ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
1236   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
1237   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1238   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1239   /* Read DS information */
1240   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1241   ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
1242   ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
1243   ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr);
1244   ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
1245   /* Read Auxiliary DS information */
1246   ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
1247   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
1248   if (dmAux) {
1249     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1250     ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
1251     ierr = DMGetSection(dmAux, &sectionAux);CHKERRQ(ierr);
1252     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1253     ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
1254   }
1255   /* Allocate data  arrays */
1256   ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr);
1257   if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
1258   /* Read out geometry */
1259   ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr);
1260   ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
1261   if (maxDegree <= 1) {
1262     ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
1263     if (affineQuad) {
1264       ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
1265     }
1266   }
1267   if (useFVM) {
1268     PetscFV   fv = NULL;
1269     Vec       grad;
1270     PetscInt  fStart, fEnd;
1271     PetscBool compGrad;
1272 
1273     for (f = 0; f < Nf; ++f) {
1274       PetscObject  obj;
1275       PetscClassId id;
1276 
1277       ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1278       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1279       if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
1280     }
1281     ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr);
1282     ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr);
1283     ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr);
1284     ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr);
1285     ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr);
1286     ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1287     /* Reconstruct and limit cell gradients */
1288     ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1289     ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1290     ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
1291     /* Communicate gradient values */
1292     ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
1293     ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1294     ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1295     ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1296     /* Handle non-essential (e.g. outflow) boundary values */
1297     ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
1298     ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1299   }
1300   /* Read out data from inputs */
1301   for (c = cStart; c < cEnd; ++c) {
1302     PetscScalar *x = NULL;
1303     PetscInt     i;
1304 
1305     ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1306     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
1307     ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1308     if (dmAux) {
1309       ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1310       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
1311       ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1312     }
1313   }
1314   /* Do integration for each field */
1315   for (f = 0; f < Nf; ++f) {
1316     PetscObject  obj;
1317     PetscClassId id;
1318     PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
1319 
1320     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1321     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1322     if (id == PETSCFE_CLASSID) {
1323       PetscFE         fe = (PetscFE) obj;
1324       PetscQuadrature q;
1325       PetscFEGeom     *chunkGeom = NULL;
1326       PetscInt        Nq, Nb;
1327 
1328       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
1329       ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1330       ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
1331       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1332       blockSize = Nb*Nq;
1333       batchSize = numBlocks * blockSize;
1334       ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
1335       numChunks = numCells / (numBatches*batchSize);
1336       Ne        = numChunks*numBatches*batchSize;
1337       Nr        = numCells % (numBatches*batchSize);
1338       offset    = numCells - Nr;
1339       if (!affineQuad) {
1340         ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
1341       }
1342       ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
1343       ierr = PetscFEIntegrate(fe, prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr);
1344       ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
1345       ierr = PetscFEIntegrate(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr);
1346       ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
1347       if (!affineQuad) {
1348         ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
1349       }
1350     } else if (id == PETSCFV_CLASSID) {
1351       PetscInt       foff;
1352       PetscPointFunc obj_func;
1353       PetscScalar    lint;
1354 
1355       ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr);
1356       ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
1357       if (obj_func) {
1358         for (c = 0; c < numCells; ++c) {
1359           PetscScalar *u_x;
1360 
1361           ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr);
1362           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);
1363           cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume;
1364         }
1365       }
1366     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
1367   }
1368   /* Cleanup data arrays */
1369   if (useFVM) {
1370     ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1371     ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1372     ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
1373     ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr);
1374     ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr);
1375     ierr = DMDestroy(&dmGrad);CHKERRQ(ierr);
1376   }
1377   if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);}
1378   ierr = PetscFree(u);CHKERRQ(ierr);
1379   /* Cleanup */
1380   if (affineQuad) {
1381     ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
1382   }
1383   ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
1384   ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
1385   ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
1386   PetscFunctionReturn(0);
1387 }
1388 
1389 /*@
1390   DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user
1391 
1392   Input Parameters:
1393 + dm - The mesh
1394 . X  - Global input vector
1395 - user - The user context
1396 
1397   Output Parameter:
1398 . integral - Integral for each field
1399 
1400   Level: developer
1401 
1402 .seealso: DMPlexComputeResidualFEM()
1403 @*/
1404 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user)
1405 {
1406   DM_Plex       *mesh = (DM_Plex *) dm->data;
1407   PetscScalar   *cintegral, *lintegral;
1408   PetscInt       Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell;
1409   PetscErrorCode ierr;
1410 
1411   PetscFunctionBegin;
1412   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1413   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
1414   PetscValidPointer(integral, 3);
1415   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1416   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
1417   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1418   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
1419   ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr);
1420   cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight];
1421   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
1422   ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
1423   ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
1424   /* Sum up values */
1425   for (cell = cStart; cell < cEnd; ++cell) {
1426     const PetscInt c = cell - cStart;
1427 
1428     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
1429     for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
1430   }
1431   ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
1432   if (mesh->printFEM) {
1433     ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr);
1434     for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);}
1435     ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr);
1436   }
1437   ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr);
1438   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1439   PetscFunctionReturn(0);
1440 }
1441 
1442 /*@
1443   DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user
1444 
1445   Input Parameters:
1446 + dm - The mesh
1447 . X  - Global input vector
1448 - user - The user context
1449 
1450   Output Parameter:
1451 . integral - Cellwise integrals for each field
1452 
1453   Level: developer
1454 
1455 .seealso: DMPlexComputeResidualFEM()
1456 @*/
1457 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user)
1458 {
1459   DM_Plex       *mesh = (DM_Plex *) dm->data;
1460   DM             dmF;
1461   PetscSection   sectionF;
1462   PetscScalar   *cintegral, *af;
1463   PetscInt       Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell;
1464   PetscErrorCode ierr;
1465 
1466   PetscFunctionBegin;
1467   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1468   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
1469   PetscValidHeaderSpecific(F, VEC_CLASSID, 3);
1470   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1471   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
1472   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1473   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
1474   ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr);
1475   cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight];
1476   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
1477   ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
1478   ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
1479   /* Put values in F*/
1480   ierr = VecGetDM(F, &dmF);CHKERRQ(ierr);
1481   ierr = DMGetSection(dmF, &sectionF);CHKERRQ(ierr);
1482   ierr = VecGetArray(F, &af);CHKERRQ(ierr);
1483   for (cell = cStart; cell < cEnd; ++cell) {
1484     const PetscInt c = cell - cStart;
1485     PetscInt       dof, off;
1486 
1487     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
1488     ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr);
1489     ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr);
1490     if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf);
1491     for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f];
1492   }
1493   ierr = VecRestoreArray(F, &af);CHKERRQ(ierr);
1494   ierr = PetscFree(cintegral);CHKERRQ(ierr);
1495   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1496   PetscFunctionReturn(0);
1497 }
1498 
1499 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS,
1500                                                        void (*func)(PetscInt, PetscInt, PetscInt,
1501                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1502                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1503                                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
1504                                                        PetscScalar *fintegral, void *user)
1505 {
1506   DM                 plex = NULL, plexA = NULL;
1507   PetscDS            prob, probAux = NULL;
1508   PetscSection       section, sectionAux = NULL;
1509   Vec                locA = NULL;
1510   DMField            coordField;
1511   PetscInt           Nf,        totDim,        *uOff, *uOff_x;
1512   PetscInt           NfAux = 0, totDimAux = 0, *aOff = NULL;
1513   PetscScalar       *u, *a = NULL;
1514   const PetscScalar *constants;
1515   PetscInt           numConstants, f;
1516   PetscErrorCode     ierr;
1517 
1518   PetscFunctionBegin;
1519   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
1520   ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
1521   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1522   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1523   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1524   /* Determine which discretizations we have */
1525   for (f = 0; f < Nf; ++f) {
1526     PetscObject  obj;
1527     PetscClassId id;
1528 
1529     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1530     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1531     if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f);
1532   }
1533   /* Read DS information */
1534   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1535   ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
1536   ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
1537   ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
1538   /* Read Auxiliary DS information */
1539   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
1540   if (locA) {
1541     DM dmAux;
1542 
1543     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
1544     ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
1545     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1546     ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
1547     ierr = DMGetDefaultSection(dmAux, &sectionAux);CHKERRQ(ierr);
1548     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1549     ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
1550   }
1551   /* Integrate over points */
1552   {
1553     PetscFEGeom    *fgeom, *chunkGeom = NULL;
1554     PetscInt        maxDegree;
1555     PetscQuadrature qGeom = NULL;
1556     const PetscInt *points;
1557     PetscInt        numFaces, face, Nq, field;
1558     PetscInt        numChunks, chunkSize, chunk, Nr, offset;
1559 
1560     ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
1561     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1562     ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
1563     ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr);
1564     for (field = 0; field < Nf; ++field) {
1565       PetscFE fe;
1566 
1567       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1568       if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);}
1569       if (!qGeom) {
1570         ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
1571         ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
1572       }
1573       ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
1574       ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
1575       for (face = 0; face < numFaces; ++face) {
1576         const PetscInt point = points[face], *support, *cone;
1577         PetscScalar    *x    = NULL;
1578         PetscInt       i, coneSize, faceLoc;
1579 
1580         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
1581         ierr = DMPlexGetConeSize(dm, support[0], &coneSize);CHKERRQ(ierr);
1582         ierr = DMPlexGetCone(dm, support[0], &cone);CHKERRQ(ierr);
1583         for (faceLoc = 0; faceLoc < coneSize; ++faceLoc) if (cone[faceLoc] == point) break;
1584         if (faceLoc == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of support[0] %D", face, support[0]);
1585         fgeom->face[face][0] = faceLoc;
1586         ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
1587         for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
1588         ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
1589         if (locA) {
1590           PetscInt subp;
1591           ierr = DMPlexGetSubpoint(plexA, support[0], &subp);CHKERRQ(ierr);
1592           ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
1593           for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
1594           ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
1595         }
1596       }
1597       /* Get blocking */
1598       {
1599         PetscQuadrature q;
1600         PetscInt        numBatches, batchSize, numBlocks, blockSize;
1601         PetscInt        Nq, Nb;
1602 
1603         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
1604         ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1605         ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
1606         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1607         blockSize = Nb*Nq;
1608         batchSize = numBlocks * blockSize;
1609         chunkSize = numBatches*batchSize;
1610         ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
1611         numChunks = numFaces / chunkSize;
1612         Nr        = numFaces % chunkSize;
1613         offset    = numFaces - Nr;
1614       }
1615       /* Do integration for each field */
1616       for (chunk = 0; chunk < numChunks; ++chunk) {
1617         ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr);
1618         ierr = PetscFEIntegrateBd(fe, prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr);
1619         ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr);
1620       }
1621       ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
1622       ierr = PetscFEIntegrateBd(fe, prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr);
1623       ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
1624       /* Cleanup data arrays */
1625       ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
1626       ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
1627       ierr = PetscFree2(u, a);CHKERRQ(ierr);
1628       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1629     }
1630   }
1631   if (plex)  {ierr = DMDestroy(&plex);CHKERRQ(ierr);}
1632   if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
1633   PetscFunctionReturn(0);
1634 }
1635 
1636 /*@
1637   DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user
1638 
1639   Input Parameters:
1640 + dm      - The mesh
1641 . X       - Global input vector
1642 . label   - The boundary DMLabel
1643 . numVals - The number of label values to use, or PETSC_DETERMINE for all values
1644 . vals    - The label values to use, or PETSC_NULL for all values
1645 . func    = The function to integrate along the boundary
1646 - user    - The user context
1647 
1648   Output Parameter:
1649 . integral - Integral for each field
1650 
1651   Level: developer
1652 
1653 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM()
1654 @*/
1655 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[],
1656                                        void (*func)(PetscInt, PetscInt, PetscInt,
1657                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1658                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1659                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
1660                                        PetscScalar *integral, void *user)
1661 {
1662   Vec            locX;
1663   PetscSection   section;
1664   DMLabel        depthLabel;
1665   IS             facetIS;
1666   PetscInt       dim, Nf, f, v;
1667   PetscErrorCode ierr;
1668 
1669   PetscFunctionBegin;
1670   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1671   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
1672   PetscValidPointer(label, 3);
1673   if (vals) PetscValidPointer(vals, 5);
1674   PetscValidPointer(integral, 6);
1675   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1676   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
1677   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1678   ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
1679   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1680   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1681   /* Get local solution with boundary values */
1682   ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
1683   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
1684   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1685   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1686   /* Loop over label values */
1687   ierr = PetscMemzero(integral, Nf * sizeof(PetscScalar));CHKERRQ(ierr);
1688   for (v = 0; v < numVals; ++v) {
1689     IS           pointIS;
1690     PetscInt     numFaces, face;
1691     PetscScalar *fintegral;
1692 
1693     ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr);
1694     if (!pointIS) continue; /* No points with that id on this process */
1695     {
1696       IS isectIS;
1697 
1698       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
1699       ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr);
1700       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1701       pointIS = isectIS;
1702     }
1703     ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
1704     ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr);
1705     ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr);
1706     /* Sum point contributions into integral */
1707     for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f];
1708     ierr = PetscFree(fintegral);CHKERRQ(ierr);
1709     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1710   }
1711   ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
1712   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
1713   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
1714   PetscFunctionReturn(0);
1715 }
1716 
1717 /*@
1718   DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to the uniformly refined DM.
1719 
1720   Input Parameters:
1721 + dmf  - The fine mesh
1722 . dmc  - The coarse mesh
1723 - user - The user context
1724 
1725   Output Parameter:
1726 . In  - The interpolation matrix
1727 
1728   Level: developer
1729 
1730 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
1731 @*/
1732 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, Mat In, void *user)
1733 {
1734   DM_Plex          *mesh  = (DM_Plex *) dmc->data;
1735   const char       *name  = "Interpolator";
1736   PetscDS           prob;
1737   PetscFE          *feRef;
1738   PetscFV          *fvRef;
1739   PetscSection      fsection, fglobalSection;
1740   PetscSection      csection, cglobalSection;
1741   PetscScalar      *elemMat;
1742   PetscInt          dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, cEndInterior, c;
1743   PetscInt          cTotDim, rTotDim = 0;
1744   PetscErrorCode    ierr;
1745 
1746   PetscFunctionBegin;
1747   ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
1748   ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
1749   ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);
1750   ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
1751   ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);
1752   ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
1753   ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
1754   ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
1755   ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
1756   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
1757   ierr = DMGetDS(dmf, &prob);CHKERRQ(ierr);
1758   ierr = PetscCalloc2(Nf,&feRef,Nf,&fvRef);CHKERRQ(ierr);
1759   for (f = 0; f < Nf; ++f) {
1760     PetscObject  obj;
1761     PetscClassId id;
1762     PetscInt     rNb = 0, Nc = 0;
1763 
1764     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1765     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1766     if (id == PETSCFE_CLASSID) {
1767       PetscFE fe = (PetscFE) obj;
1768 
1769       ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
1770       ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr);
1771       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1772     } else if (id == PETSCFV_CLASSID) {
1773       PetscFV        fv = (PetscFV) obj;
1774       PetscDualSpace Q;
1775 
1776       ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
1777       ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
1778       ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr);
1779       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1780     }
1781     rTotDim += rNb;
1782   }
1783   ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr);
1784   ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr);
1785   ierr = PetscMemzero(elemMat, rTotDim*cTotDim * sizeof(PetscScalar));CHKERRQ(ierr);
1786   for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) {
1787     PetscDualSpace   Qref;
1788     PetscQuadrature  f;
1789     const PetscReal *qpoints, *qweights;
1790     PetscReal       *points;
1791     PetscInt         npoints = 0, Nc, Np, fpdim, i, k, p, d;
1792 
1793     /* Compose points from all dual basis functionals */
1794     if (feRef[fieldI]) {
1795       ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr);
1796       ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr);
1797     } else {
1798       ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr);
1799       ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr);
1800     }
1801     ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr);
1802     for (i = 0; i < fpdim; ++i) {
1803       ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
1804       ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr);
1805       npoints += Np;
1806     }
1807     ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr);
1808     for (i = 0, k = 0; i < fpdim; ++i) {
1809       ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
1810       ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
1811       for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d];
1812     }
1813 
1814     for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) {
1815       PetscObject  obj;
1816       PetscClassId id;
1817       PetscReal   *B;
1818       PetscInt     NcJ = 0, cpdim = 0, j, qNc;
1819 
1820       ierr = PetscDSGetDiscretization(prob, fieldJ, &obj);CHKERRQ(ierr);
1821       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1822       if (id == PETSCFE_CLASSID) {
1823         PetscFE fe = (PetscFE) obj;
1824 
1825         /* Evaluate basis at points */
1826         ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr);
1827         ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
1828         /* For now, fields only interpolate themselves */
1829         if (fieldI == fieldJ) {
1830           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);
1831           ierr = PetscFEGetTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr);
1832           for (i = 0, k = 0; i < fpdim; ++i) {
1833             ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
1834             ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
1835             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);
1836             for (p = 0; p < Np; ++p, ++k) {
1837               for (j = 0; j < cpdim; ++j) {
1838                 /*
1839                    cTotDim:            Total columns in element interpolation matrix, sum of number of dual basis functionals in each field
1840                    offsetI, offsetJ:   Offsets into the larger element interpolation matrix for different fields
1841                    fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals
1842                    qNC, Nc, Ncj, c:    Number of components in this field
1843                    Np, p:              Number of quad points in the fine grid functional i
1844                    k:                  i*Np + p, overall point number for the interpolation
1845                 */
1846                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += B[k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c];
1847               }
1848             }
1849           }
1850           ierr = PetscFERestoreTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr);
1851         }
1852       } else if (id == PETSCFV_CLASSID) {
1853         PetscFV        fv = (PetscFV) obj;
1854 
1855         /* Evaluate constant function at points */
1856         ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr);
1857         cpdim = 1;
1858         /* For now, fields only interpolate themselves */
1859         if (fieldI == fieldJ) {
1860           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);
1861           for (i = 0, k = 0; i < fpdim; ++i) {
1862             ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
1863             ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
1864             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);
1865             for (p = 0; p < Np; ++p, ++k) {
1866               for (j = 0; j < cpdim; ++j) {
1867                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c];
1868               }
1869             }
1870           }
1871         }
1872       }
1873       offsetJ += cpdim;
1874     }
1875     offsetI += fpdim;
1876     ierr = PetscFree(points);CHKERRQ(ierr);
1877   }
1878   if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);}
1879   /* Preallocate matrix */
1880   {
1881     Mat          preallocator;
1882     PetscScalar *vals;
1883     PetscInt    *cellCIndices, *cellFIndices;
1884     PetscInt     locRows, locCols, cell;
1885 
1886     ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr);
1887     ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr);
1888     ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr);
1889     ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
1890     ierr = MatSetUp(preallocator);CHKERRQ(ierr);
1891     ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr);
1892     for (cell = cStart; cell < cEnd; ++cell) {
1893       ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr);
1894       ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr);
1895     }
1896     ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr);
1897     ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1898     ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1899     ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr);
1900     ierr = MatDestroy(&preallocator);CHKERRQ(ierr);
1901   }
1902   /* Fill matrix */
1903   ierr = MatZeroEntries(In);CHKERRQ(ierr);
1904   for (c = cStart; c < cEnd; ++c) {
1905     ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr);
1906   }
1907   for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);}
1908   ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr);
1909   ierr = PetscFree(elemMat);CHKERRQ(ierr);
1910   ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1911   ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1912   if (mesh->printFEM) {
1913     ierr = PetscPrintf(PETSC_COMM_WORLD, "%s:\n", name);CHKERRQ(ierr);
1914     ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr);
1915     ierr = MatView(In, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
1916   }
1917   ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
1918   PetscFunctionReturn(0);
1919 }
1920 
1921 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user)
1922 {
1923   SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness");
1924 }
1925 
1926 /*@
1927   DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM.
1928 
1929   Input Parameters:
1930 + dmf  - The fine mesh
1931 . dmc  - The coarse mesh
1932 - user - The user context
1933 
1934   Output Parameter:
1935 . In  - The interpolation matrix
1936 
1937   Level: developer
1938 
1939 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
1940 @*/
1941 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user)
1942 {
1943   DM_Plex       *mesh = (DM_Plex *) dmf->data;
1944   const char    *name = "Interpolator";
1945   PetscDS        prob;
1946   PetscSection   fsection, csection, globalFSection, globalCSection;
1947   PetscHSetIJ    ht;
1948   PetscLayout    rLayout;
1949   PetscInt      *dnz, *onz;
1950   PetscInt       locRows, rStart, rEnd;
1951   PetscReal     *x, *v0, *J, *invJ, detJ;
1952   PetscReal     *v0c, *Jc, *invJc, detJc;
1953   PetscScalar   *elemMat;
1954   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
1955   PetscErrorCode ierr;
1956 
1957   PetscFunctionBegin;
1958   ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
1959   ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
1960   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
1961   ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr);
1962   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
1963   ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
1964   ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
1965   ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);
1966   ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
1967   ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);
1968   ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
1969   ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
1970   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1971   ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
1972 
1973   ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr);
1974   ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr);
1975   ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
1976   ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
1977   ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
1978   ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
1979   ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
1980   ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
1981   ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
1982   for (field = 0; field < Nf; ++field) {
1983     PetscObject      obj;
1984     PetscClassId     id;
1985     PetscDualSpace   Q = NULL;
1986     PetscQuadrature  f;
1987     const PetscReal *qpoints;
1988     PetscInt         Nc, Np, fpdim, i, d;
1989 
1990     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
1991     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1992     if (id == PETSCFE_CLASSID) {
1993       PetscFE fe = (PetscFE) obj;
1994 
1995       ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1996       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1997     } else if (id == PETSCFV_CLASSID) {
1998       PetscFV fv = (PetscFV) obj;
1999 
2000       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2001       Nc   = 1;
2002     }
2003     ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2004     /* For each fine grid cell */
2005     for (cell = cStart; cell < cEnd; ++cell) {
2006       PetscInt *findices,   *cindices;
2007       PetscInt  numFIndices, numCIndices;
2008 
2009       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2010       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2011       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim);
2012       for (i = 0; i < fpdim; ++i) {
2013         Vec             pointVec;
2014         PetscScalar    *pV;
2015         PetscSF         coarseCellSF = NULL;
2016         const PetscSFNode *coarseCells;
2017         PetscInt        numCoarseCells, q, c;
2018 
2019         /* Get points from the dual basis functional quadrature */
2020         ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2021         ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
2022         ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2023         ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2024         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2025         for (q = 0; q < Np; ++q) {
2026           const PetscReal xi0[3] = {-1., -1., -1.};
2027 
2028           /* Transform point to real space */
2029           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2030           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2031         }
2032         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2033         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2034         /* OPT: Pack all quad points from fine cell */
2035         ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2036         ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2037         /* Update preallocation info */
2038         ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2039         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2040         {
2041           PetscHashIJKey key;
2042           PetscBool      missing;
2043 
2044           key.i = findices[i];
2045           if (key.i >= 0) {
2046             /* Get indices for coarse elements */
2047             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2048               ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2049               for (c = 0; c < numCIndices; ++c) {
2050                 key.j = cindices[c];
2051                 if (key.j < 0) continue;
2052                 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2053                 if (missing) {
2054                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2055                   else                                     ++onz[key.i-rStart];
2056                 }
2057               }
2058               ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2059             }
2060           }
2061         }
2062         ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2063         ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2064       }
2065       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2066     }
2067   }
2068   ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
2069   ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
2070   ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2071   ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
2072   for (field = 0; field < Nf; ++field) {
2073     PetscObject      obj;
2074     PetscClassId     id;
2075     PetscDualSpace   Q = NULL;
2076     PetscQuadrature  f;
2077     const PetscReal *qpoints, *qweights;
2078     PetscInt         Nc, qNc, Np, fpdim, i, d;
2079 
2080     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2081     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2082     if (id == PETSCFE_CLASSID) {
2083       PetscFE fe = (PetscFE) obj;
2084 
2085       ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
2086       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2087     } else if (id == PETSCFV_CLASSID) {
2088       PetscFV fv = (PetscFV) obj;
2089 
2090       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2091       Nc   = 1;
2092     } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %d",field);
2093     ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2094     /* For each fine grid cell */
2095     for (cell = cStart; cell < cEnd; ++cell) {
2096       PetscInt *findices,   *cindices;
2097       PetscInt  numFIndices, numCIndices;
2098 
2099       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2100       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2101       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim);
2102       for (i = 0; i < fpdim; ++i) {
2103         Vec             pointVec;
2104         PetscScalar    *pV;
2105         PetscSF         coarseCellSF = NULL;
2106         const PetscSFNode *coarseCells;
2107         PetscInt        numCoarseCells, cpdim, q, c, j;
2108 
2109         /* Get points from the dual basis functional quadrature */
2110         ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2111         ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr);
2112         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);
2113         ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2114         ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2115         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2116         for (q = 0; q < Np; ++q) {
2117           const PetscReal xi0[3] = {-1., -1., -1.};
2118 
2119           /* Transform point to real space */
2120           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2121           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2122         }
2123         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2124         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2125         /* OPT: Read this out from preallocation information */
2126         ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2127         /* Update preallocation info */
2128         ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2129         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2130         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2131         for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2132           PetscReal pVReal[3];
2133           const PetscReal xi0[3] = {-1., -1., -1.};
2134 
2135           ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2136           /* Transform points from real space to coarse reference space */
2137           ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
2138           for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2139           CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
2140 
2141           if (id == PETSCFE_CLASSID) {
2142             PetscFE    fe = (PetscFE) obj;
2143             PetscReal *B;
2144 
2145             /* Evaluate coarse basis on contained point */
2146             ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2147             ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);
2148             ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr);
2149             /* Get elemMat entries by multiplying by weight */
2150             for (j = 0; j < cpdim; ++j) {
2151               for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*qweights[ccell*qNc + c];
2152             }
2153             ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr);
2154           } else {
2155             cpdim = 1;
2156             for (j = 0; j < cpdim; ++j) {
2157               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c];
2158             }
2159           }
2160           /* Update interpolator */
2161           if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
2162           if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2163           ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2164           ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2165         }
2166         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2167         ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2168         ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2169       }
2170       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2171     }
2172   }
2173   ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
2174   ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
2175   ierr = PetscFree(elemMat);CHKERRQ(ierr);
2176   ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2177   ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2178   ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2179   PetscFunctionReturn(0);
2180 }
2181 
2182 /*@
2183   DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM.
2184 
2185   Input Parameters:
2186 + dmf  - The fine mesh
2187 . dmc  - The coarse mesh
2188 - user - The user context
2189 
2190   Output Parameter:
2191 . mass  - The mass matrix
2192 
2193   Level: developer
2194 
2195 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2196 @*/
2197 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user)
2198 {
2199   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2200   const char    *name = "Mass Matrix";
2201   PetscDS        prob;
2202   PetscSection   fsection, csection, globalFSection, globalCSection;
2203   PetscHSetIJ    ht;
2204   PetscLayout    rLayout;
2205   PetscInt      *dnz, *onz;
2206   PetscInt       locRows, rStart, rEnd;
2207   PetscReal     *x, *v0, *J, *invJ, detJ;
2208   PetscReal     *v0c, *Jc, *invJc, detJc;
2209   PetscScalar   *elemMat;
2210   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2211   PetscErrorCode ierr;
2212 
2213   PetscFunctionBegin;
2214   ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
2215   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2216   ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr);
2217   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2218   ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
2219   ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
2220   ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);
2221   ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
2222   ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);
2223   ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
2224   ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
2225   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2226   ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
2227 
2228   ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr);
2229   ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr);
2230   ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
2231   ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
2232   ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
2233   ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
2234   ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
2235   ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
2236   ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
2237   for (field = 0; field < Nf; ++field) {
2238     PetscObject      obj;
2239     PetscClassId     id;
2240     PetscQuadrature  quad;
2241     const PetscReal *qpoints;
2242     PetscInt         Nq, Nc, i, d;
2243 
2244     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2245     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2246     if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);}
2247     else                       {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);}
2248     ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr);
2249     /* For each fine grid cell */
2250     for (cell = cStart; cell < cEnd; ++cell) {
2251       Vec                pointVec;
2252       PetscScalar       *pV;
2253       PetscSF            coarseCellSF = NULL;
2254       const PetscSFNode *coarseCells;
2255       PetscInt           numCoarseCells, q, c;
2256       PetscInt          *findices,   *cindices;
2257       PetscInt           numFIndices, numCIndices;
2258 
2259       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2260       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2261       /* Get points from the quadrature */
2262       ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
2263       ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2264       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2265       for (q = 0; q < Nq; ++q) {
2266         const PetscReal xi0[3] = {-1., -1., -1.};
2267 
2268         /* Transform point to real space */
2269         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2270         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2271       }
2272       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2273       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2274       ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2275       ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2276       /* Update preallocation info */
2277       ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2278       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2279       {
2280         PetscHashIJKey key;
2281         PetscBool      missing;
2282 
2283         for (i = 0; i < numFIndices; ++i) {
2284           key.i = findices[i];
2285           if (key.i >= 0) {
2286             /* Get indices for coarse elements */
2287             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2288               ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2289               for (c = 0; c < numCIndices; ++c) {
2290                 key.j = cindices[c];
2291                 if (key.j < 0) continue;
2292                 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2293                 if (missing) {
2294                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2295                   else                                     ++onz[key.i-rStart];
2296                 }
2297               }
2298               ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2299             }
2300           }
2301         }
2302       }
2303       ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2304       ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2305       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2306     }
2307   }
2308   ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
2309   ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
2310   ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2311   ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
2312   for (field = 0; field < Nf; ++field) {
2313     PetscObject      obj;
2314     PetscClassId     id;
2315     PetscQuadrature  quad;
2316     PetscReal       *Bfine;
2317     const PetscReal *qpoints, *qweights;
2318     PetscInt         Nq, Nc, i, d;
2319 
2320     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2321     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2322     if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);ierr = PetscFEGetDefaultTabulation((PetscFE) obj, &Bfine, NULL, NULL);CHKERRQ(ierr);}
2323     else                       {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);}
2324     ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr);
2325     /* For each fine grid cell */
2326     for (cell = cStart; cell < cEnd; ++cell) {
2327       Vec                pointVec;
2328       PetscScalar       *pV;
2329       PetscSF            coarseCellSF = NULL;
2330       const PetscSFNode *coarseCells;
2331       PetscInt           numCoarseCells, cpdim, q, c, j;
2332       PetscInt          *findices,   *cindices;
2333       PetscInt           numFIndices, numCIndices;
2334 
2335       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2336       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2337       /* Get points from the quadrature */
2338       ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
2339       ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2340       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2341       for (q = 0; q < Nq; ++q) {
2342         const PetscReal xi0[3] = {-1., -1., -1.};
2343 
2344         /* Transform point to real space */
2345         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2346         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2347       }
2348       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2349       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2350       ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2351       /* Update matrix */
2352       ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2353       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2354       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2355       for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2356         PetscReal pVReal[3];
2357         const PetscReal xi0[3] = {-1., -1., -1.};
2358 
2359 
2360         ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2361         /* Transform points from real space to coarse reference space */
2362         ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
2363         for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2364         CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
2365 
2366         if (id == PETSCFE_CLASSID) {
2367           PetscFE    fe = (PetscFE) obj;
2368           PetscReal *B;
2369 
2370           /* Evaluate coarse basis on contained point */
2371           ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2372           ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);
2373           /* Get elemMat entries by multiplying by weight */
2374           for (i = 0; i < numFIndices; ++i) {
2375             ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr);
2376             for (j = 0; j < cpdim; ++j) {
2377               for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*Bfine[(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ;
2378             }
2379             /* Update interpolator */
2380             if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
2381             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2382             ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
2383           }
2384           ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr);
2385         } else {
2386           cpdim = 1;
2387           for (i = 0; i < numFIndices; ++i) {
2388             ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr);
2389             for (j = 0; j < cpdim; ++j) {
2390               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ;
2391             }
2392             /* Update interpolator */
2393             if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
2394             ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %d %d Nf: %d %d Nc: %d %d\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr);
2395             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2396             ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
2397           }
2398         }
2399         ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr);
2400       }
2401       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2402       ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2403       ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2404       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr);
2405     }
2406   }
2407   ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
2408   ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
2409   ierr = PetscFree(elemMat);CHKERRQ(ierr);
2410   ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2411   ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2412   PetscFunctionReturn(0);
2413 }
2414 
2415 /*@
2416   DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns
2417 
2418   Input Parameters:
2419 + dmc  - The coarse mesh
2420 - dmf  - The fine mesh
2421 - user - The user context
2422 
2423   Output Parameter:
2424 . sc   - The mapping
2425 
2426   Level: developer
2427 
2428 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
2429 @*/
2430 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user)
2431 {
2432   PetscDS        prob;
2433   PetscFE       *feRef;
2434   PetscFV       *fvRef;
2435   Vec            fv, cv;
2436   IS             fis, cis;
2437   PetscSection   fsection, fglobalSection, csection, cglobalSection;
2438   PetscInt      *cmap, *cellCIndices, *cellFIndices, *cindices, *findices;
2439   PetscInt       cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, cEndInterior, c, dim, d, startC, endC, offsetC, offsetF, m;
2440   PetscBool     *needAvg;
2441   PetscErrorCode ierr;
2442 
2443   PetscFunctionBegin;
2444   ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2445   ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
2446   ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);
2447   ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
2448   ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);
2449   ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
2450   ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
2451   ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
2452   ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
2453   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
2454   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2455   ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr);
2456   for (f = 0; f < Nf; ++f) {
2457     PetscObject  obj;
2458     PetscClassId id;
2459     PetscInt     fNb = 0, Nc = 0;
2460 
2461     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2462     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2463     if (id == PETSCFE_CLASSID) {
2464       PetscFE    fe = (PetscFE) obj;
2465       PetscSpace sp;
2466       PetscInt   maxDegree;
2467 
2468       ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
2469       ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr);
2470       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2471       ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr);
2472       ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr);
2473       if (!maxDegree) needAvg[f] = PETSC_TRUE;
2474     } else if (id == PETSCFV_CLASSID) {
2475       PetscFV        fv = (PetscFV) obj;
2476       PetscDualSpace Q;
2477 
2478       ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
2479       ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
2480       ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr);
2481       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
2482       needAvg[f] = PETSC_TRUE;
2483     }
2484     fTotDim += fNb;
2485   }
2486   ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr);
2487   ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr);
2488   for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) {
2489     PetscFE        feC;
2490     PetscFV        fvC;
2491     PetscDualSpace QF, QC;
2492     PetscInt       order = -1, NcF, NcC, fpdim, cpdim;
2493 
2494     if (feRef[field]) {
2495       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr);
2496       ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr);
2497       ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr);
2498       ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr);
2499       ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr);
2500       ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
2501       ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr);
2502       ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
2503     } else {
2504       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr);
2505       ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr);
2506       ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr);
2507       ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr);
2508       ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
2509       ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr);
2510       ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
2511     }
2512     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);
2513     for (c = 0; c < cpdim; ++c) {
2514       PetscQuadrature  cfunc;
2515       const PetscReal *cqpoints, *cqweights;
2516       PetscInt         NqcC, NpC;
2517       PetscBool        found = PETSC_FALSE;
2518 
2519       ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr);
2520       ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr);
2521       if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcC, NcC);
2522       if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments");
2523       for (f = 0; f < fpdim; ++f) {
2524         PetscQuadrature  ffunc;
2525         const PetscReal *fqpoints, *fqweights;
2526         PetscReal        sum = 0.0;
2527         PetscInt         NqcF, NpF;
2528 
2529         ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr);
2530         ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr);
2531         if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcF, NcF);
2532         if (NpC != NpF) continue;
2533         for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]);
2534         if (sum > 1.0e-9) continue;
2535         for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]);
2536         if (sum < 1.0e-9) continue;
2537         cmap[offsetC+c] = offsetF+f;
2538         found = PETSC_TRUE;
2539         break;
2540       }
2541       if (!found) {
2542         /* TODO We really want the average here, but some asshole put VecScatter in the interface */
2543         if (fvRef[field] || (feRef[field] && order == 0)) {
2544           cmap[offsetC+c] = offsetF+0;
2545         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection");
2546       }
2547     }
2548     offsetC += cpdim;
2549     offsetF += fpdim;
2550   }
2551   for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);}
2552   ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr);
2553 
2554   ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr);
2555   ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr);
2556   ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr);
2557   ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr);
2558   ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr);
2559   ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr);
2560   ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr);
2561   for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
2562   for (c = cStart; c < cEnd; ++c) {
2563     ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr);
2564     for (d = 0; d < cTotDim; ++d) {
2565       if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue;
2566       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]]);
2567       cindices[cellCIndices[d]-startC] = cellCIndices[d];
2568       findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]];
2569     }
2570   }
2571   ierr = PetscFree(cmap);CHKERRQ(ierr);
2572   ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr);
2573 
2574   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
2575   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
2576   ierr = VecScatterCreateWithData(cv, cis, fv, fis, sc);CHKERRQ(ierr);
2577   ierr = ISDestroy(&cis);CHKERRQ(ierr);
2578   ierr = ISDestroy(&fis);CHKERRQ(ierr);
2579   ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr);
2580   ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr);
2581   ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2582   PetscFunctionReturn(0);
2583 }
2584 
2585 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
2586 {
2587   char            composeStr[33] = {0};
2588   PetscObjectId   id;
2589   PetscContainer  container;
2590   PetscErrorCode  ierr;
2591 
2592   PetscFunctionBegin;
2593   ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
2594   ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr);
2595   ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
2596   if (container) {
2597     ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
2598   } else {
2599     ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
2600     ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
2601     ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
2602     ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
2603     ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
2604     ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
2605   }
2606   PetscFunctionReturn(0);
2607 }
2608 
2609 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
2610 {
2611   PetscFunctionBegin;
2612   *geom = NULL;
2613   PetscFunctionReturn(0);
2614 }
2615 
2616 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user)
2617 {
2618   DM_Plex         *mesh       = (DM_Plex *) dm->data;
2619   const char      *name       = "Residual";
2620   DM               dmAux      = NULL;
2621   DM               dmGrad     = NULL;
2622   DMLabel          ghostLabel = NULL;
2623   PetscDS          prob       = NULL;
2624   PetscDS          probAux    = NULL;
2625   PetscBool        useFEM     = PETSC_FALSE;
2626   PetscBool        useFVM     = PETSC_FALSE;
2627   PetscBool        isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
2628   PetscFV          fvm        = NULL;
2629   PetscFVCellGeom *cgeomFVM   = NULL;
2630   PetscFVFaceGeom *fgeomFVM   = NULL;
2631   DMField          coordField = NULL;
2632   Vec              locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL;
2633   PetscScalar     *u = NULL, *u_t, *a, *uL, *uR;
2634   IS               chunkIS;
2635   const PetscInt  *cells;
2636   PetscInt         cStart, cEnd, numCells;
2637   PetscInt         Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd;
2638   PetscInt         maxDegree = PETSC_MAX_INT;
2639   PetscQuadrature  affineQuad = NULL, *quads = NULL;
2640   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
2641   PetscErrorCode   ierr;
2642 
2643   PetscFunctionBegin;
2644   ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
2645   /* FEM+FVM */
2646   /* 1: Get sizes from dm and dmAux */
2647   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2648   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
2649   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2650   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2651   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
2652   if (locA) {
2653     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
2654     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
2655     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
2656   }
2657   /* 2: Get geometric data */
2658   for (f = 0; f < Nf; ++f) {
2659     PetscObject  obj;
2660     PetscClassId id;
2661     PetscBool    fimp;
2662 
2663     ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
2664     if (isImplicit != fimp) continue;
2665     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2666     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2667     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
2668     if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
2669   }
2670   if (useFEM) {
2671     ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
2672     ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
2673     if (maxDegree <= 1) {
2674       ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
2675       if (affineQuad) {
2676         ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
2677       }
2678     } else {
2679       ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
2680       for (f = 0; f < Nf; ++f) {
2681         PetscObject  obj;
2682         PetscClassId id;
2683         PetscBool    fimp;
2684 
2685         ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
2686         if (isImplicit != fimp) continue;
2687         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2688         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2689         if (id == PETSCFE_CLASSID) {
2690           PetscFE fe = (PetscFE) obj;
2691 
2692           ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
2693           ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr);
2694           ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
2695         }
2696       }
2697     }
2698   }
2699   if (useFVM) {
2700 #if 0
2701     ierr = DMPlexSNESGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr);
2702     ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr);
2703     ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
2704     /* Reconstruct and limit cell gradients */
2705     ierr = DMPlexSNESGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr);
2706     if (dmGrad) {
2707       ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2708       ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
2709       ierr = DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
2710       /* Communicate gradient values */
2711       ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
2712       ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
2713       ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
2714       ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
2715     }
2716     /* Handle non-essential (e.g. outflow) boundary values */
2717     ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
2718 #endif
2719   }
2720   /* Loop over chunks */
2721   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
2722   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2723   if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);}
2724   numCells      = cEnd - cStart;
2725   numChunks     = 1;
2726   cellChunkSize = numCells/numChunks;
2727   faceChunkSize = (fEnd - fStart)/numChunks;
2728   numChunks     = PetscMin(1,numCells);
2729   for (chunk = 0; chunk < numChunks; ++chunk) {
2730     PetscScalar     *elemVec, *fluxL, *fluxR;
2731     PetscReal       *vol;
2732     PetscFVFaceGeom *fgeom;
2733     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
2734     PetscInt         fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face;
2735 
2736     /* Extract field coefficients */
2737     if (useFEM) {
2738       ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr);
2739       ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
2740       ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
2741       ierr = PetscMemzero(elemVec, numCells*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
2742     }
2743     if (useFVM) {
2744 #if 0
2745       ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
2746       ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
2747       ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
2748       ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
2749       ierr = PetscMemzero(fluxL, numFaces*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
2750       ierr = PetscMemzero(fluxR, numFaces*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
2751 #endif
2752     }
2753     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
2754     /* Loop over fields */
2755     for (f = 0; f < Nf; ++f) {
2756       PetscObject  obj;
2757       PetscClassId id;
2758       PetscBool    fimp;
2759       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
2760 
2761       ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
2762       if (isImplicit != fimp) continue;
2763       ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2764       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2765       if (id == PETSCFE_CLASSID) {
2766         PetscFE         fe = (PetscFE) obj;
2767         PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
2768         PetscFEGeom    *chunkGeom = NULL;
2769         PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
2770         PetscInt        Nq, Nb;
2771 
2772         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2773         ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2774         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2775         blockSize = Nb;
2776         batchSize = numBlocks * blockSize;
2777         ierr      = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2778         numChunks = numCells / (numBatches*batchSize);
2779         Ne        = numChunks*numBatches*batchSize;
2780         Nr        = numCells % (numBatches*batchSize);
2781         offset    = numCells - Nr;
2782         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
2783         /*   For FV, I think we use a P0 basis and the cell coefficients (for subdivided cells, we can tweak the basis tabulation to be the indicator function) */
2784         ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
2785         ierr = PetscFEIntegrateResidual(fe, prob, f, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
2786         ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2787         ierr = PetscFEIntegrateResidual(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
2788         ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2789       } else if (id == PETSCFV_CLASSID) {
2790         PetscFV fv = (PetscFV) obj;
2791 
2792         Ne = numFaces;
2793         /* Riemann solve over faces (need fields at face centroids) */
2794         /*   We need to evaluate FE fields at those coordinates */
2795         ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
2796       } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
2797     }
2798     /* Loop over domain */
2799     if (useFEM) {
2800       /* Add elemVec to locX */
2801       for (c = cS; c < cE; ++c) {
2802         const PetscInt cell = cells ? cells[c] : c;
2803         const PetscInt cind = c - cStart;
2804 
2805         if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
2806         if (ghostLabel) {
2807           PetscInt ghostVal;
2808 
2809           ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
2810           if (ghostVal > 0) continue;
2811         }
2812         ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
2813       }
2814     }
2815     if (useFVM) {
2816 #if 0
2817       PetscScalar *fa;
2818       PetscInt     iface;
2819 
2820       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
2821       for (f = 0; f < Nf; ++f) {
2822         PetscFV      fv;
2823         PetscObject  obj;
2824         PetscClassId id;
2825         PetscInt     foff, pdim;
2826 
2827         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2828         ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
2829         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2830         if (id != PETSCFV_CLASSID) continue;
2831         fv   = (PetscFV) obj;
2832         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
2833         /* Accumulate fluxes to cells */
2834         for (face = fS, iface = 0; face < fE; ++face) {
2835           const PetscInt *scells;
2836           PetscScalar    *fL = NULL, *fR = NULL;
2837           PetscInt        ghost, d, nsupp, nchild;
2838 
2839           ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
2840           ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
2841           ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
2842           if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
2843           ierr = DMPlexGetSupport(dm, face, &scells);CHKERRQ(ierr);
2844           ierr = DMLabelGetValue(ghostLabel,scells[0],&ghost);CHKERRQ(ierr);
2845           if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL);CHKERRQ(ierr);}
2846           ierr = DMLabelGetValue(ghostLabel,scells[1],&ghost);CHKERRQ(ierr);
2847           if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR);CHKERRQ(ierr);}
2848           for (d = 0; d < pdim; ++d) {
2849             if (fL) fL[d] -= fluxL[iface*totDim+foff+d];
2850             if (fR) fR[d] += fluxR[iface*totDim+foff+d];
2851           }
2852           ++iface;
2853         }
2854       }
2855       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
2856 #endif
2857     }
2858     /* Handle time derivative */
2859     if (locX_t) {
2860       PetscScalar *x_t, *fa;
2861 
2862       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
2863       ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
2864       for (f = 0; f < Nf; ++f) {
2865         PetscFV      fv;
2866         PetscObject  obj;
2867         PetscClassId id;
2868         PetscInt     pdim, d;
2869 
2870         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2871         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2872         if (id != PETSCFV_CLASSID) continue;
2873         fv   = (PetscFV) obj;
2874         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
2875         for (c = cS; c < cE; ++c) {
2876           const PetscInt cell = cells ? cells[c] : c;
2877           PetscScalar   *u_t, *r;
2878 
2879           if (ghostLabel) {
2880             PetscInt ghostVal;
2881 
2882             ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr);
2883             if (ghostVal > 0) continue;
2884           }
2885           ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
2886           ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
2887           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
2888         }
2889       }
2890       ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
2891       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
2892     }
2893     if (useFEM) {
2894       ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
2895       ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
2896     }
2897     if (useFVM) {
2898 #if 0
2899       ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
2900       ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
2901       ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
2902       ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
2903       if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);}
2904 #endif
2905     }
2906   }
2907   if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);}
2908   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
2909   /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */
2910   if (useFEM) {
2911     if (maxDegree <= 1) {
2912       ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
2913       ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
2914     } else {
2915       for (f = 0; f < Nf; ++f) {
2916         ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
2917         ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);
2918       }
2919       ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
2920     }
2921   }
2922   ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
2923   PetscFunctionReturn(0);
2924 }
2925 
2926 /*
2927   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
2928 
2929   X   - The local solution vector
2930   X_t - The local solution time derviative vector, or NULL
2931 */
2932 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS,
2933                                                     PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx)
2934 {
2935   DM_Plex         *mesh  = (DM_Plex *) dm->data;
2936   const char      *name = "Jacobian", *nameP = "JacobianPre";
2937   DM               dmAux = NULL;
2938   PetscDS          prob,   probAux = NULL;
2939   PetscSection     sectionAux = NULL;
2940   Vec              A;
2941   DMField          coordField;
2942   PetscFEGeom     *cgeomFEM;
2943   PetscQuadrature  qGeom = NULL;
2944   Mat              J = Jac, JP = JacP;
2945   PetscScalar     *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL;
2946   PetscBool        hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE;
2947   const PetscInt  *cells;
2948   PetscInt         Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0;
2949   PetscErrorCode   ierr;
2950 
2951   PetscFunctionBegin;
2952   CHKMEMQ;
2953   ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
2954   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
2955   ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
2956   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
2957   ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
2958   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
2959   if (dmAux) {
2960     ierr = DMGetDefaultSection(dmAux, &sectionAux);CHKERRQ(ierr);
2961     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
2962   }
2963   /* Get flags */
2964   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2965   ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
2966   for (fieldI = 0; fieldI < Nf; ++fieldI) {
2967     PetscObject  disc;
2968     PetscClassId id;
2969     ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr);
2970     ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr);
2971     if (id == PETSCFE_CLASSID)      {isFE[fieldI] = PETSC_TRUE;}
2972     else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;}
2973   }
2974   ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr);
2975   ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
2976   ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr);
2977   assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE;
2978   hasDyn      = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
2979   ierr = PetscObjectTypeCompare((PetscObject) Jac,  MATIS, &isMatIS);CHKERRQ(ierr);
2980   ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
2981   /* Setup input data and temp arrays (should be DMGetWorkArray) */
2982   if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);}
2983   if (isMatIS)  {ierr = MatISGetLocalMat(Jac,  &J);CHKERRQ(ierr);}
2984   if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);}
2985   if (hasFV)    {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */
2986   ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
2987   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
2988   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2989   if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);}
2990   CHKMEMQ;
2991   /* Compute batch sizes */
2992   if (isFE[0]) {
2993     PetscFE         fe;
2994     PetscQuadrature q;
2995     PetscInt        numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb;
2996 
2997     ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
2998     ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
2999     ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
3000     ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
3001     ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
3002     blockSize = Nb*numQuadPoints;
3003     batchSize = numBlocks  * blockSize;
3004     chunkSize = numBatches * batchSize;
3005     numChunks = numCells / chunkSize + numCells % chunkSize;
3006     ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
3007   } else {
3008     chunkSize = numCells;
3009     numChunks = 1;
3010   }
3011   /* Get work space */
3012   wsz  = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize;
3013   ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr);
3014   ierr = PetscMemzero(work, wsz * sizeof(PetscScalar));CHKERRQ(ierr);
3015   off      = 0;
3016   u        = X       ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
3017   u_t      = X_t     ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
3018   a        = dmAux   ? (sz = chunkSize*totDimAux,     off += sz, work+off-sz) : NULL;
3019   elemMat  = hasJac  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
3020   elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
3021   elemMatD = hasDyn  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
3022   if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz);
3023   /* Setup geometry */
3024   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
3025   ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
3026   if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);}
3027   if (!qGeom) {
3028     PetscFE fe;
3029 
3030     ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
3031     ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr);
3032     ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
3033   }
3034   ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
3035   /* Compute volume integrals */
3036   if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);}
3037   ierr = MatZeroEntries(JP);CHKERRQ(ierr);
3038   for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) {
3039     const PetscInt   Ncell = PetscMin(chunkSize, numCells - offCell);
3040     PetscInt         c;
3041 
3042     /* Extract values */
3043     for (c = 0; c < Ncell; ++c) {
3044       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
3045       PetscScalar   *x = NULL,  *x_t = NULL;
3046       PetscInt       i;
3047 
3048       if (X) {
3049         ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
3050         for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
3051         ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
3052       }
3053       if (X_t) {
3054         ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
3055         for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
3056         ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
3057       }
3058       if (dmAux) {
3059         ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
3060         for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
3061         ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
3062       }
3063     }
3064     CHKMEMQ;
3065     for (fieldI = 0; fieldI < Nf; ++fieldI) {
3066       PetscFE fe;
3067       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
3068       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
3069         if (hasJac)  {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN,     fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);}
3070         if (hasPrec) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);}
3071         if (hasDyn)  {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);}
3072       }
3073       /* For finite volume, add the identity */
3074       if (!isFE[fieldI]) {
3075         PetscFV  fv;
3076         PetscInt eOffset = 0, Nc, fc, foff;
3077 
3078         ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr);
3079         ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr);
3080         ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
3081         for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) {
3082           for (fc = 0; fc < Nc; ++fc) {
3083             const PetscInt i = foff + fc;
3084             if (hasJac)  {elemMat [eOffset+i*totDim+i] = 1.0;}
3085             if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;}
3086           }
3087         }
3088       }
3089     }
3090     CHKMEMQ;
3091     /*   Add contribution from X_t */
3092     if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
3093     /* Insert values into matrix */
3094     for (c = 0; c < Ncell; ++c) {
3095       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
3096       if (mesh->printFEM > 1) {
3097         if (hasJac)  {ierr = DMPrintCellMatrix(cell, name,  totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
3098         if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
3099       }
3100       if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);}
3101       ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
3102     }
3103     CHKMEMQ;
3104   }
3105   /* Cleanup */
3106   ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
3107   ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
3108   if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);}
3109   ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
3110   ierr = 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);CHKERRQ(ierr);
3111   /* Compute boundary integrals */
3112   /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */
3113   /* Assemble matrix */
3114   if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);}
3115   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3116   ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
3117   CHKMEMQ;
3118   PetscFunctionReturn(0);
3119 }
3120