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