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