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