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