xref: /petsc/src/dm/impls/plex/plexfem.c (revision 2065540a855ff9f9c49aa4d22d544ff2b07d8a79)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petscsf.h>
3 
4 #include <petsc/private/hashsetij.h>
5 #include <petsc/private/petscfeimpl.h>
6 #include <petsc/private/petscfvimpl.h>
7 
8 static PetscErrorCode DMPlexConvertPlex(DM dm, DM *plex, PetscBool copy)
9 {
10   PetscBool      isPlex;
11   PetscErrorCode ierr;
12 
13   PetscFunctionBegin;
14   ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr);
15   if (isPlex) {
16     *plex = dm;
17     ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
18   } else {
19     ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr);
20     if (!*plex) {
21       ierr = DMConvert(dm, DMPLEX, plex);CHKERRQ(ierr);
22       ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr);
23       if (copy) {
24         DMSubDomainHookLink link;
25 
26         ierr = DMCopyAuxiliaryVec(dm, *plex);CHKERRQ(ierr);
27         /* Run the subdomain hook (this will copy the DMSNES/DMTS) */
28         for (link = dm->subdomainhook; link; link = link->next) {
29           if (link->ddhook) {ierr = (*link->ddhook)(dm, *plex, link->ctx);CHKERRQ(ierr);}
30         }
31       }
32     } else {
33       ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr);
34     }
35   }
36   PetscFunctionReturn(0);
37 }
38 
39 static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx)
40 {
41   PetscFEGeom *geom = (PetscFEGeom *) ctx;
42   PetscErrorCode ierr;
43 
44   PetscFunctionBegin;
45   ierr = PetscFEGeomDestroy(&geom);CHKERRQ(ierr);
46   PetscFunctionReturn(0);
47 }
48 
49 static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
50 {
51   char            composeStr[33] = {0};
52   PetscObjectId   id;
53   PetscContainer  container;
54   PetscErrorCode  ierr;
55 
56   PetscFunctionBegin;
57   ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
58   ierr = PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);CHKERRQ(ierr);
59   ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
60   if (container) {
61     ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
62   } else {
63     ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
64     ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
65     ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
66     ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
67     ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
68     ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
69   }
70   PetscFunctionReturn(0);
71 }
72 
73 static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
74 {
75   PetscFunctionBegin;
76   *geom = NULL;
77   PetscFunctionReturn(0);
78 }
79 
80 /*@
81   DMPlexGetScale - Get the scale for the specified fundamental unit
82 
83   Not collective
84 
85   Input Arguments:
86 + dm   - the DM
87 - unit - The SI unit
88 
89   Output Argument:
90 . scale - The value used to scale all quantities with this unit
91 
92   Level: advanced
93 
94 .seealso: DMPlexSetScale(), PetscUnit
95 @*/
96 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale)
97 {
98   DM_Plex *mesh = (DM_Plex*) dm->data;
99 
100   PetscFunctionBegin;
101   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
102   PetscValidPointer(scale, 3);
103   *scale = mesh->scale[unit];
104   PetscFunctionReturn(0);
105 }
106 
107 /*@
108   DMPlexSetScale - Set the scale for the specified fundamental unit
109 
110   Not collective
111 
112   Input Arguments:
113 + dm   - the DM
114 . unit - The SI unit
115 - scale - The value used to scale all quantities with this unit
116 
117   Level: advanced
118 
119 .seealso: DMPlexGetScale(), PetscUnit
120 @*/
121 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale)
122 {
123   DM_Plex *mesh = (DM_Plex*) dm->data;
124 
125   PetscFunctionBegin;
126   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
127   mesh->scale[unit] = scale;
128   PetscFunctionReturn(0);
129 }
130 
131 static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nc, PetscScalar *mode, void *ctx)
132 {
133   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}}};
134   PetscInt *ctxInt  = (PetscInt *) ctx;
135   PetscInt  dim2    = ctxInt[0];
136   PetscInt  d       = ctxInt[1];
137   PetscInt  i, j, k = dim > 2 ? d - dim : d;
138 
139   PetscFunctionBegin;
140   if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %D does not match context dimension %D", dim, dim2);
141   for (i = 0; i < dim; i++) mode[i] = 0.;
142   if (d < dim) {
143     mode[d] = 1.; /* Translation along axis d */
144   } else {
145     for (i = 0; i < dim; i++) {
146       for (j = 0; j < dim; j++) {
147         mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */
148       }
149     }
150   }
151   PetscFunctionReturn(0);
152 }
153 
154 /*@
155   DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation
156 
157   Collective on dm
158 
159   Input Arguments:
160 + dm - the DM
161 - field - The field number for the rigid body space, or 0 for the default
162 
163   Output Argument:
164 . sp - the null space
165 
166   Note: This is necessary to provide a suitable coarse space for algebraic multigrid
167 
168   Level: advanced
169 
170 .seealso: MatNullSpaceCreate(), PCGAMG
171 @*/
172 PetscErrorCode DMPlexCreateRigidBody(DM dm, PetscInt field, MatNullSpace *sp)
173 {
174   PetscErrorCode (**func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
175   MPI_Comm          comm;
176   Vec               mode[6];
177   PetscSection      section, globalSection;
178   PetscInt          dim, dimEmbed, Nf, n, m, mmin, d, i, j;
179   PetscErrorCode    ierr;
180 
181   PetscFunctionBegin;
182   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
183   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
184   ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
185   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
186   if (Nf && (field < 0 || field >= Nf)) SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Field %D is not in [0, Nf)", field, Nf);
187   if (dim == 1 && Nf < 2) {
188     ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr);
189     PetscFunctionReturn(0);
190   }
191   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
192   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
193   ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
194   ierr = PetscCalloc1(Nf, &func);CHKERRQ(ierr);
195   m    = (dim*(dim+1))/2;
196   ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
197   ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
198   ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
199   ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr);
200   mmin = PetscMin(m, n);
201   func[field] = DMPlexProjectRigidBody_Private;
202   for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
203   for (d = 0; d < m; d++) {
204     PetscInt ctx[2];
205     void    *voidctx = (void *) (&ctx[0]);
206 
207     ctx[0] = dimEmbed;
208     ctx[1] = d;
209     ierr = DMProjectFunction(dm, 0.0, func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
210   }
211   /* Orthonormalize system */
212   for (i = 0; i < mmin; ++i) {
213     PetscScalar dots[6];
214 
215     ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
216     ierr = VecMDot(mode[i], mmin-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr);
217     for (j = i+1; j < mmin; ++j) {
218       dots[j] *= -1.0;
219       ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr);
220     }
221   }
222   ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr);
223   for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
224   ierr = PetscFree(func);CHKERRQ(ierr);
225   PetscFunctionReturn(0);
226 }
227 
228 /*@
229   DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation
230 
231   Collective on dm
232 
233   Input Arguments:
234 + dm    - the DM
235 . nb    - The number of bodies
236 . label - The DMLabel marking each domain
237 . nids  - The number of ids per body
238 - ids   - An array of the label ids in sequence for each domain
239 
240   Output Argument:
241 . sp - the null space
242 
243   Note: This is necessary to provide a suitable coarse space for algebraic multigrid
244 
245   Level: advanced
246 
247 .seealso: MatNullSpaceCreate()
248 @*/
249 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp)
250 {
251   MPI_Comm       comm;
252   PetscSection   section, globalSection;
253   Vec           *mode;
254   PetscScalar   *dots;
255   PetscInt       dim, dimEmbed, n, m, b, d, i, j, off;
256   PetscErrorCode ierr;
257 
258   PetscFunctionBegin;
259   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
260   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
261   ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
262   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
263   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
264   ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
265   m    = nb * (dim*(dim+1))/2;
266   ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr);
267   ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
268   ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
269   ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
270   for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
271   for (b = 0, off = 0; b < nb; ++b) {
272     for (d = 0; d < m/nb; ++d) {
273       PetscInt         ctx[2];
274       PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
275       void            *voidctx = (void *) (&ctx[0]);
276 
277       ctx[0] = dimEmbed;
278       ctx[1] = d;
279       ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
280       off   += nids[b];
281     }
282   }
283   /* Orthonormalize system */
284   for (i = 0; i < m; ++i) {
285     PetscScalar dots[6];
286 
287     ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
288     ierr = VecMDot(mode[i], m-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr);
289     for (j = i+1; j < m; ++j) {
290       dots[j] *= -1.0;
291       ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr);
292     }
293   }
294   ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr);
295   for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
296   ierr = PetscFree2(mode, dots);CHKERRQ(ierr);
297   PetscFunctionReturn(0);
298 }
299 
300 /*@
301   DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs
302   are computed by associating the basis function with one of the mesh points in its transitively-closed support, and
303   evaluating the dual space basis of that point.  A basis function is associated with the point in its
304   transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum
305   projection height, which is set with this function.  By default, the maximum projection height is zero, which means
306   that only mesh cells are used to project basis functions.  A height of one, for example, evaluates a cell-interior
307   basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face.
308 
309   Input Parameters:
310 + dm - the DMPlex object
311 - height - the maximum projection height >= 0
312 
313   Level: advanced
314 
315 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
316 @*/
317 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height)
318 {
319   DM_Plex *plex = (DM_Plex *) dm->data;
320 
321   PetscFunctionBegin;
322   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
323   plex->maxProjectionHeight = height;
324   PetscFunctionReturn(0);
325 }
326 
327 /*@
328   DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in
329   DMPlexProjectXXXLocal() functions.
330 
331   Input Parameters:
332 . dm - the DMPlex object
333 
334   Output Parameters:
335 . height - the maximum projection height
336 
337   Level: intermediate
338 
339 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
340 @*/
341 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height)
342 {
343   DM_Plex *plex = (DM_Plex *) dm->data;
344 
345   PetscFunctionBegin;
346   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
347   *height = plex->maxProjectionHeight;
348   PetscFunctionReturn(0);
349 }
350 
351 typedef struct {
352   PetscReal    alpha; /* The first Euler angle, and in 2D the only one */
353   PetscReal    beta;  /* The second Euler angle */
354   PetscReal    gamma; /* The third Euler angle */
355   PetscInt     dim;   /* The dimension of R */
356   PetscScalar *R;     /* The rotation matrix, transforming a vector in the local basis to the global basis */
357   PetscScalar *RT;    /* The transposed rotation matrix, transforming a vector in the global basis to the local basis */
358 } RotCtx;
359 
360 /*
361   Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that
362   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:
363   $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis.
364   $ 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.
365   $ The XYZ system rotates a third time about the z axis by gamma.
366 */
367 static PetscErrorCode DMPlexBasisTransformSetUp_Rotation_Internal(DM dm, void *ctx)
368 {
369   RotCtx        *rc  = (RotCtx *) ctx;
370   PetscInt       dim = rc->dim;
371   PetscReal      c1, s1, c2, s2, c3, s3;
372   PetscErrorCode ierr;
373 
374   PetscFunctionBegin;
375   ierr = PetscMalloc2(PetscSqr(dim), &rc->R, PetscSqr(dim), &rc->RT);CHKERRQ(ierr);
376   switch (dim) {
377   case 2:
378     c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha);
379     rc->R[0] =  c1;rc->R[1] = s1;
380     rc->R[2] = -s1;rc->R[3] = c1;
381     ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr);
382     DMPlex_Transpose2D_Internal(rc->RT);
383     break;
384   case 3:
385     c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha);
386     c2 = PetscCosReal(rc->beta); s2 = PetscSinReal(rc->beta);
387     c3 = PetscCosReal(rc->gamma);s3 = PetscSinReal(rc->gamma);
388     rc->R[0] =  c1*c3 - c2*s1*s3;rc->R[1] =  c3*s1    + c1*c2*s3;rc->R[2] = s2*s3;
389     rc->R[3] = -c1*s3 - c2*c3*s1;rc->R[4] =  c1*c2*c3 - s1*s3;   rc->R[5] = c3*s2;
390     rc->R[6] =  s1*s2;           rc->R[7] = -c1*s2;              rc->R[8] = c2;
391     ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr);
392     DMPlex_Transpose3D_Internal(rc->RT);
393     break;
394   default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Dimension %D not supported", dim);
395   }
396   PetscFunctionReturn(0);
397 }
398 
399 static PetscErrorCode DMPlexBasisTransformDestroy_Rotation_Internal(DM dm, void *ctx)
400 {
401   RotCtx        *rc = (RotCtx *) ctx;
402   PetscErrorCode ierr;
403 
404   PetscFunctionBegin;
405   ierr = PetscFree2(rc->R, rc->RT);CHKERRQ(ierr);
406   ierr = PetscFree(rc);CHKERRQ(ierr);
407   PetscFunctionReturn(0);
408 }
409 
410 static PetscErrorCode DMPlexBasisTransformGetMatrix_Rotation_Internal(DM dm, const PetscReal x[], PetscBool l2g, const PetscScalar **A, void *ctx)
411 {
412   RotCtx *rc = (RotCtx *) ctx;
413 
414   PetscFunctionBeginHot;
415   PetscValidPointer(ctx, 5);
416   if (l2g) {*A = rc->R;}
417   else     {*A = rc->RT;}
418   PetscFunctionReturn(0);
419 }
420 
421 PetscErrorCode DMPlexBasisTransformApplyReal_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscReal *y, PetscReal *z, void *ctx)
422 {
423   PetscErrorCode ierr;
424 
425   PetscFunctionBegin;
426   #if defined(PETSC_USE_COMPLEX)
427   switch (dim) {
428     case 2:
429     {
430       PetscScalar yt[2], zt[2] = {0.0,0.0};
431 
432       yt[0] = y[0]; yt[1] = y[1];
433       ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr);
434       z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]);
435     }
436     break;
437     case 3:
438     {
439       PetscScalar yt[3], zt[3] = {0.0,0.0,0.0};
440 
441       yt[0] = y[0]; yt[1] = y[1]; yt[2] = y[2];
442       ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr);
443       z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); z[2] = PetscRealPart(zt[2]);
444     }
445     break;
446   }
447   #else
448   ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr);
449   #endif
450   PetscFunctionReturn(0);
451 }
452 
453 PetscErrorCode DMPlexBasisTransformApply_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscScalar *y, PetscScalar *z, void *ctx)
454 {
455   const PetscScalar *A;
456   PetscErrorCode     ierr;
457 
458   PetscFunctionBeginHot;
459   ierr = (*dm->transformGetMatrix)(dm, x, l2g, &A, ctx);CHKERRQ(ierr);
460   switch (dim) {
461   case 2: DMPlex_Mult2D_Internal(A, 1, y, z);break;
462   case 3: DMPlex_Mult3D_Internal(A, 1, y, z);break;
463   }
464   PetscFunctionReturn(0);
465 }
466 
467 static PetscErrorCode DMPlexBasisTransformField_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscInt f, PetscBool l2g, PetscScalar *a)
468 {
469   PetscSection       ts;
470   const PetscScalar *ta, *tva;
471   PetscInt           dof;
472   PetscErrorCode     ierr;
473 
474   PetscFunctionBeginHot;
475   ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
476   ierr = PetscSectionGetFieldDof(ts, p, f, &dof);CHKERRQ(ierr);
477   ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
478   ierr = DMPlexPointLocalFieldRead(tdm, p, f, ta, (void *) &tva);CHKERRQ(ierr);
479   if (l2g) {
480     switch (dof) {
481     case 4: DMPlex_Mult2D_Internal(tva, 1, a, a);break;
482     case 9: DMPlex_Mult3D_Internal(tva, 1, a, a);break;
483     }
484   } else {
485     switch (dof) {
486     case 4: DMPlex_MultTranspose2D_Internal(tva, 1, a, a);break;
487     case 9: DMPlex_MultTranspose3D_Internal(tva, 1, a, a);break;
488     }
489   }
490   ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
491   PetscFunctionReturn(0);
492 }
493 
494 static PetscErrorCode DMPlexBasisTransformFieldTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt pf, PetscInt f, PetscInt pg, PetscInt g, PetscBool l2g, PetscInt lda, PetscScalar *a)
495 {
496   PetscSection       s, ts;
497   const PetscScalar *ta, *tvaf, *tvag;
498   PetscInt           fdof, gdof, fpdof, gpdof;
499   PetscErrorCode     ierr;
500 
501   PetscFunctionBeginHot;
502   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
503   ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
504   ierr = PetscSectionGetFieldDof(s, pf, f, &fpdof);CHKERRQ(ierr);
505   ierr = PetscSectionGetFieldDof(s, pg, g, &gpdof);CHKERRQ(ierr);
506   ierr = PetscSectionGetFieldDof(ts, pf, f, &fdof);CHKERRQ(ierr);
507   ierr = PetscSectionGetFieldDof(ts, pg, g, &gdof);CHKERRQ(ierr);
508   ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
509   ierr = DMPlexPointLocalFieldRead(tdm, pf, f, ta, (void *) &tvaf);CHKERRQ(ierr);
510   ierr = DMPlexPointLocalFieldRead(tdm, pg, g, ta, (void *) &tvag);CHKERRQ(ierr);
511   if (l2g) {
512     switch (fdof) {
513     case 4: DMPlex_MatMult2D_Internal(tvaf, gpdof, lda, a, a);break;
514     case 9: DMPlex_MatMult3D_Internal(tvaf, gpdof, lda, a, a);break;
515     }
516     switch (gdof) {
517     case 4: DMPlex_MatMultTransposeLeft2D_Internal(tvag, fpdof, lda, a, a);break;
518     case 9: DMPlex_MatMultTransposeLeft3D_Internal(tvag, fpdof, lda, a, a);break;
519     }
520   } else {
521     switch (fdof) {
522     case 4: DMPlex_MatMultTranspose2D_Internal(tvaf, gpdof, lda, a, a);break;
523     case 9: DMPlex_MatMultTranspose3D_Internal(tvaf, gpdof, lda, a, a);break;
524     }
525     switch (gdof) {
526     case 4: DMPlex_MatMultLeft2D_Internal(tvag, fpdof, lda, a, a);break;
527     case 9: DMPlex_MatMultLeft3D_Internal(tvag, fpdof, lda, a, a);break;
528     }
529   }
530   ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
531   PetscFunctionReturn(0);
532 }
533 
534 PetscErrorCode DMPlexBasisTransformPoint_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool fieldActive[], PetscBool l2g, PetscScalar *a)
535 {
536   PetscSection    s;
537   PetscSection    clSection;
538   IS              clPoints;
539   const PetscInt *clp;
540   PetscInt       *points = NULL;
541   PetscInt        Nf, f, Np, cp, dof, d = 0;
542   PetscErrorCode  ierr;
543 
544   PetscFunctionBegin;
545   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
546   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
547   ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
548   for (f = 0; f < Nf; ++f) {
549     for (cp = 0; cp < Np*2; cp += 2) {
550       ierr = PetscSectionGetFieldDof(s, points[cp], f, &dof);CHKERRQ(ierr);
551       if (!dof) continue;
552       if (fieldActive[f]) {ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, points[cp], f, l2g, &a[d]);CHKERRQ(ierr);}
553       d += dof;
554     }
555   }
556   ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
557   PetscFunctionReturn(0);
558 }
559 
560 PetscErrorCode DMPlexBasisTransformPointTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool l2g, PetscInt lda, PetscScalar *a)
561 {
562   PetscSection    s;
563   PetscSection    clSection;
564   IS              clPoints;
565   const PetscInt *clp;
566   PetscInt       *points = NULL;
567   PetscInt        Nf, f, g, Np, cpf, cpg, fdof, gdof, r, c = 0;
568   PetscErrorCode  ierr;
569 
570   PetscFunctionBegin;
571   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
572   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
573   ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
574   for (f = 0, r = 0; f < Nf; ++f) {
575     for (cpf = 0; cpf < Np*2; cpf += 2) {
576       ierr = PetscSectionGetFieldDof(s, points[cpf], f, &fdof);CHKERRQ(ierr);
577       for (g = 0, c = 0; g < Nf; ++g) {
578         for (cpg = 0; cpg < Np*2; cpg += 2) {
579           ierr = PetscSectionGetFieldDof(s, points[cpg], g, &gdof);CHKERRQ(ierr);
580           ierr = DMPlexBasisTransformFieldTensor_Internal(dm, tdm, tv, points[cpf], f, points[cpg], g, l2g, lda, &a[r*lda+c]);CHKERRQ(ierr);
581           c += gdof;
582         }
583       }
584       if (c != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of columns %D should be %D", c, lda);
585       r += fdof;
586     }
587   }
588   if (r != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of rows %D should be %D", c, lda);
589   ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
590   PetscFunctionReturn(0);
591 }
592 
593 static PetscErrorCode DMPlexBasisTransform_Internal(DM dm, Vec lv, PetscBool l2g)
594 {
595   DM                 tdm;
596   Vec                tv;
597   PetscSection       ts, s;
598   const PetscScalar *ta;
599   PetscScalar       *a, *va;
600   PetscInt           pStart, pEnd, p, Nf, f;
601   PetscErrorCode     ierr;
602 
603   PetscFunctionBegin;
604   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
605   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
606   ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
607   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
608   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
609   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
610   ierr = VecGetArray(lv, &a);CHKERRQ(ierr);
611   ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
612   for (p = pStart; p < pEnd; ++p) {
613     for (f = 0; f < Nf; ++f) {
614       ierr = DMPlexPointLocalFieldRef(dm, p, f, a, (void *) &va);CHKERRQ(ierr);
615       ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, p, f, l2g, va);CHKERRQ(ierr);
616     }
617   }
618   ierr = VecRestoreArray(lv, &a);CHKERRQ(ierr);
619   ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
620   PetscFunctionReturn(0);
621 }
622 
623 /*@
624   DMPlexGlobalToLocalBasis - Transform the values in the given local vector from the global basis to the local basis
625 
626   Input Parameters:
627 + dm - The DM
628 - lv - A local vector with values in the global basis
629 
630   Output Parameters:
631 . lv - A local vector with values in the local basis
632 
633   Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user will have a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal.
634 
635   Level: developer
636 
637 .seealso: DMPlexLocalToGlobalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation()
638 @*/
639 PetscErrorCode DMPlexGlobalToLocalBasis(DM dm, Vec lv)
640 {
641   PetscErrorCode ierr;
642 
643   PetscFunctionBegin;
644   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
645   PetscValidHeaderSpecific(lv, VEC_CLASSID, 2);
646   ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_FALSE);CHKERRQ(ierr);
647   PetscFunctionReturn(0);
648 }
649 
650 /*@
651   DMPlexLocalToGlobalBasis - Transform the values in the given local vector from the local basis to the global basis
652 
653   Input Parameters:
654 + dm - The DM
655 - lv - A local vector with values in the local basis
656 
657   Output Parameters:
658 . lv - A local vector with values in the global basis
659 
660   Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user would want a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal.
661 
662   Level: developer
663 
664 .seealso: DMPlexGlobalToLocalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation()
665 @*/
666 PetscErrorCode DMPlexLocalToGlobalBasis(DM dm, Vec lv)
667 {
668   PetscErrorCode ierr;
669 
670   PetscFunctionBegin;
671   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
672   PetscValidHeaderSpecific(lv, VEC_CLASSID, 2);
673   ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_TRUE);CHKERRQ(ierr);
674   PetscFunctionReturn(0);
675 }
676 
677 /*@
678   DMPlexCreateBasisRotation - Create an internal transformation from the global basis, used to specify boundary conditions
679     and global solutions, to a local basis, appropriate for discretization integrals and assembly.
680 
681   Input Parameters:
682 + dm    - The DM
683 . alpha - The first Euler angle, and in 2D the only one
684 . beta  - The second Euler angle
685 - gamma - The third Euler angle
686 
687   Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that
688   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:
689   $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis.
690   $ 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.
691   $ The XYZ system rotates a third time about the z axis by gamma.
692 
693   Level: developer
694 
695 .seealso: DMPlexGlobalToLocalBasis(), DMPlexLocalToGlobalBasis()
696 @*/
697 PetscErrorCode DMPlexCreateBasisRotation(DM dm, PetscReal alpha, PetscReal beta, PetscReal gamma)
698 {
699   RotCtx        *rc;
700   PetscInt       cdim;
701   PetscErrorCode ierr;
702 
703   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
704   ierr = PetscMalloc1(1, &rc);CHKERRQ(ierr);
705   dm->transformCtx       = rc;
706   dm->transformSetUp     = DMPlexBasisTransformSetUp_Rotation_Internal;
707   dm->transformDestroy   = DMPlexBasisTransformDestroy_Rotation_Internal;
708   dm->transformGetMatrix = DMPlexBasisTransformGetMatrix_Rotation_Internal;
709   rc->dim   = cdim;
710   rc->alpha = alpha;
711   rc->beta  = beta;
712   rc->gamma = gamma;
713   ierr = (*dm->transformSetUp)(dm, dm->transformCtx);CHKERRQ(ierr);
714   ierr = DMConstructBasisTransform_Internal(dm);CHKERRQ(ierr);
715   PetscFunctionReturn(0);
716 }
717 
718 /*@C
719   DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector using a function of the coordinates
720 
721   Input Parameters:
722 + dm     - The DM, with a PetscDS that matches the problem being constrained
723 . time   - The time
724 . field  - The field to constrain
725 . Nc     - The number of constrained field components, or 0 for all components
726 . comps  - An array of constrained component numbers, or NULL for all components
727 . label  - The DMLabel defining constrained points
728 . numids - The number of DMLabel ids for constrained points
729 . ids    - An array of ids for constrained points
730 . func   - A pointwise function giving boundary values
731 - ctx    - An optional user context for bcFunc
732 
733   Output Parameter:
734 . locX   - A local vector to receives the boundary values
735 
736   Level: developer
737 
738 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary()
739 @*/
740 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)
741 {
742   PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx);
743   void            **ctxs;
744   PetscInt          numFields;
745   PetscErrorCode    ierr;
746 
747   PetscFunctionBegin;
748   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
749   ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
750   funcs[field] = func;
751   ctxs[field]  = ctx;
752   ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
753   ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
754   PetscFunctionReturn(0);
755 }
756 
757 /*@C
758   DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector using a function of the coordinates and field data
759 
760   Input Parameters:
761 + dm     - The DM, with a PetscDS that matches the problem being constrained
762 . time   - The time
763 . locU   - A local vector with the input solution values
764 . field  - The field to constrain
765 . Nc     - The number of constrained field components, or 0 for all components
766 . comps  - An array of constrained component numbers, or NULL for all components
767 . label  - The DMLabel defining constrained points
768 . numids - The number of DMLabel ids for constrained points
769 . ids    - An array of ids for constrained points
770 . func   - A pointwise function giving boundary values
771 - ctx    - An optional user context for bcFunc
772 
773   Output Parameter:
774 . locX   - A local vector to receives the boundary values
775 
776   Level: developer
777 
778 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary()
779 @*/
780 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
781                                                         void (*func)(PetscInt, PetscInt, PetscInt,
782                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
783                                                                      const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
784                                                                      PetscReal, const PetscReal[], PetscInt, const PetscScalar[],
785                                                                      PetscScalar[]),
786                                                         void *ctx, Vec locX)
787 {
788   void (**funcs)(PetscInt, PetscInt, PetscInt,
789                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
790                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
791                  PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
792   void            **ctxs;
793   PetscInt          numFields;
794   PetscErrorCode    ierr;
795 
796   PetscFunctionBegin;
797   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
798   ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
799   funcs[field] = func;
800   ctxs[field]  = ctx;
801   ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
802   ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
803   PetscFunctionReturn(0);
804 }
805 
806 /*@C
807   DMPlexInsertBoundaryValuesEssentialBdField - Insert boundary values into a local vector using a function of the coodinates and boundary field data
808 
809   Collective on dm
810 
811   Input Parameters:
812 + dm     - The DM, with a PetscDS that matches the problem being constrained
813 . time   - The time
814 . locU   - A local vector with the input solution values
815 . field  - The field to constrain
816 . Nc     - The number of constrained field components, or 0 for all components
817 . comps  - An array of constrained component numbers, or NULL for all components
818 . label  - The DMLabel defining constrained points
819 . numids - The number of DMLabel ids for constrained points
820 . ids    - An array of ids for constrained points
821 . func   - A pointwise function giving boundary values, the calling sequence is given in DMProjectBdFieldLabelLocal()
822 - ctx    - An optional user context for bcFunc
823 
824   Output Parameter:
825 . locX   - A local vector to receive the boundary values
826 
827   Level: developer
828 
829 .seealso: DMProjectBdFieldLabelLocal(), DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
830 @*/
831 PetscErrorCode DMPlexInsertBoundaryValuesEssentialBdField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
832                                                           void (*func)(PetscInt, PetscInt, PetscInt,
833                                                                        const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
834                                                                        const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
835                                                                        PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[],
836                                                                        PetscScalar[]),
837                                                           void *ctx, Vec locX)
838 {
839   void (**funcs)(PetscInt, PetscInt, PetscInt,
840                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
841                  const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
842                  PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
843   void            **ctxs;
844   PetscInt          numFields;
845   PetscErrorCode    ierr;
846 
847   PetscFunctionBegin;
848   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
849   ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
850   funcs[field] = func;
851   ctxs[field]  = ctx;
852   ierr = DMProjectBdFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
853   ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
854   PetscFunctionReturn(0);
855 }
856 
857 /*@C
858   DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector
859 
860   Input Parameters:
861 + dm     - The DM, with a PetscDS that matches the problem being constrained
862 . time   - The time
863 . faceGeometry - A vector with the FVM face geometry information
864 . cellGeometry - A vector with the FVM cell geometry information
865 . Grad         - A vector with the FVM cell gradient information
866 . field  - The field to constrain
867 . Nc     - The number of constrained field components, or 0 for all components
868 . comps  - An array of constrained component numbers, or NULL for all components
869 . label  - The DMLabel defining constrained points
870 . numids - The number of DMLabel ids for constrained points
871 . ids    - An array of ids for constrained points
872 . func   - A pointwise function giving boundary values
873 - ctx    - An optional user context for bcFunc
874 
875   Output Parameter:
876 . locX   - A local vector to receives the boundary values
877 
878   Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary()
879 
880   Level: developer
881 
882 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
883 @*/
884 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[],
885                                                  PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX)
886 {
887   PetscDS            prob;
888   PetscSF            sf;
889   DM                 dmFace, dmCell, dmGrad;
890   const PetscScalar *facegeom, *cellgeom = NULL, *grad;
891   const PetscInt    *leaves;
892   PetscScalar       *x, *fx;
893   PetscInt           dim, nleaves, loc, fStart, fEnd, pdim, i;
894   PetscErrorCode     ierr, ierru = 0;
895 
896   PetscFunctionBegin;
897   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
898   ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr);
899   nleaves = PetscMax(0, nleaves);
900   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
901   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
902   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
903   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
904   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
905   if (cellGeometry) {
906     ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
907     ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
908   }
909   if (Grad) {
910     PetscFV fv;
911 
912     ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr);
913     ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr);
914     ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr);
915     ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
916     ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
917   }
918   ierr = VecGetArray(locX, &x);CHKERRQ(ierr);
919   for (i = 0; i < numids; ++i) {
920     IS              faceIS;
921     const PetscInt *faces;
922     PetscInt        numFaces, f;
923 
924     ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr);
925     if (!faceIS) continue; /* No points with that id on this process */
926     ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
927     ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
928     for (f = 0; f < numFaces; ++f) {
929       const PetscInt         face = faces[f], *cells;
930       PetscFVFaceGeom        *fg;
931 
932       if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */
933       ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr);
934       if (loc >= 0) continue;
935       ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
936       ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
937       if (Grad) {
938         PetscFVCellGeom       *cg;
939         PetscScalar           *cx, *cgrad;
940         PetscScalar           *xG;
941         PetscReal              dx[3];
942         PetscInt               d;
943 
944         ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr);
945         ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr);
946         ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr);
947         ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
948         DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx);
949         for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx);
950         ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx);
951         if (ierru) {
952           ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
953           ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
954           goto cleanup;
955         }
956       } else {
957         PetscScalar       *xI;
958         PetscScalar       *xG;
959 
960         ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr);
961         ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
962         ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);
963         if (ierru) {
964           ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
965           ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
966           goto cleanup;
967         }
968       }
969     }
970     ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
971     ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
972   }
973   cleanup:
974   ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr);
975   if (Grad) {
976     ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
977     ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr);
978   }
979   if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);}
980   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
981   CHKERRQ(ierru);
982   PetscFunctionReturn(0);
983 }
984 
985 static PetscErrorCode zero(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
986 {
987   PetscInt c;
988   for (c = 0; c < Nc; ++c) u[c] = 0.0;
989   return 0;
990 }
991 
992 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
993 {
994   PetscObject    isZero;
995   PetscDS        prob;
996   PetscInt       numBd, b;
997   PetscErrorCode ierr;
998 
999   PetscFunctionBegin;
1000   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1001   ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
1002   ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
1003   for (b = 0; b < numBd; ++b) {
1004     PetscWeakForm           wf;
1005     DMBoundaryConditionType type;
1006     const char             *name;
1007     DMLabel                 label;
1008     PetscInt                field, Nc;
1009     const PetscInt         *comps;
1010     PetscObject             obj;
1011     PetscClassId            id;
1012     void                  (*bvfunc)(void);
1013     PetscInt                numids;
1014     const PetscInt         *ids;
1015     void                   *ctx;
1016 
1017     ierr = PetscDSGetBoundary(prob, b, &wf, &type, &name, &label, &numids, &ids, &field, &Nc, &comps, &bvfunc, NULL, &ctx);CHKERRQ(ierr);
1018     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1019     ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1020     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1021     if (id == PETSCFE_CLASSID) {
1022       switch (type) {
1023         /* for FEM, there is no insertion to be done for non-essential boundary conditions */
1024       case DM_BC_ESSENTIAL:
1025         {
1026           PetscSimplePointFunc func = (PetscSimplePointFunc) bvfunc;
1027 
1028           if (isZero) func = zero;
1029           ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1030           ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, func, ctx, locX);CHKERRQ(ierr);
1031           ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1032         }
1033         break;
1034       case DM_BC_ESSENTIAL_FIELD:
1035         {
1036           PetscPointFunc func = (PetscPointFunc) bvfunc;
1037 
1038           ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1039           ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, func, ctx, locX);CHKERRQ(ierr);
1040           ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1041         }
1042         break;
1043       default: break;
1044       }
1045     } else if (id == PETSCFV_CLASSID) {
1046       {
1047         PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*) = (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) bvfunc;
1048 
1049         if (!faceGeomFVM) continue;
1050         ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids, func, ctx, locX);CHKERRQ(ierr);
1051       }
1052     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1053   }
1054   PetscFunctionReturn(0);
1055 }
1056 
1057 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1058 {
1059   PetscObject    isZero;
1060   PetscDS        prob;
1061   PetscInt       numBd, b;
1062   PetscErrorCode ierr;
1063 
1064   PetscFunctionBegin;
1065   if (!locX) PetscFunctionReturn(0);
1066   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1067   ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
1068   ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
1069   for (b = 0; b < numBd; ++b) {
1070     PetscWeakForm           wf;
1071     DMBoundaryConditionType type;
1072     const char             *name;
1073     DMLabel                 label;
1074     PetscInt                field, Nc;
1075     const PetscInt         *comps;
1076     PetscObject             obj;
1077     PetscClassId            id;
1078     PetscInt                numids;
1079     const PetscInt         *ids;
1080     void                  (*bvfunc)(void);
1081     void                   *ctx;
1082 
1083     ierr = PetscDSGetBoundary(prob, b, &wf, &type, &name, &label, &numids, &ids, &field, &Nc, &comps, NULL, &bvfunc, &ctx);CHKERRQ(ierr);
1084     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1085     ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1086     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1087     if (id == PETSCFE_CLASSID) {
1088       switch (type) {
1089         /* for FEM, there is no insertion to be done for non-essential boundary conditions */
1090       case DM_BC_ESSENTIAL:
1091         {
1092           PetscSimplePointFunc func_t = (PetscSimplePointFunc) bvfunc;
1093 
1094           if (isZero) func_t = zero;
1095           ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1096           ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, func_t, ctx, locX);CHKERRQ(ierr);
1097           ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1098         }
1099         break;
1100       case DM_BC_ESSENTIAL_FIELD:
1101         {
1102           PetscPointFunc func_t = (PetscPointFunc) bvfunc;
1103 
1104           ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1105           ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, func_t, ctx, locX);CHKERRQ(ierr);
1106           ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1107         }
1108         break;
1109       default: break;
1110       }
1111     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1112   }
1113   PetscFunctionReturn(0);
1114 }
1115 
1116 /*@
1117   DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector
1118 
1119   Input Parameters:
1120 + dm - The DM
1121 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
1122 . time - The time
1123 . faceGeomFVM - Face geometry data for FV discretizations
1124 . cellGeomFVM - Cell geometry data for FV discretizations
1125 - gradFVM - Gradient reconstruction data for FV discretizations
1126 
1127   Output Parameters:
1128 . locX - Solution updated with boundary values
1129 
1130   Level: developer
1131 
1132 .seealso: DMProjectFunctionLabelLocal()
1133 @*/
1134 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1135 {
1136   PetscErrorCode ierr;
1137 
1138   PetscFunctionBegin;
1139   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1140   PetscValidHeaderSpecific(locX, VEC_CLASSID, 2);
1141   if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);}
1142   if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);}
1143   if (gradFVM)     {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);}
1144   ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr);
1145   PetscFunctionReturn(0);
1146 }
1147 
1148 /*@
1149   DMPlexInsertTimeDerivativeBoundaryValues - Puts coefficients which represent boundary values of the time derviative into the local solution vector
1150 
1151   Input Parameters:
1152 + dm - The DM
1153 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
1154 . time - The time
1155 . faceGeomFVM - Face geometry data for FV discretizations
1156 . cellGeomFVM - Cell geometry data for FV discretizations
1157 - gradFVM - Gradient reconstruction data for FV discretizations
1158 
1159   Output Parameters:
1160 . locX_t - Solution updated with boundary values
1161 
1162   Level: developer
1163 
1164 .seealso: DMProjectFunctionLabelLocal()
1165 @*/
1166 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues(DM dm, PetscBool insertEssential, Vec locX_t, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1167 {
1168   PetscErrorCode ierr;
1169 
1170   PetscFunctionBegin;
1171   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1172   if (locX_t)      {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 2);}
1173   if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);}
1174   if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);}
1175   if (gradFVM)     {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);}
1176   ierr = PetscTryMethod(dm,"DMPlexInsertTimeDerviativeBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX_t,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr);
1177   PetscFunctionReturn(0);
1178 }
1179 
1180 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
1181 {
1182   Vec              localX;
1183   PetscErrorCode   ierr;
1184 
1185   PetscFunctionBegin;
1186   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1187   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr);
1188   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1189   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1190   ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr);
1191   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1192   PetscFunctionReturn(0);
1193 }
1194 
1195 /*@C
1196   DMComputeL2DiffLocal - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h.
1197 
1198   Collective on dm
1199 
1200   Input Parameters:
1201 + dm     - The DM
1202 . time   - The time
1203 . funcs  - The functions to evaluate for each field component
1204 . ctxs   - Optional array of contexts to pass to each function, or NULL.
1205 - localX - The coefficient vector u_h, a local vector
1206 
1207   Output Parameter:
1208 . diff - The diff ||u - u_h||_2
1209 
1210   Level: developer
1211 
1212 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff()
1213 @*/
1214 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff)
1215 {
1216   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
1217   DM               tdm;
1218   Vec              tv;
1219   PetscSection     section;
1220   PetscQuadrature  quad;
1221   PetscFEGeom      fegeom;
1222   PetscScalar     *funcVal, *interpolant;
1223   PetscReal       *coords, *gcoords;
1224   PetscReal        localDiff = 0.0;
1225   const PetscReal *quadWeights;
1226   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, c, field, fieldOffset;
1227   PetscBool        transform;
1228   PetscErrorCode   ierr;
1229 
1230   PetscFunctionBegin;
1231   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1232   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1233   fegeom.dimEmbed = coordDim;
1234   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1235   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1236   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1237   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1238   ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1239   for (field = 0; field < numFields; ++field) {
1240     PetscObject  obj;
1241     PetscClassId id;
1242     PetscInt     Nc;
1243 
1244     ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1245     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1246     if (id == PETSCFE_CLASSID) {
1247       PetscFE fe = (PetscFE) obj;
1248 
1249       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1250       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1251     } else if (id == PETSCFV_CLASSID) {
1252       PetscFV fv = (PetscFV) obj;
1253 
1254       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1255       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1256     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1257     numComponents += Nc;
1258   }
1259   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr);
1260   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1261   ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1262   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1263   ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
1264   for (c = cStart; c < cEnd; ++c) {
1265     PetscScalar *x = NULL;
1266     PetscReal    elemDiff = 0.0;
1267     PetscInt     qc = 0;
1268 
1269     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1270     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1271 
1272     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1273       PetscObject  obj;
1274       PetscClassId id;
1275       void * const ctx = ctxs ? ctxs[field] : NULL;
1276       PetscInt     Nb, Nc, q, fc;
1277 
1278       ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1279       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1280       if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1281       else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1282       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1283       if (debug) {
1284         char title[1024];
1285         ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr);
1286         ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
1287       }
1288       for (q = 0; q < Nq; ++q) {
1289         PetscFEGeom qgeom;
1290 
1291         qgeom.dimEmbed = fegeom.dimEmbed;
1292         qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1293         qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1294         qgeom.detJ     = &fegeom.detJ[q];
1295         if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", (double)fegeom.detJ[q], c, q);
1296         if (transform) {
1297           gcoords = &coords[coordDim*Nq];
1298           ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1299         } else {
1300           gcoords = &coords[coordDim*q];
1301         }
1302         ierr = (*funcs[field])(coordDim, time, gcoords, Nc, funcVal, ctx);
1303         if (ierr) {
1304           PetscErrorCode ierr2;
1305           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1306           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1307           ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1308           CHKERRQ(ierr);
1309         }
1310         if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1311         if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1312         else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1313         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1314         for (fc = 0; fc < Nc; ++fc) {
1315           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1316           if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    elem %D field %D,%D point %g %g %g diff %g\n", c, field, fc, (double)(coordDim > 0 ? coords[coordDim*q] : 0.), (double)(coordDim > 1 ? coords[coordDim*q+1] : 0.),(double)(coordDim > 2 ? coords[coordDim*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1317           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1318         }
1319       }
1320       fieldOffset += Nb;
1321       qc += Nc;
1322     }
1323     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1324     if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);}
1325     localDiff += elemDiff;
1326   }
1327   ierr  = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1328   ierr  = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
1329   *diff = PetscSqrtReal(*diff);
1330   PetscFunctionReturn(0);
1331 }
1332 
1333 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)
1334 {
1335   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
1336   DM               tdm;
1337   PetscSection     section;
1338   PetscQuadrature  quad;
1339   Vec              localX, tv;
1340   PetscScalar     *funcVal, *interpolant;
1341   const PetscReal *quadWeights;
1342   PetscFEGeom      fegeom;
1343   PetscReal       *coords, *gcoords;
1344   PetscReal        localDiff = 0.0;
1345   PetscInt         dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, c, field, fieldOffset;
1346   PetscBool        transform;
1347   PetscErrorCode   ierr;
1348 
1349   PetscFunctionBegin;
1350   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1351   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1352   fegeom.dimEmbed = coordDim;
1353   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1354   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1355   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1356   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1357   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1358   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1359   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1360   ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1361   for (field = 0; field < numFields; ++field) {
1362     PetscFE  fe;
1363     PetscInt Nc;
1364 
1365     ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr);
1366     ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1367     ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1368     numComponents += Nc;
1369   }
1370   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr);
1371   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1372   /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */
1373   ierr = PetscMalloc6(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ,numComponents*coordDim,&interpolant,Nq,&fegeom.detJ);CHKERRQ(ierr);
1374   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1375   for (c = cStart; c < cEnd; ++c) {
1376     PetscScalar *x = NULL;
1377     PetscReal    elemDiff = 0.0;
1378     PetscInt     qc = 0;
1379 
1380     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1381     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1382 
1383     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1384       PetscFE          fe;
1385       void * const     ctx = ctxs ? ctxs[field] : NULL;
1386       PetscInt         Nb, Nc, q, fc;
1387 
1388       ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr);
1389       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1390       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1391       if (debug) {
1392         char title[1024];
1393         ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr);
1394         ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
1395       }
1396       for (q = 0; q < Nq; ++q) {
1397         PetscFEGeom qgeom;
1398 
1399         qgeom.dimEmbed = fegeom.dimEmbed;
1400         qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1401         qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1402         qgeom.detJ     = &fegeom.detJ[q];
1403         if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q);
1404         if (transform) {
1405           gcoords = &coords[coordDim*Nq];
1406           ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1407         } else {
1408           gcoords = &coords[coordDim*q];
1409         }
1410         ierr = (*funcs[field])(coordDim, time, gcoords, n, Nc, funcVal, ctx);
1411         if (ierr) {
1412           PetscErrorCode ierr2;
1413           ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1414           ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1415           ierr2 = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr2);
1416           CHKERRQ(ierr);
1417         }
1418         if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1419         ierr = PetscFEInterpolateGradient_Static(fe, 1, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);
1420         /* Overwrite with the dot product if the normal is given */
1421         if (n) {
1422           for (fc = 0; fc < Nc; ++fc) {
1423             PetscScalar sum = 0.0;
1424             PetscInt    d;
1425             for (d = 0; d < dim; ++d) sum += interpolant[fc*dim+d]*n[d];
1426             interpolant[fc] = sum;
1427           }
1428         }
1429         for (fc = 0; fc < Nc; ++fc) {
1430           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1431           if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    elem %D fieldDer %D,%D diff %g\n", c, field, fc, (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1432           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1433         }
1434       }
1435       fieldOffset += Nb;
1436       qc          += Nc;
1437     }
1438     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1439     if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);}
1440     localDiff += elemDiff;
1441   }
1442   ierr  = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr);
1443   ierr  = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1444   ierr  = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
1445   *diff = PetscSqrtReal(*diff);
1446   PetscFunctionReturn(0);
1447 }
1448 
1449 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
1450 {
1451   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
1452   DM               tdm;
1453   DMLabel          depthLabel;
1454   PetscSection     section;
1455   Vec              localX, tv;
1456   PetscReal       *localDiff;
1457   PetscInt         dim, depth, dE, Nf, f, Nds, s;
1458   PetscBool        transform;
1459   PetscErrorCode   ierr;
1460 
1461   PetscFunctionBegin;
1462   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1463   ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
1464   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1465   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1466   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1467   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1468   ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1469   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
1470   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
1471   ierr = DMLabelGetNumValues(depthLabel, &depth);CHKERRQ(ierr);
1472 
1473   ierr = VecSet(localX, 0.0);CHKERRQ(ierr);
1474   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1475   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1476   ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
1477   ierr = DMGetNumDS(dm, &Nds);CHKERRQ(ierr);
1478   ierr = PetscCalloc1(Nf, &localDiff);CHKERRQ(ierr);
1479   for (s = 0; s < Nds; ++s) {
1480     PetscDS          ds;
1481     DMLabel          label;
1482     IS               fieldIS, pointIS;
1483     const PetscInt  *fields, *points = NULL;
1484     PetscQuadrature  quad;
1485     const PetscReal *quadPoints, *quadWeights;
1486     PetscFEGeom      fegeom;
1487     PetscReal       *coords, *gcoords;
1488     PetscScalar     *funcVal, *interpolant;
1489     PetscBool        isHybrid;
1490     PetscInt         qNc, Nq, totNc, cStart = 0, cEnd, c, dsNf;
1491 
1492     ierr = DMGetRegionNumDS(dm, s, &label, &fieldIS, &ds);CHKERRQ(ierr);
1493     ierr = ISGetIndices(fieldIS, &fields);CHKERRQ(ierr);
1494     ierr = PetscDSGetHybrid(ds, &isHybrid);CHKERRQ(ierr);
1495     ierr = PetscDSGetNumFields(ds, &dsNf);CHKERRQ(ierr);
1496     ierr = PetscDSGetTotalComponents(ds, &totNc);CHKERRQ(ierr);
1497     ierr = PetscDSGetQuadrature(ds, &quad);CHKERRQ(ierr);
1498     ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1499     if ((qNc != 1) && (qNc != totNc)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, totNc);
1500     ierr = PetscCalloc6(totNc, &funcVal, totNc, &interpolant, dE*(Nq+1), &coords,Nq, &fegeom.detJ, dE*dE*Nq, &fegeom.J, dE*dE*Nq, &fegeom.invJ);CHKERRQ(ierr);
1501     if (!label) {
1502       ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1503     } else {
1504       ierr = DMLabelGetStratumIS(label, 1, &pointIS);CHKERRQ(ierr);
1505       ierr = ISGetLocalSize(pointIS, &cEnd);CHKERRQ(ierr);
1506       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1507     }
1508     for (c = cStart; c < cEnd; ++c) {
1509       const PetscInt cell = points ? points[c] : c;
1510       PetscScalar   *x    = NULL;
1511       PetscInt       qc   = 0, fOff = 0, dep, fStart = isHybrid ? dsNf-1 : 0;
1512 
1513       ierr = DMLabelGetValue(depthLabel, cell, &dep);CHKERRQ(ierr);
1514       if (dep != depth-1) continue;
1515       if (isHybrid) {
1516         const PetscInt *cone;
1517 
1518         ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
1519         ierr = DMPlexComputeCellGeometryFEM(dm, cone[0], quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1520       } else {
1521         ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1522       }
1523       ierr = DMPlexVecGetClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr);
1524       for (f = fStart; f < dsNf; ++f) {
1525         PetscObject  obj;
1526         PetscClassId id;
1527         void * const ctx = ctxs ? ctxs[fields[f]] : NULL;
1528         PetscInt     Nb, Nc, q, fc;
1529         PetscReal    elemDiff = 0.0;
1530 
1531         ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
1532         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1533         if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1534         else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1535         else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1536         if (debug) {
1537           char title[1024];
1538           ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", fields[f]);CHKERRQ(ierr);
1539           ierr = DMPrintCellVector(cell, title, Nb, &x[fOff]);CHKERRQ(ierr);
1540         }
1541         for (q = 0; q < Nq; ++q) {
1542           PetscFEGeom qgeom;
1543 
1544           qgeom.dimEmbed = fegeom.dimEmbed;
1545           qgeom.J        = &fegeom.J[q*dE*dE];
1546           qgeom.invJ     = &fegeom.invJ[q*dE*dE];
1547           qgeom.detJ     = &fegeom.detJ[q];
1548           if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for cell %D, quadrature point %D", (double)fegeom.detJ[q], cell, q);
1549           if (transform) {
1550             gcoords = &coords[dE*Nq];
1551             ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[dE*q], PETSC_TRUE, dE, &coords[dE*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1552           } else {
1553             gcoords = &coords[dE*q];
1554           }
1555           ierr = (*funcs[fields[f]])(dE, time, gcoords, Nc, funcVal, ctx);
1556           if (ierr) {
1557             PetscErrorCode ierr2;
1558             ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr2);
1559             ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1560             ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1561             CHKERRQ(ierr);
1562           }
1563           if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[dE*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1564           /* Call once for each face, except for lagrange field */
1565           if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fOff], &qgeom, q, interpolant);CHKERRQ(ierr);}
1566           else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fOff], q, interpolant);CHKERRQ(ierr);}
1567           else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1568           for (fc = 0; fc < Nc; ++fc) {
1569             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1570             if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    cell %D field %D,%D point %g %g %g diff %g\n", cell, fields[f], fc, (double)(dE > 0 ? coords[dE*q] : 0.), (double)(dE > 1 ? coords[dE*q+1] : 0.),(double)(dE > 2 ? coords[dE*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1571             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1572           }
1573         }
1574         fOff += Nb;
1575         qc   += Nc;
1576         localDiff[fields[f]] += elemDiff;
1577         if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  cell %D field %D cum diff %g\n", cell, fields[f], (double)localDiff[fields[f]]);CHKERRQ(ierr);}
1578       }
1579       ierr = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr);
1580     }
1581     if (label) {
1582       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1583       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1584     }
1585     ierr = ISRestoreIndices(fieldIS, &fields);CHKERRQ(ierr);
1586     ierr = PetscFree6(funcVal, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ);CHKERRQ(ierr);
1587   }
1588   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1589   ierr = MPIU_Allreduce(localDiff, diff, Nf, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
1590   ierr = PetscFree(localDiff);CHKERRQ(ierr);
1591   for (f = 0; f < Nf; ++f) diff[f] = PetscSqrtReal(diff[f]);
1592   PetscFunctionReturn(0);
1593 }
1594 
1595 /*@C
1596   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.
1597 
1598   Collective on dm
1599 
1600   Input Parameters:
1601 + dm    - The DM
1602 . time  - The time
1603 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation
1604 . ctxs  - Optional array of contexts to pass to each function, or NULL.
1605 - X     - The coefficient vector u_h
1606 
1607   Output Parameter:
1608 . D - A Vec which holds the difference ||u - u_h||_2 for each cell
1609 
1610   Level: developer
1611 
1612 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1613 @*/
1614 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D)
1615 {
1616   PetscSection     section;
1617   PetscQuadrature  quad;
1618   Vec              localX;
1619   PetscFEGeom      fegeom;
1620   PetscScalar     *funcVal, *interpolant;
1621   PetscReal       *coords;
1622   const PetscReal *quadPoints, *quadWeights;
1623   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, c, field, fieldOffset;
1624   PetscErrorCode   ierr;
1625 
1626   PetscFunctionBegin;
1627   ierr = VecSet(D, 0.0);CHKERRQ(ierr);
1628   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1629   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1630   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1631   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1632   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1633   ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
1634   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1635   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1636   for (field = 0; field < numFields; ++field) {
1637     PetscObject  obj;
1638     PetscClassId id;
1639     PetscInt     Nc;
1640 
1641     ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1642     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1643     if (id == PETSCFE_CLASSID) {
1644       PetscFE fe = (PetscFE) obj;
1645 
1646       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1647       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1648     } else if (id == PETSCFV_CLASSID) {
1649       PetscFV fv = (PetscFV) obj;
1650 
1651       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1652       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1653     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1654     numComponents += Nc;
1655   }
1656   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1657   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1658   ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1659   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1660   for (c = cStart; c < cEnd; ++c) {
1661     PetscScalar *x = NULL;
1662     PetscScalar  elemDiff = 0.0;
1663     PetscInt     qc = 0;
1664 
1665     ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1666     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1667 
1668     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1669       PetscObject  obj;
1670       PetscClassId id;
1671       void * const ctx = ctxs ? ctxs[field] : NULL;
1672       PetscInt     Nb, Nc, q, fc;
1673 
1674       ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1675       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1676       if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1677       else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1678       else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1679       if (funcs[field]) {
1680         for (q = 0; q < Nq; ++q) {
1681           PetscFEGeom qgeom;
1682 
1683           qgeom.dimEmbed = fegeom.dimEmbed;
1684           qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1685           qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1686           qgeom.detJ     = &fegeom.detJ[q];
1687           if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q);
1688           ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx);
1689           if (ierr) {
1690             PetscErrorCode ierr2;
1691             ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1692             ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1693             ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1694             CHKERRQ(ierr);
1695           }
1696           if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1697           else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1698           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1699           for (fc = 0; fc < Nc; ++fc) {
1700             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1701             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1702           }
1703         }
1704       }
1705       fieldOffset += Nb;
1706       qc          += Nc;
1707     }
1708     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1709     ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr);
1710   }
1711   ierr = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1712   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1713   ierr = VecSqrtAbs(D);CHKERRQ(ierr);
1714   PetscFunctionReturn(0);
1715 }
1716 
1717 /*@C
1718   DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec.
1719 
1720   Collective on dm
1721 
1722   Input Parameters:
1723 + dm - The DM
1724 - LocX  - The coefficient vector u_h
1725 
1726   Output Parameter:
1727 . locC - A Vec which holds the Clement interpolant of the gradient
1728 
1729   Notes:
1730     Add citation to (Clement, 1975) and definition of the interpolant
1731   \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
1732 
1733   Level: developer
1734 
1735 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1736 @*/
1737 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC)
1738 {
1739   DM_Plex         *mesh  = (DM_Plex *) dm->data;
1740   PetscInt         debug = mesh->printFEM;
1741   DM               dmC;
1742   PetscSection     section;
1743   PetscQuadrature  quad;
1744   PetscScalar     *interpolant, *gradsum;
1745   PetscFEGeom      fegeom;
1746   PetscReal       *coords;
1747   const PetscReal *quadPoints, *quadWeights;
1748   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, vStart, vEnd, v, field, fieldOffset;
1749   PetscErrorCode   ierr;
1750 
1751   PetscFunctionBegin;
1752   ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr);
1753   ierr = VecSet(locC, 0.0);CHKERRQ(ierr);
1754   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1755   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1756   fegeom.dimEmbed = coordDim;
1757   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1758   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1759   for (field = 0; field < numFields; ++field) {
1760     PetscObject  obj;
1761     PetscClassId id;
1762     PetscInt     Nc;
1763 
1764     ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1765     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1766     if (id == PETSCFE_CLASSID) {
1767       PetscFE fe = (PetscFE) obj;
1768 
1769       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1770       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1771     } else if (id == PETSCFV_CLASSID) {
1772       PetscFV fv = (PetscFV) obj;
1773 
1774       ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1775       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1776     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1777     numComponents += Nc;
1778   }
1779   ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1780   if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1781   ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1782   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
1783   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1784   for (v = vStart; v < vEnd; ++v) {
1785     PetscScalar volsum = 0.0;
1786     PetscInt   *star = NULL;
1787     PetscInt    starSize, st, d, fc;
1788 
1789     ierr = PetscArrayzero(gradsum, coordDim*numComponents);CHKERRQ(ierr);
1790     ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1791     for (st = 0; st < starSize*2; st += 2) {
1792       const PetscInt cell = star[st];
1793       PetscScalar   *grad = &gradsum[coordDim*numComponents];
1794       PetscScalar   *x    = NULL;
1795       PetscReal      vol  = 0.0;
1796 
1797       if ((cell < cStart) || (cell >= cEnd)) continue;
1798       ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1799       ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1800       for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1801         PetscObject  obj;
1802         PetscClassId id;
1803         PetscInt     Nb, Nc, q, qc = 0;
1804 
1805         ierr = PetscArrayzero(grad, coordDim*numComponents);CHKERRQ(ierr);
1806         ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1807         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1808         if (id == PETSCFE_CLASSID)      {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1809         else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1810         else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1811         for (q = 0; q < Nq; ++q) {
1812           PetscFEGeom qgeom;
1813 
1814           qgeom.dimEmbed = fegeom.dimEmbed;
1815           qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1816           qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1817           qgeom.detJ     = &fegeom.detJ[q];
1818           if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], cell, q);
1819           if (ierr) {
1820             PetscErrorCode ierr2;
1821             ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2);
1822             ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2);
1823             ierr2 = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1824             CHKERRQ(ierr);
1825           }
1826           if (id == PETSCFE_CLASSID)      {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, 1, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1827           else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1828           for (fc = 0; fc < Nc; ++fc) {
1829             const PetscReal wt = quadWeights[q*qNc+qc+fc];
1830 
1831             for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*fegeom.detJ[q];
1832           }
1833           vol += quadWeights[q*qNc]*fegeom.detJ[q];
1834         }
1835         fieldOffset += Nb;
1836         qc          += Nc;
1837       }
1838       ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1839       for (fc = 0; fc < numComponents; ++fc) {
1840         for (d = 0; d < coordDim; ++d) {
1841           gradsum[fc*coordDim+d] += grad[fc*coordDim+d];
1842         }
1843       }
1844       volsum += vol;
1845       if (debug) {
1846         ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr);
1847         for (fc = 0; fc < numComponents; ++fc) {
1848           for (d = 0; d < coordDim; ++d) {
1849             if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);}
1850             ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr);
1851           }
1852         }
1853         ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr);
1854       }
1855     }
1856     for (fc = 0; fc < numComponents; ++fc) {
1857       for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum;
1858     }
1859     ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1860     ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr);
1861   }
1862   ierr = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1863   PetscFunctionReturn(0);
1864 }
1865 
1866 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user)
1867 {
1868   DM                 dmAux = NULL;
1869   PetscDS            prob,    probAux = NULL;
1870   PetscSection       section, sectionAux;
1871   Vec                locX,    locA;
1872   PetscInt           dim, numCells = cEnd - cStart, c, f;
1873   PetscBool          useFVM = PETSC_FALSE;
1874   /* DS */
1875   PetscInt           Nf,    totDim,    *uOff, *uOff_x, numConstants;
1876   PetscInt           NfAux, totDimAux, *aOff;
1877   PetscScalar       *u, *a;
1878   const PetscScalar *constants;
1879   /* Geometry */
1880   PetscFEGeom       *cgeomFEM;
1881   DM                 dmGrad;
1882   PetscQuadrature    affineQuad = NULL;
1883   Vec                cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL;
1884   PetscFVCellGeom   *cgeomFVM;
1885   const PetscScalar *lgrad;
1886   PetscInt           maxDegree;
1887   DMField            coordField;
1888   IS                 cellIS;
1889   PetscErrorCode     ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1893   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1894   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1895   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1896   /* Determine which discretizations we have */
1897   for (f = 0; f < Nf; ++f) {
1898     PetscObject  obj;
1899     PetscClassId id;
1900 
1901     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1902     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1903     if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
1904   }
1905   /* Get local solution with boundary values */
1906   ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
1907   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
1908   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1909   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1910   /* Read DS information */
1911   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1912   ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
1913   ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
1914   ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr);
1915   ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
1916   /* Read Auxiliary DS information */
1917   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
1918   if (locA) {
1919     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
1920     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1921     ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
1922     ierr = DMGetLocalSection(dmAux, &sectionAux);CHKERRQ(ierr);
1923     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1924     ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
1925   }
1926   /* Allocate data  arrays */
1927   ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr);
1928   if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
1929   /* Read out geometry */
1930   ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr);
1931   ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
1932   if (maxDegree <= 1) {
1933     ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
1934     if (affineQuad) {
1935       ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
1936     }
1937   }
1938   if (useFVM) {
1939     PetscFV   fv = NULL;
1940     Vec       grad;
1941     PetscInt  fStart, fEnd;
1942     PetscBool compGrad;
1943 
1944     for (f = 0; f < Nf; ++f) {
1945       PetscObject  obj;
1946       PetscClassId id;
1947 
1948       ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1949       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1950       if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
1951     }
1952     ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr);
1953     ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr);
1954     ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr);
1955     ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr);
1956     ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr);
1957     ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1958     /* Reconstruct and limit cell gradients */
1959     ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1960     ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1961     ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
1962     /* Communicate gradient values */
1963     ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
1964     ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1965     ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1966     ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1967     /* Handle non-essential (e.g. outflow) boundary values */
1968     ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
1969     ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1970   }
1971   /* Read out data from inputs */
1972   for (c = cStart; c < cEnd; ++c) {
1973     PetscScalar *x = NULL;
1974     PetscInt     i;
1975 
1976     ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1977     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
1978     ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1979     if (dmAux) {
1980       ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1981       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
1982       ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1983     }
1984   }
1985   /* Do integration for each field */
1986   for (f = 0; f < Nf; ++f) {
1987     PetscObject  obj;
1988     PetscClassId id;
1989     PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
1990 
1991     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1992     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1993     if (id == PETSCFE_CLASSID) {
1994       PetscFE         fe = (PetscFE) obj;
1995       PetscQuadrature q;
1996       PetscFEGeom     *chunkGeom = NULL;
1997       PetscInt        Nq, Nb;
1998 
1999       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2000       ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
2001       ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2002       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2003       blockSize = Nb*Nq;
2004       batchSize = numBlocks * blockSize;
2005       ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2006       numChunks = numCells / (numBatches*batchSize);
2007       Ne        = numChunks*numBatches*batchSize;
2008       Nr        = numCells % (numBatches*batchSize);
2009       offset    = numCells - Nr;
2010       if (!affineQuad) {
2011         ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
2012       }
2013       ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
2014       ierr = PetscFEIntegrate(prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr);
2015       ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2016       ierr = PetscFEIntegrate(prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr);
2017       ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2018       if (!affineQuad) {
2019         ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
2020       }
2021     } else if (id == PETSCFV_CLASSID) {
2022       PetscInt       foff;
2023       PetscPointFunc obj_func;
2024       PetscScalar    lint;
2025 
2026       ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr);
2027       ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
2028       if (obj_func) {
2029         for (c = 0; c < numCells; ++c) {
2030           PetscScalar *u_x;
2031 
2032           ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr);
2033           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);
2034           cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume;
2035         }
2036       }
2037     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
2038   }
2039   /* Cleanup data arrays */
2040   if (useFVM) {
2041     ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
2042     ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
2043     ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
2044     ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr);
2045     ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr);
2046     ierr = DMDestroy(&dmGrad);CHKERRQ(ierr);
2047   }
2048   if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);}
2049   ierr = PetscFree(u);CHKERRQ(ierr);
2050   /* Cleanup */
2051   if (affineQuad) {
2052     ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
2053   }
2054   ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
2055   ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
2056   ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
2057   PetscFunctionReturn(0);
2058 }
2059 
2060 /*@
2061   DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user
2062 
2063   Input Parameters:
2064 + dm - The mesh
2065 . X  - Global input vector
2066 - user - The user context
2067 
2068   Output Parameter:
2069 . integral - Integral for each field
2070 
2071   Level: developer
2072 
2073 .seealso: DMPlexSNESComputeResidualFEM()
2074 @*/
2075 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user)
2076 {
2077   DM_Plex       *mesh = (DM_Plex *) dm->data;
2078   PetscScalar   *cintegral, *lintegral;
2079   PetscInt       Nf, f, cellHeight, cStart, cEnd, cell;
2080   PetscErrorCode ierr;
2081 
2082   PetscFunctionBegin;
2083   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2084   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2085   PetscValidPointer(integral, 3);
2086   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2087   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2088   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
2089   ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2090   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2091   ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
2092   ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
2093   /* Sum up values */
2094   for (cell = cStart; cell < cEnd; ++cell) {
2095     const PetscInt c = cell - cStart;
2096 
2097     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
2098     for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
2099   }
2100   ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRMPI(ierr);
2101   if (mesh->printFEM) {
2102     ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr);
2103     for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);}
2104     ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr);
2105   }
2106   ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr);
2107   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2108   PetscFunctionReturn(0);
2109 }
2110 
2111 /*@
2112   DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user
2113 
2114   Input Parameters:
2115 + dm - The mesh
2116 . X  - Global input vector
2117 - user - The user context
2118 
2119   Output Parameter:
2120 . integral - Cellwise integrals for each field
2121 
2122   Level: developer
2123 
2124 .seealso: DMPlexSNESComputeResidualFEM()
2125 @*/
2126 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user)
2127 {
2128   DM_Plex       *mesh = (DM_Plex *) dm->data;
2129   DM             dmF;
2130   PetscSection   sectionF;
2131   PetscScalar   *cintegral, *af;
2132   PetscInt       Nf, f, cellHeight, cStart, cEnd, cell;
2133   PetscErrorCode ierr;
2134 
2135   PetscFunctionBegin;
2136   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2137   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2138   PetscValidHeaderSpecific(F, VEC_CLASSID, 3);
2139   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2140   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2141   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
2142   ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2143   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2144   ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
2145   ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
2146   /* Put values in F*/
2147   ierr = VecGetDM(F, &dmF);CHKERRQ(ierr);
2148   ierr = DMGetLocalSection(dmF, &sectionF);CHKERRQ(ierr);
2149   ierr = VecGetArray(F, &af);CHKERRQ(ierr);
2150   for (cell = cStart; cell < cEnd; ++cell) {
2151     const PetscInt c = cell - cStart;
2152     PetscInt       dof, off;
2153 
2154     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
2155     ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr);
2156     ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr);
2157     if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf);
2158     for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f];
2159   }
2160   ierr = VecRestoreArray(F, &af);CHKERRQ(ierr);
2161   ierr = PetscFree(cintegral);CHKERRQ(ierr);
2162   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2163   PetscFunctionReturn(0);
2164 }
2165 
2166 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS,
2167                                                        void (*func)(PetscInt, PetscInt, PetscInt,
2168                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2169                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2170                                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2171                                                        PetscScalar *fintegral, void *user)
2172 {
2173   DM                 plex = NULL, plexA = NULL;
2174   DMEnclosureType    encAux;
2175   PetscDS            prob, probAux = NULL;
2176   PetscSection       section, sectionAux = NULL;
2177   Vec                locA = NULL;
2178   DMField            coordField;
2179   PetscInt           Nf,        totDim,        *uOff, *uOff_x;
2180   PetscInt           NfAux = 0, totDimAux = 0, *aOff = NULL;
2181   PetscScalar       *u, *a = NULL;
2182   const PetscScalar *constants;
2183   PetscInt           numConstants, f;
2184   PetscErrorCode     ierr;
2185 
2186   PetscFunctionBegin;
2187   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
2188   ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
2189   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
2190   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
2191   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
2192   /* Determine which discretizations we have */
2193   for (f = 0; f < Nf; ++f) {
2194     PetscObject  obj;
2195     PetscClassId id;
2196 
2197     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2198     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2199     if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f);
2200   }
2201   /* Read DS information */
2202   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2203   ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
2204   ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
2205   ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
2206   /* Read Auxiliary DS information */
2207   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
2208   if (locA) {
2209     DM dmAux;
2210 
2211     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
2212     ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
2213     ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
2214     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
2215     ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
2216     ierr = DMGetLocalSection(dmAux, &sectionAux);CHKERRQ(ierr);
2217     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
2218     ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
2219   }
2220   /* Integrate over points */
2221   {
2222     PetscFEGeom    *fgeom, *chunkGeom = NULL;
2223     PetscInt        maxDegree;
2224     PetscQuadrature qGeom = NULL;
2225     const PetscInt *points;
2226     PetscInt        numFaces, face, Nq, field;
2227     PetscInt        numChunks, chunkSize, chunk, Nr, offset;
2228 
2229     ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
2230     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
2231     ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
2232     ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr);
2233     for (field = 0; field < Nf; ++field) {
2234       PetscFE fe;
2235 
2236       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
2237       if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);}
2238       if (!qGeom) {
2239         ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
2240         ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
2241       }
2242       ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2243       ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
2244       for (face = 0; face < numFaces; ++face) {
2245         const PetscInt point = points[face], *support;
2246         PetscScalar    *x    = NULL;
2247         PetscInt       i;
2248 
2249         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
2250         ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
2251         for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
2252         ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
2253         if (locA) {
2254           PetscInt subp;
2255           ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
2256           ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
2257           for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
2258           ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
2259         }
2260       }
2261       /* Get blocking */
2262       {
2263         PetscQuadrature q;
2264         PetscInt        numBatches, batchSize, numBlocks, blockSize;
2265         PetscInt        Nq, Nb;
2266 
2267         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2268         ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
2269         ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2270         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2271         blockSize = Nb*Nq;
2272         batchSize = numBlocks * blockSize;
2273         chunkSize = numBatches*batchSize;
2274         ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2275         numChunks = numFaces / chunkSize;
2276         Nr        = numFaces % chunkSize;
2277         offset    = numFaces - Nr;
2278       }
2279       /* Do integration for each field */
2280       for (chunk = 0; chunk < numChunks; ++chunk) {
2281         ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr);
2282         ierr = PetscFEIntegrateBd(prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr);
2283         ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr);
2284       }
2285       ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
2286       ierr = PetscFEIntegrateBd(prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr);
2287       ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
2288       /* Cleanup data arrays */
2289       ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
2290       ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
2291       ierr = PetscFree2(u, a);CHKERRQ(ierr);
2292       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
2293     }
2294   }
2295   if (plex)  {ierr = DMDestroy(&plex);CHKERRQ(ierr);}
2296   if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
2297   PetscFunctionReturn(0);
2298 }
2299 
2300 /*@
2301   DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user
2302 
2303   Input Parameters:
2304 + dm      - The mesh
2305 . X       - Global input vector
2306 . label   - The boundary DMLabel
2307 . numVals - The number of label values to use, or PETSC_DETERMINE for all values
2308 . vals    - The label values to use, or PETSC_NULL for all values
2309 . func    = The function to integrate along the boundary
2310 - user    - The user context
2311 
2312   Output Parameter:
2313 . integral - Integral for each field
2314 
2315   Level: developer
2316 
2317 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM()
2318 @*/
2319 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[],
2320                                        void (*func)(PetscInt, PetscInt, PetscInt,
2321                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2322                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2323                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2324                                        PetscScalar *integral, void *user)
2325 {
2326   Vec            locX;
2327   PetscSection   section;
2328   DMLabel        depthLabel;
2329   IS             facetIS;
2330   PetscInt       dim, Nf, f, v;
2331   PetscErrorCode ierr;
2332 
2333   PetscFunctionBegin;
2334   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2335   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2336   PetscValidPointer(label, 3);
2337   if (vals) PetscValidPointer(vals, 5);
2338   PetscValidPointer(integral, 6);
2339   ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2340   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
2341   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2342   ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
2343   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
2344   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
2345   /* Get local solution with boundary values */
2346   ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
2347   ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
2348   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
2349   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
2350   /* Loop over label values */
2351   ierr = PetscArrayzero(integral, Nf);CHKERRQ(ierr);
2352   for (v = 0; v < numVals; ++v) {
2353     IS           pointIS;
2354     PetscInt     numFaces, face;
2355     PetscScalar *fintegral;
2356 
2357     ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr);
2358     if (!pointIS) continue; /* No points with that id on this process */
2359     {
2360       IS isectIS;
2361 
2362       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
2363       ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr);
2364       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2365       pointIS = isectIS;
2366     }
2367     ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
2368     ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr);
2369     ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr);
2370     /* Sum point contributions into integral */
2371     for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f];
2372     ierr = PetscFree(fintegral);CHKERRQ(ierr);
2373     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2374   }
2375   ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
2376   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
2377   ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2378   PetscFunctionReturn(0);
2379 }
2380 
2381 /*@
2382   DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to a uniformly refined DM.
2383 
2384   Input Parameters:
2385 + dmc  - The coarse mesh
2386 . dmf  - The fine mesh
2387 . isRefined - Flag indicating regular refinement, rather than the same topology
2388 - user - The user context
2389 
2390   Output Parameter:
2391 . In  - The interpolation matrix
2392 
2393   Level: developer
2394 
2395 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2396 @*/
2397 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, PetscBool isRefined, Mat In, void *user)
2398 {
2399   DM_Plex          *mesh  = (DM_Plex *) dmc->data;
2400   const char       *name  = "Interpolator";
2401   PetscFE          *feRef;
2402   PetscFV          *fvRef;
2403   PetscSection      fsection, fglobalSection;
2404   PetscSection      csection, cglobalSection;
2405   PetscScalar      *elemMat;
2406   PetscInt          dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, c;
2407   PetscInt          cTotDim=0, rTotDim = 0;
2408   PetscErrorCode    ierr;
2409 
2410   PetscFunctionBegin;
2411   ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2412   ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
2413   ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2414   ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
2415   ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2416   ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
2417   ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
2418   ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
2419   ierr = PetscCalloc2(Nf, &feRef, Nf, &fvRef);CHKERRQ(ierr);
2420   for (f = 0; f < Nf; ++f) {
2421     PetscObject  obj, objc;
2422     PetscClassId id, idc;
2423     PetscInt     rNb = 0, Nc = 0, cNb = 0;
2424 
2425     ierr = DMGetField(dmf, f, NULL, &obj);CHKERRQ(ierr);
2426     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2427     if (id == PETSCFE_CLASSID) {
2428       PetscFE fe = (PetscFE) obj;
2429 
2430       if (isRefined) {
2431         ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
2432       } else {
2433         ierr = PetscObjectReference((PetscObject) fe);CHKERRQ(ierr);
2434         feRef[f] = fe;
2435       }
2436       ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr);
2437       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2438     } else if (id == PETSCFV_CLASSID) {
2439       PetscFV        fv = (PetscFV) obj;
2440       PetscDualSpace Q;
2441 
2442       if (isRefined) {
2443         ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
2444       } else {
2445         ierr = PetscObjectReference((PetscObject) fv);CHKERRQ(ierr);
2446         fvRef[f] = fv;
2447       }
2448       ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
2449       ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr);
2450       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2451       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
2452     }
2453     ierr = DMGetField(dmc, f, NULL, &objc);CHKERRQ(ierr);
2454     ierr = PetscObjectGetClassId(objc, &idc);CHKERRQ(ierr);
2455     if (idc == PETSCFE_CLASSID) {
2456       PetscFE fe = (PetscFE) objc;
2457 
2458       ierr = PetscFEGetDimension(fe, &cNb);CHKERRQ(ierr);
2459     } else if (id == PETSCFV_CLASSID) {
2460       PetscFV        fv = (PetscFV) obj;
2461       PetscDualSpace Q;
2462 
2463       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2464       ierr = PetscDualSpaceGetDimension(Q, &cNb);CHKERRQ(ierr);
2465     }
2466     rTotDim += rNb;
2467     cTotDim += cNb;
2468   }
2469   ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr);
2470   ierr = PetscArrayzero(elemMat, rTotDim*cTotDim);CHKERRQ(ierr);
2471   for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) {
2472     PetscDualSpace   Qref;
2473     PetscQuadrature  f;
2474     const PetscReal *qpoints, *qweights;
2475     PetscReal       *points;
2476     PetscInt         npoints = 0, Nc, Np, fpdim, i, k, p, d;
2477 
2478     /* Compose points from all dual basis functionals */
2479     if (feRef[fieldI]) {
2480       ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr);
2481       ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr);
2482     } else {
2483       ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr);
2484       ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr);
2485     }
2486     ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr);
2487     for (i = 0; i < fpdim; ++i) {
2488       ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2489       ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr);
2490       npoints += Np;
2491     }
2492     ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr);
2493     for (i = 0, k = 0; i < fpdim; ++i) {
2494       ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2495       ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
2496       for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d];
2497     }
2498 
2499     for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) {
2500       PetscObject  obj;
2501       PetscClassId id;
2502       PetscInt     NcJ = 0, cpdim = 0, j, qNc;
2503 
2504       ierr = DMGetField(dmc, fieldJ, NULL, &obj);CHKERRQ(ierr);
2505       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2506       if (id == PETSCFE_CLASSID) {
2507         PetscFE           fe = (PetscFE) obj;
2508         PetscTabulation T  = NULL;
2509 
2510         /* Evaluate basis at points */
2511         ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr);
2512         ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2513         /* For now, fields only interpolate themselves */
2514         if (fieldI == fieldJ) {
2515           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);
2516           ierr = PetscFECreateTabulation(fe, 1, npoints, points, 0, &T);CHKERRQ(ierr);
2517           for (i = 0, k = 0; i < fpdim; ++i) {
2518             ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2519             ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
2520             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);
2521             for (p = 0; p < Np; ++p, ++k) {
2522               for (j = 0; j < cpdim; ++j) {
2523                 /*
2524                    cTotDim:            Total columns in element interpolation matrix, sum of number of dual basis functionals in each field
2525                    offsetI, offsetJ:   Offsets into the larger element interpolation matrix for different fields
2526                    fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals
2527                    qNC, Nc, Ncj, c:    Number of components in this field
2528                    Np, p:              Number of quad points in the fine grid functional i
2529                    k:                  i*Np + p, overall point number for the interpolation
2530                 */
2531                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += T->T[0][k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c];
2532               }
2533             }
2534           }
2535           ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);CHKERRQ(ierr);
2536         }
2537       } else if (id == PETSCFV_CLASSID) {
2538         PetscFV        fv = (PetscFV) obj;
2539 
2540         /* Evaluate constant function at points */
2541         ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr);
2542         cpdim = 1;
2543         /* For now, fields only interpolate themselves */
2544         if (fieldI == fieldJ) {
2545           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);
2546           for (i = 0, k = 0; i < fpdim; ++i) {
2547             ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2548             ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
2549             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);
2550             for (p = 0; p < Np; ++p, ++k) {
2551               for (j = 0; j < cpdim; ++j) {
2552                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c];
2553               }
2554             }
2555           }
2556         }
2557       }
2558       offsetJ += cpdim;
2559     }
2560     offsetI += fpdim;
2561     ierr = PetscFree(points);CHKERRQ(ierr);
2562   }
2563   if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);}
2564   /* Preallocate matrix */
2565   {
2566     Mat          preallocator;
2567     PetscScalar *vals;
2568     PetscInt    *cellCIndices, *cellFIndices;
2569     PetscInt     locRows, locCols, cell;
2570 
2571     ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr);
2572     ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr);
2573     ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr);
2574     ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
2575     ierr = MatSetUp(preallocator);CHKERRQ(ierr);
2576     ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr);
2577     for (cell = cStart; cell < cEnd; ++cell) {
2578       if (isRefined) {
2579         ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr);
2580         ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr);
2581       } else {
2582         ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, preallocator, cell, vals, INSERT_VALUES);CHKERRQ(ierr);
2583       }
2584     }
2585     ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr);
2586     ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2587     ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2588     ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr);
2589     ierr = MatDestroy(&preallocator);CHKERRQ(ierr);
2590   }
2591   /* Fill matrix */
2592   ierr = MatZeroEntries(In);CHKERRQ(ierr);
2593   for (c = cStart; c < cEnd; ++c) {
2594     if (isRefined) {
2595       ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2596     } else {
2597       ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2598     }
2599   }
2600   for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);}
2601   ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr);
2602   ierr = PetscFree(elemMat);CHKERRQ(ierr);
2603   ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2604   ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2605   if (mesh->printFEM) {
2606     ierr = PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name);CHKERRQ(ierr);
2607     ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr);
2608     ierr = MatView(In, NULL);CHKERRQ(ierr);
2609   }
2610   ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2611   PetscFunctionReturn(0);
2612 }
2613 
2614 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user)
2615 {
2616   SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness");
2617 }
2618 
2619 /*@
2620   DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM.
2621 
2622   Input Parameters:
2623 + dmf  - The fine mesh
2624 . dmc  - The coarse mesh
2625 - user - The user context
2626 
2627   Output Parameter:
2628 . In  - The interpolation matrix
2629 
2630   Level: developer
2631 
2632 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
2633 @*/
2634 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user)
2635 {
2636   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2637   const char    *name = "Interpolator";
2638   PetscDS        prob;
2639   PetscSection   fsection, csection, globalFSection, globalCSection;
2640   PetscHSetIJ    ht;
2641   PetscLayout    rLayout;
2642   PetscInt      *dnz, *onz;
2643   PetscInt       locRows, rStart, rEnd;
2644   PetscReal     *x, *v0, *J, *invJ, detJ;
2645   PetscReal     *v0c, *Jc, *invJc, detJc;
2646   PetscScalar   *elemMat;
2647   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2648   PetscErrorCode ierr;
2649 
2650   PetscFunctionBegin;
2651   ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2652   ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
2653   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2654   ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
2655   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2656   ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
2657   ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
2658   ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2659   ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
2660   ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2661   ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
2662   ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
2663   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2664   ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
2665 
2666   ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr);
2667   ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr);
2668   ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
2669   ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
2670   ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
2671   ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
2672   ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
2673   ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
2674   ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
2675   for (field = 0; field < Nf; ++field) {
2676     PetscObject      obj;
2677     PetscClassId     id;
2678     PetscDualSpace   Q = NULL;
2679     PetscQuadrature  f;
2680     const PetscReal *qpoints;
2681     PetscInt         Nc, Np, fpdim, i, d;
2682 
2683     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2684     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2685     if (id == PETSCFE_CLASSID) {
2686       PetscFE fe = (PetscFE) obj;
2687 
2688       ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
2689       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2690     } else if (id == PETSCFV_CLASSID) {
2691       PetscFV fv = (PetscFV) obj;
2692 
2693       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2694       Nc   = 1;
2695     }
2696     ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2697     /* For each fine grid cell */
2698     for (cell = cStart; cell < cEnd; ++cell) {
2699       PetscInt *findices,   *cindices;
2700       PetscInt  numFIndices, numCIndices;
2701 
2702       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2703       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2704       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2705       for (i = 0; i < fpdim; ++i) {
2706         Vec             pointVec;
2707         PetscScalar    *pV;
2708         PetscSF         coarseCellSF = NULL;
2709         const PetscSFNode *coarseCells;
2710         PetscInt        numCoarseCells, q, c;
2711 
2712         /* Get points from the dual basis functional quadrature */
2713         ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2714         ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
2715         ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2716         ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2717         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2718         for (q = 0; q < Np; ++q) {
2719           const PetscReal xi0[3] = {-1., -1., -1.};
2720 
2721           /* Transform point to real space */
2722           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2723           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2724         }
2725         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2726         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2727         /* OPT: Pack all quad points from fine cell */
2728         ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2729         ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2730         /* Update preallocation info */
2731         ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2732         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2733         {
2734           PetscHashIJKey key;
2735           PetscBool      missing;
2736 
2737           key.i = findices[i];
2738           if (key.i >= 0) {
2739             /* Get indices for coarse elements */
2740             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2741               ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2742               for (c = 0; c < numCIndices; ++c) {
2743                 key.j = cindices[c];
2744                 if (key.j < 0) continue;
2745                 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2746                 if (missing) {
2747                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2748                   else                                     ++onz[key.i-rStart];
2749                 }
2750               }
2751               ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2752             }
2753           }
2754         }
2755         ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2756         ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2757       }
2758       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2759     }
2760   }
2761   ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
2762   ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
2763   ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2764   ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
2765   for (field = 0; field < Nf; ++field) {
2766     PetscObject       obj;
2767     PetscClassId      id;
2768     PetscDualSpace    Q = NULL;
2769     PetscTabulation T = NULL;
2770     PetscQuadrature   f;
2771     const PetscReal  *qpoints, *qweights;
2772     PetscInt          Nc, qNc, Np, fpdim, i, d;
2773 
2774     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2775     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2776     if (id == PETSCFE_CLASSID) {
2777       PetscFE fe = (PetscFE) obj;
2778 
2779       ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
2780       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2781       ierr = PetscFECreateTabulation(fe, 1, 1, x, 0, &T);CHKERRQ(ierr);
2782     } else if (id == PETSCFV_CLASSID) {
2783       PetscFV fv = (PetscFV) obj;
2784 
2785       ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2786       Nc   = 1;
2787     } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %D",field);
2788     ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2789     /* For each fine grid cell */
2790     for (cell = cStart; cell < cEnd; ++cell) {
2791       PetscInt *findices,   *cindices;
2792       PetscInt  numFIndices, numCIndices;
2793 
2794       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2795       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2796       if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2797       for (i = 0; i < fpdim; ++i) {
2798         Vec             pointVec;
2799         PetscScalar    *pV;
2800         PetscSF         coarseCellSF = NULL;
2801         const PetscSFNode *coarseCells;
2802         PetscInt        numCoarseCells, cpdim, q, c, j;
2803 
2804         /* Get points from the dual basis functional quadrature */
2805         ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2806         ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr);
2807         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);
2808         ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2809         ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2810         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2811         for (q = 0; q < Np; ++q) {
2812           const PetscReal xi0[3] = {-1., -1., -1.};
2813 
2814           /* Transform point to real space */
2815           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2816           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2817         }
2818         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2819         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2820         /* OPT: Read this out from preallocation information */
2821         ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2822         /* Update preallocation info */
2823         ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2824         if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2825         ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2826         for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2827           PetscReal pVReal[3];
2828           const PetscReal xi0[3] = {-1., -1., -1.};
2829 
2830           ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2831           /* Transform points from real space to coarse reference space */
2832           ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
2833           for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2834           CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
2835 
2836           if (id == PETSCFE_CLASSID) {
2837             PetscFE fe = (PetscFE) obj;
2838 
2839             /* Evaluate coarse basis on contained point */
2840             ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2841             ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr);
2842             ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
2843             /* Get elemMat entries by multiplying by weight */
2844             for (j = 0; j < cpdim; ++j) {
2845               for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*qweights[ccell*qNc + c];
2846             }
2847           } else {
2848             cpdim = 1;
2849             for (j = 0; j < cpdim; ++j) {
2850               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c];
2851             }
2852           }
2853           /* Update interpolator */
2854           if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
2855           if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2856           ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2857           ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2858         }
2859         ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2860         ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2861         ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2862       }
2863       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2864     }
2865     if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
2866   }
2867   ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
2868   ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
2869   ierr = PetscFree(elemMat);CHKERRQ(ierr);
2870   ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2871   ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2872   ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2873   PetscFunctionReturn(0);
2874 }
2875 
2876 /*@
2877   DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM.
2878 
2879   Input Parameters:
2880 + dmf  - The fine mesh
2881 . dmc  - The coarse mesh
2882 - user - The user context
2883 
2884   Output Parameter:
2885 . mass  - The mass matrix
2886 
2887   Level: developer
2888 
2889 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2890 @*/
2891 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user)
2892 {
2893   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2894   const char    *name = "Mass Matrix";
2895   PetscDS        prob;
2896   PetscSection   fsection, csection, globalFSection, globalCSection;
2897   PetscHSetIJ    ht;
2898   PetscLayout    rLayout;
2899   PetscInt      *dnz, *onz;
2900   PetscInt       locRows, rStart, rEnd;
2901   PetscReal     *x, *v0, *J, *invJ, detJ;
2902   PetscReal     *v0c, *Jc, *invJc, detJc;
2903   PetscScalar   *elemMat;
2904   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2905   PetscErrorCode ierr;
2906 
2907   PetscFunctionBegin;
2908   ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
2909   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2910   ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
2911   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2912   ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
2913   ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
2914   ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2915   ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
2916   ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2917   ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
2918   ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
2919   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2920   ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
2921 
2922   ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr);
2923   ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr);
2924   ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
2925   ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
2926   ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
2927   ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
2928   ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
2929   ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
2930   ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
2931   for (field = 0; field < Nf; ++field) {
2932     PetscObject      obj;
2933     PetscClassId     id;
2934     PetscQuadrature  quad;
2935     const PetscReal *qpoints;
2936     PetscInt         Nq, Nc, i, d;
2937 
2938     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2939     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2940     if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);}
2941     else                       {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);}
2942     ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr);
2943     /* For each fine grid cell */
2944     for (cell = cStart; cell < cEnd; ++cell) {
2945       Vec                pointVec;
2946       PetscScalar       *pV;
2947       PetscSF            coarseCellSF = NULL;
2948       const PetscSFNode *coarseCells;
2949       PetscInt           numCoarseCells, q, c;
2950       PetscInt          *findices,   *cindices;
2951       PetscInt           numFIndices, numCIndices;
2952 
2953       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2954       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2955       /* Get points from the quadrature */
2956       ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
2957       ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2958       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2959       for (q = 0; q < Nq; ++q) {
2960         const PetscReal xi0[3] = {-1., -1., -1.};
2961 
2962         /* Transform point to real space */
2963         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2964         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2965       }
2966       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2967       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2968       ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2969       ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2970       /* Update preallocation info */
2971       ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2972       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2973       {
2974         PetscHashIJKey key;
2975         PetscBool      missing;
2976 
2977         for (i = 0; i < numFIndices; ++i) {
2978           key.i = findices[i];
2979           if (key.i >= 0) {
2980             /* Get indices for coarse elements */
2981             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2982               ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2983               for (c = 0; c < numCIndices; ++c) {
2984                 key.j = cindices[c];
2985                 if (key.j < 0) continue;
2986                 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2987                 if (missing) {
2988                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2989                   else                                     ++onz[key.i-rStart];
2990                 }
2991               }
2992               ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2993             }
2994           }
2995         }
2996       }
2997       ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2998       ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2999       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
3000     }
3001   }
3002   ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
3003   ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
3004   ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3005   ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
3006   for (field = 0; field < Nf; ++field) {
3007     PetscObject       obj;
3008     PetscClassId      id;
3009     PetscTabulation T, Tfine;
3010     PetscQuadrature   quad;
3011     const PetscReal  *qpoints, *qweights;
3012     PetscInt          Nq, Nc, i, d;
3013 
3014     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
3015     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3016     if (id == PETSCFE_CLASSID) {
3017       ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);
3018       ierr = PetscFEGetCellTabulation((PetscFE) obj, 1, &Tfine);CHKERRQ(ierr);
3019       ierr = PetscFECreateTabulation((PetscFE) obj, 1, 1, x, 0, &T);CHKERRQ(ierr);
3020     } else {
3021       ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);
3022     }
3023     ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr);
3024     /* For each fine grid cell */
3025     for (cell = cStart; cell < cEnd; ++cell) {
3026       Vec                pointVec;
3027       PetscScalar       *pV;
3028       PetscSF            coarseCellSF = NULL;
3029       const PetscSFNode *coarseCells;
3030       PetscInt           numCoarseCells, cpdim, q, c, j;
3031       PetscInt          *findices,   *cindices;
3032       PetscInt           numFIndices, numCIndices;
3033 
3034       ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
3035       ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
3036       /* Get points from the quadrature */
3037       ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
3038       ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
3039       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
3040       for (q = 0; q < Nq; ++q) {
3041         const PetscReal xi0[3] = {-1., -1., -1.};
3042 
3043         /* Transform point to real space */
3044         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
3045         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
3046       }
3047       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
3048       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3049       ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
3050       /* Update matrix */
3051       ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
3052       if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
3053       ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
3054       for (ccell = 0; ccell < numCoarseCells; ++ccell) {
3055         PetscReal pVReal[3];
3056         const PetscReal xi0[3] = {-1., -1., -1.};
3057 
3058 
3059         ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
3060         /* Transform points from real space to coarse reference space */
3061         ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
3062         for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
3063         CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
3064 
3065         if (id == PETSCFE_CLASSID) {
3066           PetscFE fe = (PetscFE) obj;
3067 
3068           /* Evaluate coarse basis on contained point */
3069           ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
3070           ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr);
3071           /* Get elemMat entries by multiplying by weight */
3072           for (i = 0; i < numFIndices; ++i) {
3073             ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
3074             for (j = 0; j < cpdim; ++j) {
3075               for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*Tfine->T[0][(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ;
3076             }
3077             /* Update interpolator */
3078             if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
3079             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3080             ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
3081           }
3082         } else {
3083           cpdim = 1;
3084           for (i = 0; i < numFIndices; ++i) {
3085             ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
3086             for (j = 0; j < cpdim; ++j) {
3087               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ;
3088             }
3089             /* Update interpolator */
3090             if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
3091             ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %D %D Nf: %D %D Nc: %D %D\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr);
3092             if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3093             ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
3094           }
3095         }
3096         ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
3097       }
3098       ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
3099       ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
3100       ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
3101       ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
3102     }
3103     if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
3104   }
3105   ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
3106   ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
3107   ierr = PetscFree(elemMat);CHKERRQ(ierr);
3108   ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3109   ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3110   PetscFunctionReturn(0);
3111 }
3112 
3113 /*@
3114   DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns
3115 
3116   Input Parameters:
3117 + dmc  - The coarse mesh
3118 - dmf  - The fine mesh
3119 - user - The user context
3120 
3121   Output Parameter:
3122 . sc   - The mapping
3123 
3124   Level: developer
3125 
3126 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
3127 @*/
3128 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user)
3129 {
3130   PetscDS        prob;
3131   PetscFE       *feRef;
3132   PetscFV       *fvRef;
3133   Vec            fv, cv;
3134   IS             fis, cis;
3135   PetscSection   fsection, fglobalSection, csection, cglobalSection;
3136   PetscInt      *cmap, *cellCIndices, *cellFIndices, *cindices, *findices;
3137   PetscInt       cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, c, dim, d, startC, endC, offsetC, offsetF, m;
3138   PetscBool     *needAvg;
3139   PetscErrorCode ierr;
3140 
3141   PetscFunctionBegin;
3142   ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
3143   ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
3144   ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
3145   ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
3146   ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
3147   ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
3148   ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
3149   ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
3150   ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
3151   ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr);
3152   for (f = 0; f < Nf; ++f) {
3153     PetscObject  obj;
3154     PetscClassId id;
3155     PetscInt     fNb = 0, Nc = 0;
3156 
3157     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3158     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3159     if (id == PETSCFE_CLASSID) {
3160       PetscFE    fe = (PetscFE) obj;
3161       PetscSpace sp;
3162       PetscInt   maxDegree;
3163 
3164       ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
3165       ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr);
3166       ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
3167       ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr);
3168       ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr);
3169       if (!maxDegree) needAvg[f] = PETSC_TRUE;
3170     } else if (id == PETSCFV_CLASSID) {
3171       PetscFV        fv = (PetscFV) obj;
3172       PetscDualSpace Q;
3173 
3174       ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
3175       ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
3176       ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr);
3177       ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
3178       needAvg[f] = PETSC_TRUE;
3179     }
3180     fTotDim += fNb;
3181   }
3182   ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr);
3183   ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr);
3184   for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) {
3185     PetscFE        feC;
3186     PetscFV        fvC;
3187     PetscDualSpace QF, QC;
3188     PetscInt       order = -1, NcF, NcC, fpdim, cpdim;
3189 
3190     if (feRef[field]) {
3191       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr);
3192       ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr);
3193       ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr);
3194       ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr);
3195       ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr);
3196       ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
3197       ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr);
3198       ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
3199     } else {
3200       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr);
3201       ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr);
3202       ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr);
3203       ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr);
3204       ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
3205       ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr);
3206       ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
3207     }
3208     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);
3209     for (c = 0; c < cpdim; ++c) {
3210       PetscQuadrature  cfunc;
3211       const PetscReal *cqpoints, *cqweights;
3212       PetscInt         NqcC, NpC;
3213       PetscBool        found = PETSC_FALSE;
3214 
3215       ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr);
3216       ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr);
3217       if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcC, NcC);
3218       if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments");
3219       for (f = 0; f < fpdim; ++f) {
3220         PetscQuadrature  ffunc;
3221         const PetscReal *fqpoints, *fqweights;
3222         PetscReal        sum = 0.0;
3223         PetscInt         NqcF, NpF;
3224 
3225         ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr);
3226         ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr);
3227         if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcF, NcF);
3228         if (NpC != NpF) continue;
3229         for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]);
3230         if (sum > 1.0e-9) continue;
3231         for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]);
3232         if (sum < 1.0e-9) continue;
3233         cmap[offsetC+c] = offsetF+f;
3234         found = PETSC_TRUE;
3235         break;
3236       }
3237       if (!found) {
3238         /* TODO We really want the average here, but some asshole put VecScatter in the interface */
3239         if (fvRef[field] || (feRef[field] && order == 0)) {
3240           cmap[offsetC+c] = offsetF+0;
3241         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection");
3242       }
3243     }
3244     offsetC += cpdim;
3245     offsetF += fpdim;
3246   }
3247   for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);}
3248   ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr);
3249 
3250   ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr);
3251   ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr);
3252   ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr);
3253   ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr);
3254   ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr);
3255   ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr);
3256   ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr);
3257   for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
3258   for (c = cStart; c < cEnd; ++c) {
3259     ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr);
3260     for (d = 0; d < cTotDim; ++d) {
3261       if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue;
3262       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]]);
3263       cindices[cellCIndices[d]-startC] = cellCIndices[d];
3264       findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]];
3265     }
3266   }
3267   ierr = PetscFree(cmap);CHKERRQ(ierr);
3268   ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr);
3269 
3270   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
3271   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
3272   ierr = VecScatterCreate(cv, cis, fv, fis, sc);CHKERRQ(ierr);
3273   ierr = ISDestroy(&cis);CHKERRQ(ierr);
3274   ierr = ISDestroy(&fis);CHKERRQ(ierr);
3275   ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr);
3276   ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr);
3277   ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
3278   PetscFunctionReturn(0);
3279 }
3280 
3281 /*@C
3282   DMPlexGetCellFields - Retrieve the field values values for a chunk of cells
3283 
3284   Input Parameters:
3285 + dm     - The DM
3286 . cellIS - The cells to include
3287 . locX   - A local vector with the solution fields
3288 . locX_t - A local vector with solution field time derivatives, or NULL
3289 - locA   - A local vector with auxiliary fields, or NULL
3290 
3291   Output Parameters:
3292 + u   - The field coefficients
3293 . u_t - The fields derivative coefficients
3294 - a   - The auxiliary field coefficients
3295 
3296   Level: developer
3297 
3298 .seealso: DMPlexGetFaceFields()
3299 @*/
3300 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3301 {
3302   DM              plex, plexA = NULL;
3303   DMEnclosureType encAux;
3304   PetscSection    section, sectionAux;
3305   PetscDS         prob;
3306   const PetscInt *cells;
3307   PetscInt        cStart, cEnd, numCells, totDim, totDimAux, c;
3308   PetscErrorCode  ierr;
3309 
3310   PetscFunctionBegin;
3311   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3312   PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
3313   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
3314   if (locA)   {PetscValidHeaderSpecific(locA, VEC_CLASSID, 6);}
3315   PetscValidPointer(u, 7);
3316   PetscValidPointer(u_t, 8);
3317   PetscValidPointer(a, 9);
3318   ierr = DMPlexConvertPlex(dm, &plex, PETSC_FALSE);CHKERRQ(ierr);
3319   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3320   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
3321   ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr);
3322   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
3323   if (locA) {
3324     DM      dmAux;
3325     PetscDS probAux;
3326 
3327     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
3328     ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
3329     ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr);
3330     ierr = DMGetLocalSection(dmAux, &sectionAux);CHKERRQ(ierr);
3331     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
3332     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
3333   }
3334   numCells = cEnd - cStart;
3335   ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u);CHKERRQ(ierr);
3336   if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;}
3337   if (locA)   {ierr = DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;}
3338   for (c = cStart; c < cEnd; ++c) {
3339     const PetscInt cell = cells ? cells[c] : c;
3340     const PetscInt cind = c - cStart;
3341     PetscScalar   *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a;
3342     PetscInt       i;
3343 
3344     ierr = DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr);
3345     for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i];
3346     ierr = DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr);
3347     if (locX_t) {
3348       ierr = DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr);
3349       for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i];
3350       ierr = DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr);
3351     }
3352     if (locA) {
3353       PetscInt subcell;
3354       ierr = DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell);CHKERRQ(ierr);
3355       ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr);
3356       for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i];
3357       ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr);
3358     }
3359   }
3360   ierr = DMDestroy(&plex);CHKERRQ(ierr);
3361   if (locA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
3362   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3363   PetscFunctionReturn(0);
3364 }
3365 
3366 /*@C
3367   DMPlexRestoreCellFields - Restore the field values values for a chunk of cells
3368 
3369   Input Parameters:
3370 + dm     - The DM
3371 . cellIS - The cells to include
3372 . locX   - A local vector with the solution fields
3373 . locX_t - A local vector with solution field time derivatives, or NULL
3374 - locA   - A local vector with auxiliary fields, or NULL
3375 
3376   Output Parameters:
3377 + u   - The field coefficients
3378 . u_t - The fields derivative coefficients
3379 - a   - The auxiliary field coefficients
3380 
3381   Level: developer
3382 
3383 .seealso: DMPlexGetFaceFields()
3384 @*/
3385 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3386 {
3387   PetscErrorCode ierr;
3388 
3389   PetscFunctionBegin;
3390   ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u);CHKERRQ(ierr);
3391   if (locX_t) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t);CHKERRQ(ierr);}
3392   if (locA)   {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a);CHKERRQ(ierr);}
3393   PetscFunctionReturn(0);
3394 }
3395 
3396 static PetscErrorCode DMPlexGetHybridAuxFields(DM dmAux, PetscDS dsAux[], IS cellIS, Vec locA, PetscScalar *a[])
3397 {
3398   DM              plexA;
3399   PetscSection    sectionAux;
3400   const PetscInt *cells;
3401   PetscInt        cStart, cEnd, numCells, c, totDimAux[2];
3402   PetscErrorCode  ierr;
3403 
3404   PetscFunctionBegin;
3405   if (!locA) PetscFunctionReturn(0);
3406   PetscValidHeaderSpecific(dmAux, DM_CLASSID, 1);
3407   PetscValidPointer(dsAux, 2);
3408   PetscValidHeaderSpecific(locA, VEC_CLASSID, 4);
3409   PetscValidPointer(a, 5);
3410   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3411   ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr);
3412   ierr = DMGetLocalSection(dmAux, &sectionAux);CHKERRQ(ierr);
3413   numCells = cEnd - cStart;
3414   ierr = PetscDSGetTotalDimension(dsAux[0], &totDimAux[0]);CHKERRQ(ierr);
3415   ierr = DMGetWorkArray(dmAux, numCells*totDimAux[0], MPIU_SCALAR, &a[0]);CHKERRQ(ierr);
3416   ierr = PetscDSGetTotalDimension(dsAux[1], &totDimAux[1]);CHKERRQ(ierr);
3417   ierr = DMGetWorkArray(dmAux, numCells*totDimAux[1], MPIU_SCALAR, &a[1]);CHKERRQ(ierr);
3418   for (c = cStart; c < cEnd; ++c) {
3419     const PetscInt  cell = cells ? cells[c] : c;
3420     const PetscInt  cind = c - cStart;
3421     const PetscInt *cone, *ornt;
3422     PetscInt        c;
3423 
3424     ierr = DMPlexGetCone(dmAux, cell, &cone);CHKERRQ(ierr);
3425     ierr = DMPlexGetConeOrientation(dmAux, cell, &ornt);CHKERRQ(ierr);
3426     for (c = 0; c < 2; ++c) {
3427       PetscScalar   *x = NULL, *al = a[c];
3428       const PetscInt tdA = totDimAux[c];
3429       PetscInt       Na, i;
3430 
3431       if (ornt[c]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_SUP, "Face %D in hybrid cell %D has orientation %D != 0", cone[c], cell, ornt[c]);
3432       ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, cone[c], &Na, &x);CHKERRQ(ierr);
3433       for (i = 0; i < Na; ++i) al[cind*tdA+i] = x[i];
3434       ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, cone[c], &Na, &x);CHKERRQ(ierr);
3435     }
3436   }
3437   ierr = DMDestroy(&plexA);CHKERRQ(ierr);
3438   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3439   PetscFunctionReturn(0);
3440 }
3441 
3442 static PetscErrorCode DMPlexRestoreHybridAuxFields(DM dmAux, PetscDS dsAux[], IS cellIS, Vec locA, PetscScalar *a[])
3443 {
3444   PetscErrorCode ierr;
3445 
3446   PetscFunctionBegin;
3447   if (!locA) PetscFunctionReturn(0);
3448   ierr = DMRestoreWorkArray(dmAux, 0, MPIU_SCALAR, &a[0]);CHKERRQ(ierr);
3449   ierr = DMRestoreWorkArray(dmAux, 0, MPIU_SCALAR, &a[1]);CHKERRQ(ierr);
3450   PetscFunctionReturn(0);
3451 }
3452 
3453 /*@C
3454   DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces
3455 
3456   Input Parameters:
3457 + dm     - The DM
3458 . fStart - The first face to include
3459 . fEnd   - The first face to exclude
3460 . locX   - A local vector with the solution fields
3461 . locX_t - A local vector with solution field time derivatives, or NULL
3462 . faceGeometry - A local vector with face geometry
3463 . cellGeometry - A local vector with cell geometry
3464 - locaGrad - A local vector with field gradients, or NULL
3465 
3466   Output Parameters:
3467 + Nface - The number of faces with field values
3468 . uL - The field values at the left side of the face
3469 - uR - The field values at the right side of the face
3470 
3471   Level: developer
3472 
3473 .seealso: DMPlexGetCellFields()
3474 @*/
3475 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)
3476 {
3477   DM                 dmFace, dmCell, dmGrad = NULL;
3478   PetscSection       section;
3479   PetscDS            prob;
3480   DMLabel            ghostLabel;
3481   const PetscScalar *facegeom, *cellgeom, *x, *lgrad;
3482   PetscBool         *isFE;
3483   PetscInt           dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face;
3484   PetscErrorCode     ierr;
3485 
3486   PetscFunctionBegin;
3487   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3488   PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
3489   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
3490   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6);
3491   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7);
3492   if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);}
3493   PetscValidPointer(uL, 9);
3494   PetscValidPointer(uR, 10);
3495   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3496   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3497   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
3498   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
3499   ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr);
3500   ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr);
3501   for (f = 0; f < Nf; ++f) {
3502     PetscObject  obj;
3503     PetscClassId id;
3504 
3505     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3506     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3507     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
3508     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
3509     else                            {isFE[f] = PETSC_FALSE;}
3510   }
3511   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3512   ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr);
3513   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
3514   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3515   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
3516   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3517   if (locGrad) {
3518     ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr);
3519     ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
3520   }
3521   ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL);CHKERRQ(ierr);
3522   ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR);CHKERRQ(ierr);
3523   /* Right now just eat the extra work for FE (could make a cell loop) */
3524   for (face = fStart, iface = 0; face < fEnd; ++face) {
3525     const PetscInt        *cells;
3526     PetscFVFaceGeom       *fg;
3527     PetscFVCellGeom       *cgL, *cgR;
3528     PetscScalar           *xL, *xR, *gL, *gR;
3529     PetscScalar           *uLl = *uL, *uRl = *uR;
3530     PetscInt               ghost, nsupp, nchild;
3531 
3532     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
3533     ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
3534     ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
3535     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3536     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
3537     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
3538     ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
3539     ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
3540     for (f = 0; f < Nf; ++f) {
3541       PetscInt off;
3542 
3543       ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr);
3544       if (isFE[f]) {
3545         const PetscInt *cone;
3546         PetscInt        comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d;
3547 
3548         xL = xR = NULL;
3549         ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr);
3550         ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
3551         ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
3552         ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr);
3553         ierr = DMPlexGetConeSize(dm, cells[0], &coneSizeL);CHKERRQ(ierr);
3554         for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break;
3555         ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr);
3556         ierr = DMPlexGetConeSize(dm, cells[1], &coneSizeR);CHKERRQ(ierr);
3557         for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break;
3558         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]);
3559         /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */
3560         /* TODO: this is a hack that might not be right for nonconforming */
3561         if (faceLocL < coneSizeL) {
3562           ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr);
3563           if (rdof == ldof && faceLocR < coneSizeR) {ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);}
3564           else              {for (d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];}
3565         }
3566         else {
3567           ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);
3568           ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr);
3569           for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d];
3570         }
3571         ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
3572         ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
3573       } else {
3574         PetscFV  fv;
3575         PetscInt numComp, c;
3576 
3577         ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr);
3578         ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr);
3579         ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr);
3580         ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr);
3581         if (dmGrad) {
3582           PetscReal dxL[3], dxR[3];
3583 
3584           ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr);
3585           ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr);
3586           DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL);
3587           DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR);
3588           for (c = 0; c < numComp; ++c) {
3589             uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL);
3590             uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR);
3591           }
3592         } else {
3593           for (c = 0; c < numComp; ++c) {
3594             uLl[iface*Nc+off+c] = xL[c];
3595             uRl[iface*Nc+off+c] = xR[c];
3596           }
3597         }
3598       }
3599     }
3600     ++iface;
3601   }
3602   *Nface = iface;
3603   ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr);
3604   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3605   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3606   if (locGrad) {
3607     ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
3608   }
3609   ierr = PetscFree(isFE);CHKERRQ(ierr);
3610   PetscFunctionReturn(0);
3611 }
3612 
3613 /*@C
3614   DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces
3615 
3616   Input Parameters:
3617 + dm     - The DM
3618 . fStart - The first face to include
3619 . fEnd   - The first face to exclude
3620 . locX   - A local vector with the solution fields
3621 . locX_t - A local vector with solution field time derivatives, or NULL
3622 . faceGeometry - A local vector with face geometry
3623 . cellGeometry - A local vector with cell geometry
3624 - locaGrad - A local vector with field gradients, or NULL
3625 
3626   Output Parameters:
3627 + Nface - The number of faces with field values
3628 . uL - The field values at the left side of the face
3629 - uR - The field values at the right side of the face
3630 
3631   Level: developer
3632 
3633 .seealso: DMPlexGetFaceFields()
3634 @*/
3635 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)
3636 {
3637   PetscErrorCode ierr;
3638 
3639   PetscFunctionBegin;
3640   ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL);CHKERRQ(ierr);
3641   ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR);CHKERRQ(ierr);
3642   PetscFunctionReturn(0);
3643 }
3644 
3645 /*@C
3646   DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces
3647 
3648   Input Parameters:
3649 + dm     - The DM
3650 . fStart - The first face to include
3651 . fEnd   - The first face to exclude
3652 . faceGeometry - A local vector with face geometry
3653 - cellGeometry - A local vector with cell geometry
3654 
3655   Output Parameters:
3656 + Nface - The number of faces with field values
3657 . fgeom - The extract the face centroid and normal
3658 - vol   - The cell volume
3659 
3660   Level: developer
3661 
3662 .seealso: DMPlexGetCellFields()
3663 @*/
3664 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3665 {
3666   DM                 dmFace, dmCell;
3667   DMLabel            ghostLabel;
3668   const PetscScalar *facegeom, *cellgeom;
3669   PetscInt           dim, numFaces = fEnd - fStart, iface, face;
3670   PetscErrorCode     ierr;
3671 
3672   PetscFunctionBegin;
3673   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3674   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4);
3675   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5);
3676   PetscValidPointer(fgeom, 6);
3677   PetscValidPointer(vol, 7);
3678   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3679   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3680   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
3681   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3682   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
3683   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3684   ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr);
3685   ierr = DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol);CHKERRQ(ierr);
3686   for (face = fStart, iface = 0; face < fEnd; ++face) {
3687     const PetscInt        *cells;
3688     PetscFVFaceGeom       *fg;
3689     PetscFVCellGeom       *cgL, *cgR;
3690     PetscFVFaceGeom       *fgeoml = *fgeom;
3691     PetscReal             *voll   = *vol;
3692     PetscInt               ghost, d, nchild, nsupp;
3693 
3694     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
3695     ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
3696     ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
3697     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3698     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
3699     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
3700     ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
3701     ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
3702     for (d = 0; d < dim; ++d) {
3703       fgeoml[iface].centroid[d] = fg->centroid[d];
3704       fgeoml[iface].normal[d]   = fg->normal[d];
3705     }
3706     voll[iface*2+0] = cgL->volume;
3707     voll[iface*2+1] = cgR->volume;
3708     ++iface;
3709   }
3710   *Nface = iface;
3711   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3712   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3713   PetscFunctionReturn(0);
3714 }
3715 
3716 /*@C
3717   DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces
3718 
3719   Input Parameters:
3720 + dm     - The DM
3721 . fStart - The first face to include
3722 . fEnd   - The first face to exclude
3723 . faceGeometry - A local vector with face geometry
3724 - cellGeometry - A local vector with cell geometry
3725 
3726   Output Parameters:
3727 + Nface - The number of faces with field values
3728 . fgeom - The extract the face centroid and normal
3729 - vol   - The cell volume
3730 
3731   Level: developer
3732 
3733 .seealso: DMPlexGetFaceFields()
3734 @*/
3735 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3736 {
3737   PetscErrorCode ierr;
3738 
3739   PetscFunctionBegin;
3740   ierr = PetscFree(*fgeom);CHKERRQ(ierr);
3741   ierr = DMRestoreWorkArray(dm, 0, MPIU_REAL, vol);CHKERRQ(ierr);
3742   PetscFunctionReturn(0);
3743 }
3744 
3745 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3746 {
3747   char            composeStr[33] = {0};
3748   PetscObjectId   id;
3749   PetscContainer  container;
3750   PetscErrorCode  ierr;
3751 
3752   PetscFunctionBegin;
3753   ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
3754   ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr);
3755   ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
3756   if (container) {
3757     ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
3758   } else {
3759     ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
3760     ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
3761     ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
3762     ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
3763     ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
3764     ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
3765   }
3766   PetscFunctionReturn(0);
3767 }
3768 
3769 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3770 {
3771   PetscFunctionBegin;
3772   *geom = NULL;
3773   PetscFunctionReturn(0);
3774 }
3775 
3776 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user)
3777 {
3778   DM_Plex         *mesh       = (DM_Plex *) dm->data;
3779   const char      *name       = "Residual";
3780   DM               dmAux      = NULL;
3781   DMLabel          ghostLabel = NULL;
3782   PetscDS          prob       = NULL;
3783   PetscDS          probAux    = NULL;
3784   PetscBool        useFEM     = PETSC_FALSE;
3785   PetscBool        isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
3786   DMField          coordField = NULL;
3787   Vec              locA;
3788   PetscScalar     *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL;
3789   IS               chunkIS;
3790   const PetscInt  *cells;
3791   PetscInt         cStart, cEnd, numCells;
3792   PetscInt         Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd;
3793   PetscInt         maxDegree = PETSC_MAX_INT;
3794   PetscHashFormKey key;
3795   PetscQuadrature  affineQuad = NULL, *quads = NULL;
3796   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
3797   PetscErrorCode   ierr;
3798 
3799   PetscFunctionBegin;
3800   ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
3801   /* FEM+FVM */
3802   /* 1: Get sizes from dm and dmAux */
3803   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3804   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3805   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
3806   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
3807   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
3808   if (locA) {
3809     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
3810     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
3811     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
3812   }
3813   /* 2: Get geometric data */
3814   for (f = 0; f < Nf; ++f) {
3815     PetscObject  obj;
3816     PetscClassId id;
3817     PetscBool    fimp;
3818 
3819     ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3820     if (isImplicit != fimp) continue;
3821     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3822     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3823     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
3824     if (id == PETSCFV_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented");
3825   }
3826   if (useFEM) {
3827     ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
3828     ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
3829     if (maxDegree <= 1) {
3830       ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
3831       if (affineQuad) {
3832         ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
3833       }
3834     } else {
3835       ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
3836       for (f = 0; f < Nf; ++f) {
3837         PetscObject  obj;
3838         PetscClassId id;
3839         PetscBool    fimp;
3840 
3841         ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3842         if (isImplicit != fimp) continue;
3843         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3844         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3845         if (id == PETSCFE_CLASSID) {
3846           PetscFE fe = (PetscFE) obj;
3847 
3848           ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
3849           ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr);
3850           ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
3851         }
3852       }
3853     }
3854   }
3855   /* Loop over chunks */
3856   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3857   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
3858   if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);}
3859   numCells      = cEnd - cStart;
3860   numChunks     = 1;
3861   cellChunkSize = numCells/numChunks;
3862   numChunks     = PetscMin(1,numCells);
3863   key.label     = NULL;
3864   key.value     = 0;
3865   for (chunk = 0; chunk < numChunks; ++chunk) {
3866     PetscScalar     *elemVec, *fluxL = NULL, *fluxR = NULL;
3867     PetscReal       *vol = NULL;
3868     PetscFVFaceGeom *fgeom = NULL;
3869     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
3870     PetscInt         numFaces = 0;
3871 
3872     /* Extract field coefficients */
3873     if (useFEM) {
3874       ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr);
3875       ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
3876       ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
3877       ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr);
3878     }
3879     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
3880     /* Loop over fields */
3881     for (f = 0; f < Nf; ++f) {
3882       PetscObject  obj;
3883       PetscClassId id;
3884       PetscBool    fimp;
3885       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
3886 
3887       key.field = f;
3888       ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3889       if (isImplicit != fimp) continue;
3890       ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3891       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3892       if (id == PETSCFE_CLASSID) {
3893         PetscFE         fe = (PetscFE) obj;
3894         PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
3895         PetscFEGeom    *chunkGeom = NULL;
3896         PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
3897         PetscInt        Nq, Nb;
3898 
3899         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
3900         ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
3901         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
3902         blockSize = Nb;
3903         batchSize = numBlocks * blockSize;
3904         ierr      = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
3905         numChunks = numCells / (numBatches*batchSize);
3906         Ne        = numChunks*numBatches*batchSize;
3907         Nr        = numCells % (numBatches*batchSize);
3908         offset    = numCells - Nr;
3909         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
3910         /*   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) */
3911         ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
3912         ierr = PetscFEIntegrateResidual(prob, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
3913         ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
3914         ierr = PetscFEIntegrateResidual(prob, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
3915         ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
3916       } else if (id == PETSCFV_CLASSID) {
3917         PetscFV fv = (PetscFV) obj;
3918 
3919         Ne = numFaces;
3920         /* Riemann solve over faces (need fields at face centroids) */
3921         /*   We need to evaluate FE fields at those coordinates */
3922         ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
3923       } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
3924     }
3925     /* Loop over domain */
3926     if (useFEM) {
3927       /* Add elemVec to locX */
3928       for (c = cS; c < cE; ++c) {
3929         const PetscInt cell = cells ? cells[c] : c;
3930         const PetscInt cind = c - cStart;
3931 
3932         if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
3933         if (ghostLabel) {
3934           PetscInt ghostVal;
3935 
3936           ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
3937           if (ghostVal > 0) continue;
3938         }
3939         ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
3940       }
3941     }
3942     /* Handle time derivative */
3943     if (locX_t) {
3944       PetscScalar *x_t, *fa;
3945 
3946       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
3947       ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
3948       for (f = 0; f < Nf; ++f) {
3949         PetscFV      fv;
3950         PetscObject  obj;
3951         PetscClassId id;
3952         PetscInt     pdim, d;
3953 
3954         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3955         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3956         if (id != PETSCFV_CLASSID) continue;
3957         fv   = (PetscFV) obj;
3958         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
3959         for (c = cS; c < cE; ++c) {
3960           const PetscInt cell = cells ? cells[c] : c;
3961           PetscScalar   *u_t, *r;
3962 
3963           if (ghostLabel) {
3964             PetscInt ghostVal;
3965 
3966             ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr);
3967             if (ghostVal > 0) continue;
3968           }
3969           ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
3970           ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
3971           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
3972         }
3973       }
3974       ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
3975       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
3976     }
3977     if (useFEM) {
3978       ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
3979       ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
3980     }
3981   }
3982   if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);}
3983   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3984   /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */
3985   if (useFEM) {
3986     if (maxDegree <= 1) {
3987       ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
3988       ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
3989     } else {
3990       for (f = 0; f < Nf; ++f) {
3991         ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
3992         ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);
3993       }
3994       ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
3995     }
3996   }
3997   ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
3998   PetscFunctionReturn(0);
3999 }
4000 
4001 /*
4002   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
4003 
4004   X   - The local solution vector
4005   X_t - The local solution time derviative vector, or NULL
4006 */
4007 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS,
4008                                                     PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx)
4009 {
4010   DM_Plex         *mesh  = (DM_Plex *) dm->data;
4011   const char      *name = "Jacobian", *nameP = "JacobianPre";
4012   DM               dmAux = NULL;
4013   PetscDS          prob,   probAux = NULL;
4014   PetscSection     sectionAux = NULL;
4015   Vec              A;
4016   DMField          coordField;
4017   PetscFEGeom     *cgeomFEM;
4018   PetscQuadrature  qGeom = NULL;
4019   Mat              J = Jac, JP = JacP;
4020   PetscScalar     *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL;
4021   PetscBool        hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE;
4022   const PetscInt  *cells;
4023   PetscHashFormKey key;
4024   PetscInt         Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0;
4025   PetscErrorCode   ierr;
4026 
4027   PetscFunctionBegin;
4028   ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
4029   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4030   ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
4031   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4032   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &A);CHKERRQ(ierr);
4033   if (A) {
4034     ierr = VecGetDM(A, &dmAux);CHKERRQ(ierr);
4035     ierr = DMGetLocalSection(dmAux, &sectionAux);CHKERRQ(ierr);
4036     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
4037   }
4038   /* Get flags */
4039   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
4040   ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
4041   for (fieldI = 0; fieldI < Nf; ++fieldI) {
4042     PetscObject  disc;
4043     PetscClassId id;
4044     ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr);
4045     ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr);
4046     if (id == PETSCFE_CLASSID)      {isFE[fieldI] = PETSC_TRUE;}
4047     else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;}
4048   }
4049   ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr);
4050   ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
4051   ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr);
4052   assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE;
4053   hasDyn      = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
4054   ierr = PetscObjectTypeCompare((PetscObject) Jac,  MATIS, &isMatIS);CHKERRQ(ierr);
4055   ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
4056   /* Setup input data and temp arrays (should be DMGetWorkArray) */
4057   if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);}
4058   if (isMatIS)  {ierr = MatISGetLocalMat(Jac,  &J);CHKERRQ(ierr);}
4059   if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);}
4060   if (hasFV)    {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */
4061   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4062   if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);}
4063   /* Compute batch sizes */
4064   if (isFE[0]) {
4065     PetscFE         fe;
4066     PetscQuadrature q;
4067     PetscInt        numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb;
4068 
4069     ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
4070     ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
4071     ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
4072     ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4073     ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4074     blockSize = Nb*numQuadPoints;
4075     batchSize = numBlocks  * blockSize;
4076     chunkSize = numBatches * batchSize;
4077     numChunks = numCells / chunkSize + numCells % chunkSize;
4078     ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4079   } else {
4080     chunkSize = numCells;
4081     numChunks = 1;
4082   }
4083   /* Get work space */
4084   wsz  = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize;
4085   ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr);
4086   ierr = PetscArrayzero(work, wsz);CHKERRQ(ierr);
4087   off      = 0;
4088   u        = X       ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
4089   u_t      = X_t     ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
4090   a        = dmAux   ? (sz = chunkSize*totDimAux,     off += sz, work+off-sz) : NULL;
4091   elemMat  = hasJac  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4092   elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4093   elemMatD = hasDyn  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4094   if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz);
4095   /* Setup geometry */
4096   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4097   ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
4098   if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);}
4099   if (!qGeom) {
4100     PetscFE fe;
4101 
4102     ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
4103     ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr);
4104     ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
4105   }
4106   ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
4107   /* Compute volume integrals */
4108   if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);}
4109   ierr = MatZeroEntries(JP);CHKERRQ(ierr);
4110   key.label = NULL;
4111   key.value = 0;
4112   for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) {
4113     const PetscInt   Ncell = PetscMin(chunkSize, numCells - offCell);
4114     PetscInt         c;
4115 
4116     /* Extract values */
4117     for (c = 0; c < Ncell; ++c) {
4118       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4119       PetscScalar   *x = NULL,  *x_t = NULL;
4120       PetscInt       i;
4121 
4122       if (X) {
4123         ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
4124         for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
4125         ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
4126       }
4127       if (X_t) {
4128         ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
4129         for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
4130         ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
4131       }
4132       if (dmAux) {
4133         ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
4134         for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
4135         ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
4136       }
4137     }
4138     for (fieldI = 0; fieldI < Nf; ++fieldI) {
4139       PetscFE fe;
4140       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
4141       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
4142         key.field = fieldI*Nf + fieldJ;
4143         if (hasJac)  {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN,     key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);}
4144         if (hasPrec) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);}
4145         if (hasDyn)  {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);}
4146       }
4147       /* For finite volume, add the identity */
4148       if (!isFE[fieldI]) {
4149         PetscFV  fv;
4150         PetscInt eOffset = 0, Nc, fc, foff;
4151 
4152         ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr);
4153         ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr);
4154         ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
4155         for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) {
4156           for (fc = 0; fc < Nc; ++fc) {
4157             const PetscInt i = foff + fc;
4158             if (hasJac)  {elemMat [eOffset+i*totDim+i] = 1.0;}
4159             if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;}
4160           }
4161         }
4162       }
4163     }
4164     /*   Add contribution from X_t */
4165     if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
4166     /* Insert values into matrix */
4167     for (c = 0; c < Ncell; ++c) {
4168       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4169       if (mesh->printFEM > 1) {
4170         if (hasJac)  {ierr = DMPrintCellMatrix(cell, name,  totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
4171         if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
4172       }
4173       if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);}
4174       ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
4175     }
4176   }
4177   /* Cleanup */
4178   ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
4179   ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
4180   if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);}
4181   ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
4182   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);
4183   /* Compute boundary integrals */
4184   /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */
4185   /* Assemble matrix */
4186   if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);}
4187   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4188   ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
4189   PetscFunctionReturn(0);
4190 }
4191 
4192 /******** FEM Assembly Function ********/
4193 
4194 static PetscErrorCode DMConvertPlex_Internal(DM dm, DM *plex, PetscBool copy)
4195 {
4196   PetscBool      isPlex;
4197   PetscErrorCode ierr;
4198 
4199   PetscFunctionBegin;
4200   ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr);
4201   if (isPlex) {
4202     *plex = dm;
4203     ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
4204   } else {
4205     ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr);
4206     if (!*plex) {
4207       ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr);
4208       ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr);
4209       if (copy) {
4210         ierr = DMCopyAuxiliaryVec(dm, *plex);CHKERRQ(ierr);
4211       }
4212     } else {
4213       ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr);
4214     }
4215   }
4216   PetscFunctionReturn(0);
4217 }
4218 
4219 /*@
4220   DMPlexGetGeometryFVM - Return precomputed geometric data
4221 
4222   Collective on DM
4223 
4224   Input Parameter:
4225 . dm - The DM
4226 
4227   Output Parameters:
4228 + facegeom - The values precomputed from face geometry
4229 . cellgeom - The values precomputed from cell geometry
4230 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell
4231 
4232   Level: developer
4233 
4234 .seealso: DMTSSetRHSFunctionLocal()
4235 @*/
4236 PetscErrorCode DMPlexGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
4237 {
4238   DM             plex;
4239   PetscErrorCode ierr;
4240 
4241   PetscFunctionBegin;
4242   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4243   ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr);
4244   ierr = DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL);CHKERRQ(ierr);
4245   if (minRadius) {ierr = DMPlexGetMinRadius(plex, minRadius);CHKERRQ(ierr);}
4246   ierr = DMDestroy(&plex);CHKERRQ(ierr);
4247   PetscFunctionReturn(0);
4248 }
4249 
4250 /*@
4251   DMPlexGetGradientDM - Return gradient data layout
4252 
4253   Collective on DM
4254 
4255   Input Parameters:
4256 + dm - The DM
4257 - fv - The PetscFV
4258 
4259   Output Parameter:
4260 . dmGrad - The layout for gradient values
4261 
4262   Level: developer
4263 
4264 .seealso: DMPlexGetGeometryFVM()
4265 @*/
4266 PetscErrorCode DMPlexGetGradientDM(DM dm, PetscFV fv, DM *dmGrad)
4267 {
4268   DM             plex;
4269   PetscBool      computeGradients;
4270   PetscErrorCode ierr;
4271 
4272   PetscFunctionBegin;
4273   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4274   PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2);
4275   PetscValidPointer(dmGrad,3);
4276   ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr);
4277   if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
4278   ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr);
4279   ierr = DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad);CHKERRQ(ierr);
4280   ierr = DMDestroy(&plex);CHKERRQ(ierr);
4281   PetscFunctionReturn(0);
4282 }
4283 
4284 static PetscErrorCode DMPlexComputeBdResidual_Single_Internal(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF, DMField coordField, IS facetIS)
4285 {
4286   DM_Plex         *mesh = (DM_Plex *) dm->data;
4287   DM               plex = NULL, plexA = NULL;
4288   DMEnclosureType  encAux;
4289   PetscDS          prob, probAux = NULL;
4290   PetscSection     section, sectionAux = NULL;
4291   Vec              locA = NULL;
4292   PetscScalar     *u = NULL, *u_t = NULL, *a = NULL, *elemVec = NULL;
4293   PetscInt         v;
4294   PetscInt         totDim, totDimAux = 0;
4295   PetscErrorCode   ierr;
4296 
4297   PetscFunctionBegin;
4298   ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
4299   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
4300   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4301   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4302   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
4303   if (locA) {
4304     DM dmAux;
4305 
4306     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4307     ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
4308     ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
4309     ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr);
4310     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
4311     ierr = DMGetLocalSection(plexA, &sectionAux);CHKERRQ(ierr);
4312   }
4313   for (v = 0; v < numValues; ++v) {
4314     PetscFEGeom     *fgeom;
4315     PetscInt         maxDegree;
4316     PetscQuadrature  qGeom = NULL;
4317     IS               pointIS;
4318     const PetscInt  *points;
4319     PetscHashFormKey key;
4320     PetscInt         numFaces, face, Nq;
4321 
4322     key.label = label;
4323     key.value = values[v];
4324     key.field = field;
4325     ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr);
4326     if (!pointIS) continue; /* No points with that id on this process */
4327     {
4328       IS isectIS;
4329 
4330       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
4331       ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr);
4332       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
4333       pointIS = isectIS;
4334     }
4335     ierr = ISGetLocalSize(pointIS,&numFaces);CHKERRQ(ierr);
4336     ierr = ISGetIndices(pointIS,&points);CHKERRQ(ierr);
4337     ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
4338     ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr);
4339     if (maxDegree <= 1) {
4340       ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr);
4341     }
4342     if (!qGeom) {
4343       PetscFE fe;
4344 
4345       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
4346       ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
4347       ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
4348     }
4349     ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4350     ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
4351     for (face = 0; face < numFaces; ++face) {
4352       const PetscInt point = points[face], *support;
4353       PetscScalar   *x     = NULL;
4354       PetscInt       i;
4355 
4356       ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
4357       ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
4358       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
4359       ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
4360       if (locX_t) {
4361         ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
4362         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
4363         ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
4364       }
4365       if (locA) {
4366         PetscInt subp;
4367 
4368         ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
4369         ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
4370         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
4371         ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
4372       }
4373     }
4374     ierr = PetscArrayzero(elemVec, numFaces*totDim);CHKERRQ(ierr);
4375     {
4376       PetscFE         fe;
4377       PetscInt        Nb;
4378       PetscFEGeom     *chunkGeom = NULL;
4379       /* Conforming batches */
4380       PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
4381       /* Remainder */
4382       PetscInt        Nr, offset;
4383 
4384       ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
4385       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4386       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4387       /* TODO: documentation is unclear about what is going on with these numbers: how should Nb / Nq factor in ? */
4388       blockSize = Nb;
4389       batchSize = numBlocks * blockSize;
4390       ierr =  PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4391       numChunks = numFaces / (numBatches*batchSize);
4392       Ne        = numChunks*numBatches*batchSize;
4393       Nr        = numFaces % (numBatches*batchSize);
4394       offset    = numFaces - Nr;
4395       ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr);
4396       ierr = PetscFEIntegrateBdResidual(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
4397       ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr);
4398       ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
4399       ierr = PetscFEIntegrateBdResidual(prob, wf, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4400       ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
4401     }
4402     for (face = 0; face < numFaces; ++face) {
4403       const PetscInt point = points[face], *support;
4404 
4405       if (mesh->printFEM > 1) {ierr = DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]);CHKERRQ(ierr);}
4406       ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr);
4407       ierr = DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
4408     }
4409     ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
4410     ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
4411     ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
4412     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
4413     ierr = PetscFree4(u, u_t, elemVec, a);CHKERRQ(ierr);
4414   }
4415   ierr = DMDestroy(&plex);CHKERRQ(ierr);
4416   ierr = DMDestroy(&plexA);CHKERRQ(ierr);
4417   PetscFunctionReturn(0);
4418 }
4419 
4420 PetscErrorCode DMPlexComputeBdResidualSingle(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF)
4421 {
4422   DMField        coordField;
4423   DMLabel        depthLabel;
4424   IS             facetIS;
4425   PetscInt       dim;
4426   PetscErrorCode ierr;
4427 
4428   PetscFunctionBegin;
4429   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4430   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4431   ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
4432   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4433   ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr);
4434   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
4435   PetscFunctionReturn(0);
4436 }
4437 
4438 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4439 {
4440   PetscDS        prob;
4441   PetscInt       numBd, bd;
4442   DMField        coordField = NULL;
4443   IS             facetIS    = NULL;
4444   DMLabel        depthLabel;
4445   PetscInt       dim;
4446   PetscErrorCode ierr;
4447 
4448   PetscFunctionBegin;
4449   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4450   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4451   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4452   ierr = DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS);CHKERRQ(ierr);
4453   ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
4454   for (bd = 0; bd < numBd; ++bd) {
4455     PetscWeakForm           wf;
4456     DMBoundaryConditionType type;
4457     DMLabel                 label;
4458     const PetscInt         *values;
4459     PetscInt                field, numValues;
4460     PetscObject             obj;
4461     PetscClassId            id;
4462 
4463     ierr = PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &field, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
4464     ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
4465     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4466     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
4467     if (!facetIS) {
4468       DMLabel  depthLabel;
4469       PetscInt dim;
4470 
4471       ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4472       ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4473       ierr = DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS);CHKERRQ(ierr);
4474     }
4475     ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4476     ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr);
4477   }
4478   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
4479   PetscFunctionReturn(0);
4480 }
4481 
4482 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, PetscHashFormKey key, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4483 {
4484   DM_Plex         *mesh       = (DM_Plex *) dm->data;
4485   const char      *name       = "Residual";
4486   DM               dmAux      = NULL;
4487   DM               dmGrad     = NULL;
4488   DMLabel          ghostLabel = NULL;
4489   PetscDS          ds         = NULL;
4490   PetscDS          dsAux      = NULL;
4491   PetscSection     section    = NULL;
4492   PetscBool        useFEM     = PETSC_FALSE;
4493   PetscBool        useFVM     = PETSC_FALSE;
4494   PetscBool        isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
4495   PetscFV          fvm        = NULL;
4496   PetscFVCellGeom *cgeomFVM   = NULL;
4497   PetscFVFaceGeom *fgeomFVM   = NULL;
4498   DMField          coordField = NULL;
4499   Vec              locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL;
4500   PetscScalar     *u = NULL, *u_t, *a, *uL, *uR;
4501   IS               chunkIS;
4502   const PetscInt  *cells;
4503   PetscInt         cStart, cEnd, numCells;
4504   PetscInt         Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd;
4505   PetscInt         maxDegree = PETSC_MAX_INT;
4506   PetscQuadrature  affineQuad = NULL, *quads = NULL;
4507   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
4508   PetscErrorCode   ierr;
4509 
4510   PetscFunctionBegin;
4511   ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4512   /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4513   /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */
4514   /* FEM+FVM */
4515   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4516   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4517   /* 1: Get sizes from dm and dmAux */
4518   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
4519   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
4520   ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &ds);CHKERRQ(ierr);
4521   ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr);
4522   ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr);
4523   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
4524   if (locA) {
4525     PetscInt subcell;
4526     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4527     ierr = DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell);CHKERRQ(ierr);
4528     ierr = DMGetCellDS(dmAux, subcell, &dsAux);CHKERRQ(ierr);
4529     ierr = PetscDSGetTotalDimension(dsAux, &totDimAux);CHKERRQ(ierr);
4530   }
4531   /* 2: Get geometric data */
4532   for (f = 0; f < Nf; ++f) {
4533     PetscObject  obj;
4534     PetscClassId id;
4535     PetscBool    fimp;
4536 
4537     ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr);
4538     if (isImplicit != fimp) continue;
4539     ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
4540     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4541     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
4542     if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
4543   }
4544   if (useFEM) {
4545     ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4546     ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
4547     if (maxDegree <= 1) {
4548       ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
4549       if (affineQuad) {
4550         ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
4551       }
4552     } else {
4553       ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
4554       for (f = 0; f < Nf; ++f) {
4555         PetscObject  obj;
4556         PetscClassId id;
4557         PetscBool    fimp;
4558 
4559         ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr);
4560         if (isImplicit != fimp) continue;
4561         ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
4562         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4563         if (id == PETSCFE_CLASSID) {
4564           PetscFE fe = (PetscFE) obj;
4565 
4566           ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
4567           ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr);
4568           ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
4569         }
4570       }
4571     }
4572   }
4573   if (useFVM) {
4574     ierr = DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr);
4575     ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr);
4576     ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
4577     /* Reconstruct and limit cell gradients */
4578     ierr = DMPlexGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr);
4579     if (dmGrad) {
4580       ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4581       ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
4582       ierr = DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
4583       /* Communicate gradient values */
4584       ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
4585       ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
4586       ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
4587       ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
4588     }
4589     /* Handle non-essential (e.g. outflow) boundary values */
4590     ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
4591   }
4592   /* Loop over chunks */
4593   if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);}
4594   numCells      = cEnd - cStart;
4595   numChunks     = 1;
4596   cellChunkSize = numCells/numChunks;
4597   faceChunkSize = (fEnd - fStart)/numChunks;
4598   numChunks     = PetscMin(1,numCells);
4599   for (chunk = 0; chunk < numChunks; ++chunk) {
4600     PetscScalar     *elemVec, *fluxL, *fluxR;
4601     PetscReal       *vol;
4602     PetscFVFaceGeom *fgeom;
4603     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
4604     PetscInt         fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face;
4605 
4606     /* Extract field coefficients */
4607     if (useFEM) {
4608       ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr);
4609       ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4610       ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4611       ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr);
4612     }
4613     if (useFVM) {
4614       ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
4615       ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
4616       ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
4617       ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
4618       ierr = PetscArrayzero(fluxL, numFaces*totDim);CHKERRQ(ierr);
4619       ierr = PetscArrayzero(fluxR, numFaces*totDim);CHKERRQ(ierr);
4620     }
4621     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
4622     /* Loop over fields */
4623     for (f = 0; f < Nf; ++f) {
4624       PetscObject  obj;
4625       PetscClassId id;
4626       PetscBool    fimp;
4627       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
4628 
4629       key.field = f;
4630       ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr);
4631       if (isImplicit != fimp) continue;
4632       ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
4633       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4634       if (id == PETSCFE_CLASSID) {
4635         PetscFE         fe = (PetscFE) obj;
4636         PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
4637         PetscFEGeom    *chunkGeom = NULL;
4638         PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
4639         PetscInt        Nq, Nb;
4640 
4641         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4642         ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4643         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4644         blockSize = Nb;
4645         batchSize = numBlocks * blockSize;
4646         ierr      = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4647         numChunks = numCells / (numBatches*batchSize);
4648         Ne        = numChunks*numBatches*batchSize;
4649         Nr        = numCells % (numBatches*batchSize);
4650         offset    = numCells - Nr;
4651         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
4652         /*   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) */
4653         ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
4654         ierr = PetscFEIntegrateResidual(ds, key, Ne, chunkGeom, u, u_t, dsAux, a, t, elemVec);CHKERRQ(ierr);
4655         ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4656         ierr = PetscFEIntegrateResidual(ds, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4657         ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4658       } else if (id == PETSCFV_CLASSID) {
4659         PetscFV fv = (PetscFV) obj;
4660 
4661         Ne = numFaces;
4662         /* Riemann solve over faces (need fields at face centroids) */
4663         /*   We need to evaluate FE fields at those coordinates */
4664         ierr = PetscFVIntegrateRHSFunction(fv, ds, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
4665       } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
4666     }
4667     /* Loop over domain */
4668     if (useFEM) {
4669       /* Add elemVec to locX */
4670       for (c = cS; c < cE; ++c) {
4671         const PetscInt cell = cells ? cells[c] : c;
4672         const PetscInt cind = c - cStart;
4673 
4674         if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
4675         if (ghostLabel) {
4676           PetscInt ghostVal;
4677 
4678           ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
4679           if (ghostVal > 0) continue;
4680         }
4681         ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
4682       }
4683     }
4684     if (useFVM) {
4685       PetscScalar *fa;
4686       PetscInt     iface;
4687 
4688       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
4689       for (f = 0; f < Nf; ++f) {
4690         PetscFV      fv;
4691         PetscObject  obj;
4692         PetscClassId id;
4693         PetscInt     foff, pdim;
4694 
4695         ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
4696         ierr = PetscDSGetFieldOffset(ds, f, &foff);CHKERRQ(ierr);
4697         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4698         if (id != PETSCFV_CLASSID) continue;
4699         fv   = (PetscFV) obj;
4700         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
4701         /* Accumulate fluxes to cells */
4702         for (face = fS, iface = 0; face < fE; ++face) {
4703           const PetscInt *scells;
4704           PetscScalar    *fL = NULL, *fR = NULL;
4705           PetscInt        ghost, d, nsupp, nchild;
4706 
4707           ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
4708           ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
4709           ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
4710           if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
4711           ierr = DMPlexGetSupport(dm, face, &scells);CHKERRQ(ierr);
4712           ierr = DMLabelGetValue(ghostLabel,scells[0],&ghost);CHKERRQ(ierr);
4713           if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL);CHKERRQ(ierr);}
4714           ierr = DMLabelGetValue(ghostLabel,scells[1],&ghost);CHKERRQ(ierr);
4715           if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR);CHKERRQ(ierr);}
4716           for (d = 0; d < pdim; ++d) {
4717             if (fL) fL[d] -= fluxL[iface*totDim+foff+d];
4718             if (fR) fR[d] += fluxR[iface*totDim+foff+d];
4719           }
4720           ++iface;
4721         }
4722       }
4723       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
4724     }
4725     /* Handle time derivative */
4726     if (locX_t) {
4727       PetscScalar *x_t, *fa;
4728 
4729       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
4730       ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
4731       for (f = 0; f < Nf; ++f) {
4732         PetscFV      fv;
4733         PetscObject  obj;
4734         PetscClassId id;
4735         PetscInt     pdim, d;
4736 
4737         ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
4738         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4739         if (id != PETSCFV_CLASSID) continue;
4740         fv   = (PetscFV) obj;
4741         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
4742         for (c = cS; c < cE; ++c) {
4743           const PetscInt cell = cells ? cells[c] : c;
4744           PetscScalar   *u_t, *r;
4745 
4746           if (ghostLabel) {
4747             PetscInt ghostVal;
4748 
4749             ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr);
4750             if (ghostVal > 0) continue;
4751           }
4752           ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
4753           ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
4754           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4755         }
4756       }
4757       ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
4758       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
4759     }
4760     if (useFEM) {
4761       ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4762       ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4763     }
4764     if (useFVM) {
4765       ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
4766       ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
4767       ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
4768       ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
4769       if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);}
4770     }
4771   }
4772   if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);}
4773   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4774 
4775   if (useFEM) {
4776     ierr = DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user);CHKERRQ(ierr);
4777 
4778     if (maxDegree <= 1) {
4779       ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
4780       ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
4781     } else {
4782       for (f = 0; f < Nf; ++f) {
4783         ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
4784         ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);
4785       }
4786       ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
4787     }
4788   }
4789 
4790   /* FEM */
4791   /* 1: Get sizes from dm and dmAux */
4792   /* 2: Get geometric data */
4793   /* 3: Handle boundary values */
4794   /* 4: Loop over domain */
4795   /*   Extract coefficients */
4796   /* Loop over fields */
4797   /*   Set tiling for FE*/
4798   /*   Integrate FE residual to get elemVec */
4799   /*     Loop over subdomain */
4800   /*       Loop over quad points */
4801   /*         Transform coords to real space */
4802   /*         Evaluate field and aux fields at point */
4803   /*         Evaluate residual at point */
4804   /*         Transform residual to real space */
4805   /*       Add residual to elemVec */
4806   /* Loop over domain */
4807   /*   Add elemVec to locX */
4808 
4809   /* FVM */
4810   /* Get geometric data */
4811   /* If using gradients */
4812   /*   Compute gradient data */
4813   /*   Loop over domain faces */
4814   /*     Count computational faces */
4815   /*     Reconstruct cell gradient */
4816   /*   Loop over domain cells */
4817   /*     Limit cell gradients */
4818   /* Handle boundary values */
4819   /* Loop over domain faces */
4820   /*   Read out field, centroid, normal, volume for each side of face */
4821   /* Riemann solve over faces */
4822   /* Loop over domain faces */
4823   /*   Accumulate fluxes to cells */
4824   /* TODO Change printFEM to printDisc here */
4825   if (mesh->printFEM) {
4826     Vec         locFbc;
4827     PetscInt    pStart, pEnd, p, maxDof;
4828     PetscScalar *zeroes;
4829 
4830     ierr = VecDuplicate(locF,&locFbc);CHKERRQ(ierr);
4831     ierr = VecCopy(locF,locFbc);CHKERRQ(ierr);
4832     ierr = PetscSectionGetChart(section,&pStart,&pEnd);CHKERRQ(ierr);
4833     ierr = PetscSectionGetMaxDof(section,&maxDof);CHKERRQ(ierr);
4834     ierr = PetscCalloc1(maxDof,&zeroes);CHKERRQ(ierr);
4835     for (p = pStart; p < pEnd; p++) {
4836       ierr = VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES);CHKERRQ(ierr);
4837     }
4838     ierr = PetscFree(zeroes);CHKERRQ(ierr);
4839     ierr = DMPrintLocalVec(dm, name, mesh->printTol, locFbc);CHKERRQ(ierr);
4840     ierr = VecDestroy(&locFbc);CHKERRQ(ierr);
4841   }
4842   ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4843   PetscFunctionReturn(0);
4844 }
4845 
4846 /*
4847   1) Allow multiple kernels for BdResidual for hybrid DS
4848 
4849   DONE 2) Get out dsAux for either side at the same time as cohesive cell dsAux
4850 
4851   DONE 3) Change DMGetCellFields() to get different aux data a[] for each side
4852      - I think I just need to replace a[] with the closure from each face
4853 
4854   4) Run both kernels for each non-hybrid field with correct dsAux, and then hybrid field as before
4855 */
4856 PetscErrorCode DMPlexComputeResidual_Hybrid_Internal(DM dm, PetscHashFormKey key[], IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4857 {
4858   DM_Plex         *mesh       = (DM_Plex *) dm->data;
4859   const char      *name       = "Hybrid Residual";
4860   DM               dmAux      = NULL;
4861   DMLabel          ghostLabel = NULL;
4862   PetscDS          ds         = NULL;
4863   PetscDS          dsAux[3]   = {NULL, NULL, NULL};
4864   PetscSection     section    = NULL;
4865   DMField          coordField = NULL;
4866   Vec              locA;
4867   PetscScalar     *u = NULL, *u_t, *a[3];
4868   PetscScalar     *elemVec;
4869   IS               chunkIS;
4870   const PetscInt  *cells;
4871   PetscInt        *faces;
4872   PetscInt         cStart, cEnd, numCells;
4873   PetscInt         Nf, f, totDim, totDimAux[3], numChunks, cellChunkSize, chunk;
4874   PetscInt         maxDegree = PETSC_MAX_INT;
4875   PetscQuadrature  affineQuad = NULL, *quads = NULL;
4876   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
4877   PetscErrorCode   ierr;
4878 
4879   PetscFunctionBegin;
4880   ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4881   /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4882   /* FEM */
4883   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4884   /* 1: Get sizes from dm and dmAux */
4885   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
4886   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
4887   ierr = DMGetCellDS(dm, cStart, &ds);CHKERRQ(ierr);
4888   ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr);
4889   ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr);
4890   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
4891   if (locA) {
4892     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4893     ierr = DMGetCellDS(dmAux, cStart, &dsAux[2]);CHKERRQ(ierr);
4894     ierr = PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]);CHKERRQ(ierr);
4895     {
4896       const PetscInt *cone;
4897       PetscInt        c;
4898 
4899       ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr);
4900       for (c = 0; c < 2; ++c) {
4901         const PetscInt *support;
4902         PetscInt ssize, s;
4903 
4904         ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
4905         ierr = DMPlexGetSupportSize(dm, cone[c], &ssize);CHKERRQ(ierr);
4906         if (ssize != 2) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D from cell %D has support size %D != 2", cone[c], cStart, ssize);
4907         if      (support[0] == cStart) s = 1;
4908         else if (support[1] == cStart) s = 0;
4909         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart);
4910         ierr = DMGetCellDS(dmAux, support[s], &dsAux[c]);CHKERRQ(ierr);
4911         ierr = PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]);CHKERRQ(ierr);
4912       }
4913     }
4914   }
4915   /* 2: Setup geometric data */
4916   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4917   ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
4918   if (maxDegree > 1) {
4919     ierr = PetscCalloc2(Nf, &quads, Nf, &geoms);CHKERRQ(ierr);
4920     for (f = 0; f < Nf; ++f) {
4921       PetscFE fe;
4922 
4923       ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr);
4924       if (fe) {
4925         ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
4926         ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr);
4927       }
4928     }
4929   }
4930   /* Loop over chunks */
4931   numCells      = cEnd - cStart;
4932   cellChunkSize = numCells;
4933   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
4934   ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr);
4935   ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr);
4936   /* Extract field coefficients */
4937   /* NOTE This needs the end cap faces to have identical orientations */
4938   ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a[2]);CHKERRQ(ierr);
4939   ierr = DMPlexGetHybridAuxFields(dm, dsAux, cellIS, locA, a);CHKERRQ(ierr);
4940   ierr = DMGetWorkArray(dm, cellChunkSize*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4941   for (chunk = 0; chunk < numChunks; ++chunk) {
4942     PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
4943 
4944     ierr = PetscMemzero(elemVec, cellChunkSize*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
4945     /* Get faces */
4946     for (c = cS; c < cE; ++c) {
4947       const PetscInt  cell = cells ? cells[c] : c;
4948       const PetscInt *cone;
4949       ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
4950       faces[(c-cS)*2+0] = cone[0];
4951       faces[(c-cS)*2+1] = cone[1];
4952     }
4953     ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr);
4954     /* Get geometric data */
4955     if (maxDegree <= 1) {
4956       if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);}
4957       if (affineQuad)  {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);}
4958     } else {
4959       for (f = 0; f < Nf; ++f) {
4960         if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);}
4961       }
4962     }
4963     /* Loop over fields */
4964     for (f = 0; f < Nf; ++f) {
4965       PetscFE         fe;
4966       PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
4967       PetscFEGeom    *chunkGeom = NULL;
4968       PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
4969       PetscInt        numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
4970 
4971       ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr);
4972       if (!fe) continue;
4973       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4974       ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4975       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4976       blockSize = Nb;
4977       batchSize = numBlocks * blockSize;
4978       ierr      = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4979       numChunks = numCells / (numBatches*batchSize);
4980       Ne        = numChunks*numBatches*batchSize;
4981       Nr        = numCells % (numBatches*batchSize);
4982       offset    = numCells - Nr;
4983       if (f == Nf-1) {
4984         key[2].field = f;
4985         ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
4986         ierr = PetscFEIntegrateHybridResidual(ds, key[2], Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, elemVec);CHKERRQ(ierr);
4987         ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4988         ierr = PetscFEIntegrateHybridResidual(ds, key[2], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[2], &a[2][offset*totDimAux[2]], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4989         ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4990       } else {
4991         key[0].field = f;
4992         key[1].field = f;
4993         ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
4994         ierr = PetscFEIntegrateHybridResidual(ds, key[0], Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, elemVec);CHKERRQ(ierr);
4995         ierr = PetscFEIntegrateHybridResidual(ds, key[1], Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, elemVec);CHKERRQ(ierr);
4996         ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4997         ierr = PetscFEIntegrateHybridResidual(ds, key[0], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[0], &a[0][offset*totDimAux[0]], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4998         ierr = PetscFEIntegrateHybridResidual(ds, key[1], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[1], &a[1][offset*totDimAux[1]], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4999         ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
5000       }
5001     }
5002     /* Add elemVec to locX */
5003     for (c = cS; c < cE; ++c) {
5004       const PetscInt cell = cells ? cells[c] : c;
5005       const PetscInt cind = c - cStart;
5006 
5007       if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
5008       if (ghostLabel) {
5009         PetscInt ghostVal;
5010 
5011         ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
5012         if (ghostVal > 0) continue;
5013       }
5014       ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
5015     }
5016   }
5017   ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a[2]);CHKERRQ(ierr);
5018   ierr = DMPlexRestoreHybridAuxFields(dm, dsAux, cellIS, locA, a);CHKERRQ(ierr);
5019   ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
5020   ierr = PetscFree(faces);CHKERRQ(ierr);
5021   ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);
5022   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5023   if (maxDegree <= 1) {
5024     ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
5025     ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
5026   } else {
5027     for (f = 0; f < Nf; ++f) {
5028       if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);}
5029       if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);}
5030     }
5031     ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
5032   }
5033   ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
5034   PetscFunctionReturn(0);
5035 }
5036 
5037 PetscErrorCode DMPlexComputeBdJacobian_Single_Internal(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt fieldI, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP, DMField coordField, IS facetIS)
5038 {
5039   DM_Plex        *mesh = (DM_Plex *) dm->data;
5040   DM              plex = NULL, plexA = NULL, tdm;
5041   DMEnclosureType encAux;
5042   PetscDS         prob, probAux = NULL;
5043   PetscSection    section, sectionAux = NULL;
5044   PetscSection    globalSection, subSection = NULL;
5045   Vec             locA = NULL, tv;
5046   PetscScalar    *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL;
5047   PetscInt        v;
5048   PetscInt        Nf, totDim, totDimAux = 0;
5049   PetscBool       isMatISP, transform;
5050   PetscErrorCode  ierr;
5051 
5052   PetscFunctionBegin;
5053   ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
5054   ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
5055   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
5056   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
5057   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
5058   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
5059   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
5060   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
5061   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
5062   if (locA) {
5063     DM dmAux;
5064 
5065     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
5066     ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
5067     ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
5068     ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr);
5069     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
5070     ierr = DMGetLocalSection(plexA, &sectionAux);CHKERRQ(ierr);
5071   }
5072 
5073   ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
5074   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
5075   if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);}
5076   for (v = 0; v < numValues; ++v) {
5077     PetscFEGeom     *fgeom;
5078     PetscInt         maxDegree;
5079     PetscQuadrature  qGeom = NULL;
5080     IS               pointIS;
5081     const PetscInt  *points;
5082     PetscHashFormKey key;
5083     PetscInt         numFaces, face, Nq;
5084 
5085     key.label = label;
5086     key.value = values[v];
5087     ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr);
5088     if (!pointIS) continue; /* No points with that id on this process */
5089     {
5090       IS isectIS;
5091 
5092       /* TODO: Special cases of ISIntersect where it is quick to check a prior if one is a superset of the other */
5093       ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr);
5094       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
5095       pointIS = isectIS;
5096     }
5097     ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
5098     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
5099     ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
5100     ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr);
5101     if (maxDegree <= 1) {
5102       ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr);
5103     }
5104     if (!qGeom) {
5105       PetscFE fe;
5106 
5107       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
5108       ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
5109       ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
5110     }
5111     ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
5112     ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
5113     for (face = 0; face < numFaces; ++face) {
5114       const PetscInt point = points[face], *support;
5115       PetscScalar   *x     = NULL;
5116       PetscInt       i;
5117 
5118       ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
5119       ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
5120       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
5121       ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
5122       if (locX_t) {
5123         ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
5124         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
5125         ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
5126       }
5127       if (locA) {
5128         PetscInt subp;
5129         ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
5130         ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
5131         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
5132         ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
5133       }
5134     }
5135     ierr = PetscArrayzero(elemMat, numFaces*totDim*totDim);CHKERRQ(ierr);
5136     {
5137       PetscFE         fe;
5138       PetscInt        Nb;
5139       /* Conforming batches */
5140       PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5141       /* Remainder */
5142       PetscFEGeom    *chunkGeom = NULL;
5143       PetscInt        fieldJ, Nr, offset;
5144 
5145       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
5146       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
5147       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5148       blockSize = Nb;
5149       batchSize = numBlocks * blockSize;
5150       ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5151       numChunks = numFaces / (numBatches*batchSize);
5152       Ne        = numChunks*numBatches*batchSize;
5153       Nr        = numFaces % (numBatches*batchSize);
5154       offset    = numFaces - Nr;
5155       ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr);
5156       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5157         key.field = fieldI*Nf+fieldJ;
5158         ierr = PetscFEIntegrateBdJacobian(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5159       }
5160       ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
5161       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5162         key.field = fieldI*Nf+fieldJ;
5163         ierr = PetscFEIntegrateBdJacobian(prob, wf, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5164       }
5165       ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
5166     }
5167     for (face = 0; face < numFaces; ++face) {
5168       const PetscInt point = points[face], *support;
5169 
5170       /* Transform to global basis before insertion in Jacobian */
5171       ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr);
5172       if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);}
5173       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);}
5174       if (!isMatISP) {
5175         ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5176       } else {
5177         Mat lJ;
5178 
5179         ierr = MatISGetLocalMat(JacP, &lJ);CHKERRQ(ierr);
5180         ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5181       }
5182     }
5183     ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
5184     ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
5185     ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
5186     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
5187     ierr = PetscFree4(u, u_t, elemMat, a);CHKERRQ(ierr);
5188   }
5189   if (plex)  {ierr = DMDestroy(&plex);CHKERRQ(ierr);}
5190   if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
5191   PetscFunctionReturn(0);
5192 }
5193 
5194 PetscErrorCode DMPlexComputeBdJacobianSingle(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP)
5195 {
5196   DMField        coordField;
5197   DMLabel        depthLabel;
5198   IS             facetIS;
5199   PetscInt       dim;
5200   PetscErrorCode ierr;
5201 
5202   PetscFunctionBegin;
5203   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5204   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
5205   ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
5206   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5207   ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr);
5208   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
5209   PetscFunctionReturn(0);
5210 }
5211 
5212 PetscErrorCode DMPlexComputeBdJacobian_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, PetscReal X_tShift, Mat Jac, Mat JacP, void *user)
5213 {
5214   PetscDS          prob;
5215   PetscInt         dim, numBd, bd;
5216   DMLabel          depthLabel;
5217   DMField          coordField = NULL;
5218   IS               facetIS;
5219   PetscErrorCode   ierr;
5220 
5221   PetscFunctionBegin;
5222   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
5223   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
5224   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5225   ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
5226   ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
5227   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5228   for (bd = 0; bd < numBd; ++bd) {
5229     PetscWeakForm           wf;
5230     DMBoundaryConditionType type;
5231     DMLabel                 label;
5232     const PetscInt         *values;
5233     PetscInt                fieldI, numValues;
5234     PetscObject             obj;
5235     PetscClassId            id;
5236 
5237     ierr = PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &fieldI, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5238     ierr = PetscDSGetDiscretization(prob, fieldI, &obj);CHKERRQ(ierr);
5239     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
5240     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
5241     ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr);
5242   }
5243   ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
5244   PetscFunctionReturn(0);
5245 }
5246 
5247 PetscErrorCode DMPlexComputeJacobian_Internal(DM dm, PetscHashFormKey key, IS cellIS, PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP,void *user)
5248 {
5249   DM_Plex        *mesh  = (DM_Plex *) dm->data;
5250   const char     *name  = "Jacobian";
5251   DM              dmAux = NULL, plex, tdm;
5252   DMEnclosureType encAux;
5253   Vec             A, tv;
5254   DMField         coordField;
5255   PetscDS         prob, probAux = NULL;
5256   PetscSection    section, globalSection, subSection, sectionAux;
5257   PetscScalar    *elemMat, *elemMatP, *elemMatD, *u, *u_t, *a = NULL;
5258   const PetscInt *cells;
5259   PetscInt        Nf, fieldI, fieldJ;
5260   PetscInt        totDim, totDimAux, cStart, cEnd, numCells, c;
5261   PetscBool       isMatIS, isMatISP, hasJac, hasPrec, hasDyn, hasFV = PETSC_FALSE, transform;
5262   PetscErrorCode  ierr;
5263 
5264   PetscFunctionBegin;
5265   ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5266   ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5267   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5268   ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
5269   ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
5270   ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
5271   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
5272   ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
5273   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
5274   if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);}
5275   ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5276   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5277   ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr);
5278   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
5279   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
5280   ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr);
5281   ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
5282   /* user passed in the same matrix, avoid double contributions and
5283      only assemble the Jacobian */
5284   if (hasJac && Jac == JacP) hasPrec = PETSC_FALSE;
5285   ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr);
5286   hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5287   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &A);CHKERRQ(ierr);
5288   if (A) {
5289     ierr = VecGetDM(A, &dmAux);CHKERRQ(ierr);
5290     ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
5291     ierr = DMConvert(dmAux, DMPLEX, &plex);CHKERRQ(ierr);
5292     ierr = DMGetLocalSection(plex, &sectionAux);CHKERRQ(ierr);
5293     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
5294     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
5295   }
5296   ierr = PetscMalloc5(numCells*totDim,&u,X_t ? numCells*totDim : 0,&u_t,hasJac ? numCells*totDim*totDim : 0,&elemMat,hasPrec ? numCells*totDim*totDim : 0, &elemMatP,hasDyn ? numCells*totDim*totDim : 0, &elemMatD);CHKERRQ(ierr);
5297   if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
5298   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5299   for (c = cStart; c < cEnd; ++c) {
5300     const PetscInt cell = cells ? cells[c] : c;
5301     const PetscInt cind = c - cStart;
5302     PetscScalar   *x = NULL,  *x_t = NULL;
5303     PetscInt       i;
5304 
5305     ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
5306     for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5307     ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
5308     if (X_t) {
5309       ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
5310       for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i];
5311       ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
5312     }
5313     if (dmAux) {
5314       PetscInt subcell;
5315       ierr = DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell);CHKERRQ(ierr);
5316       ierr = DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr);
5317       for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5318       ierr = DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr);
5319     }
5320   }
5321   if (hasJac)  {ierr = PetscArrayzero(elemMat,  numCells*totDim*totDim);CHKERRQ(ierr);}
5322   if (hasPrec) {ierr = PetscArrayzero(elemMatP, numCells*totDim*totDim);CHKERRQ(ierr);}
5323   if (hasDyn)  {ierr = PetscArrayzero(elemMatD, numCells*totDim*totDim);CHKERRQ(ierr);}
5324   for (fieldI = 0; fieldI < Nf; ++fieldI) {
5325     PetscClassId    id;
5326     PetscFE         fe;
5327     PetscQuadrature qGeom = NULL;
5328     PetscInt        Nb;
5329     /* Conforming batches */
5330     PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5331     /* Remainder */
5332     PetscInt        Nr, offset, Nq;
5333     PetscInt        maxDegree;
5334     PetscFEGeom     *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL;
5335 
5336     ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
5337     ierr = PetscObjectGetClassId((PetscObject) fe, &id);CHKERRQ(ierr);
5338     if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;}
5339     ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
5340     ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5341     ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
5342     if (maxDegree <= 1) {
5343       ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom);CHKERRQ(ierr);
5344     }
5345     if (!qGeom) {
5346       ierr = PetscFEGetQuadrature(fe,&qGeom);CHKERRQ(ierr);
5347       ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
5348     }
5349     ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
5350     ierr = DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
5351     blockSize = Nb;
5352     batchSize = numBlocks * blockSize;
5353     ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5354     numChunks = numCells / (numBatches*batchSize);
5355     Ne        = numChunks*numBatches*batchSize;
5356     Nr        = numCells % (numBatches*batchSize);
5357     offset    = numCells - Nr;
5358     ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
5359     ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr);
5360     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5361       key.field = fieldI*Nf+fieldJ;
5362       if (hasJac) {
5363         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5364         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5365       }
5366       if (hasPrec) {
5367         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);
5368         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr);
5369       }
5370       if (hasDyn) {
5371         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);
5372         ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatD[offset*totDim*totDim]);CHKERRQ(ierr);
5373       }
5374     }
5375     ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr);
5376     ierr = PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
5377     ierr = DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
5378     ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
5379   }
5380   /*   Add contribution from X_t */
5381   if (hasDyn) {for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
5382   if (hasFV) {
5383     PetscClassId id;
5384     PetscFV      fv;
5385     PetscInt     offsetI, NcI, NbI = 1, fc, f;
5386 
5387     for (fieldI = 0; fieldI < Nf; ++fieldI) {
5388       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr);
5389       ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr);
5390       ierr = PetscObjectGetClassId((PetscObject) fv, &id);CHKERRQ(ierr);
5391       if (id != PETSCFV_CLASSID) continue;
5392       /* Put in the identity */
5393       ierr = PetscFVGetNumComponents(fv, &NcI);CHKERRQ(ierr);
5394       for (c = cStart; c < cEnd; ++c) {
5395         const PetscInt cind    = c - cStart;
5396         const PetscInt eOffset = cind*totDim*totDim;
5397         for (fc = 0; fc < NcI; ++fc) {
5398           for (f = 0; f < NbI; ++f) {
5399             const PetscInt i = offsetI + f*NcI+fc;
5400             if (hasPrec) {
5401               if (hasJac) {elemMat[eOffset+i*totDim+i] = 1.0;}
5402               elemMatP[eOffset+i*totDim+i] = 1.0;
5403             } else {elemMat[eOffset+i*totDim+i] = 1.0;}
5404           }
5405         }
5406       }
5407     }
5408     /* No allocated space for FV stuff, so ignore the zero entries */
5409     ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);
5410   }
5411   /* Insert values into matrix */
5412   isMatIS = PETSC_FALSE;
5413   if (hasPrec && hasJac) {
5414     ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);
5415   }
5416   if (isMatIS && !subSection) {
5417     ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);
5418   }
5419   for (c = cStart; c < cEnd; ++c) {
5420     const PetscInt cell = cells ? cells[c] : c;
5421     const PetscInt cind = c - cStart;
5422 
5423     /* Transform to global basis before insertion in Jacobian */
5424     if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5425     if (hasPrec) {
5426       if (hasJac) {
5427         if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5428         if (!isMatIS) {
5429           ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5430         } else {
5431           Mat lJ;
5432 
5433           ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr);
5434           ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5435         }
5436       }
5437       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);}
5438       if (!isMatISP) {
5439         ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5440       } else {
5441         Mat lJ;
5442 
5443         ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5444         ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5445       }
5446     } else {
5447       if (hasJac) {
5448         if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5449         if (!isMatISP) {
5450           ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5451         } else {
5452           Mat lJ;
5453 
5454           ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5455           ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5456         }
5457       }
5458     }
5459   }
5460   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5461   if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);}
5462   ierr = PetscFree5(u,u_t,elemMat,elemMatP,elemMatD);CHKERRQ(ierr);
5463   if (dmAux) {
5464     ierr = PetscFree(a);CHKERRQ(ierr);
5465     ierr = DMDestroy(&plex);CHKERRQ(ierr);
5466   }
5467   /* Compute boundary integrals */
5468   ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user);CHKERRQ(ierr);
5469   /* Assemble matrix */
5470   if (hasJac && hasPrec) {
5471     ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5472     ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5473   }
5474   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5475   ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5476   ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5477   PetscFunctionReturn(0);
5478 }
5479 
5480 PetscErrorCode DMPlexComputeJacobian_Hybrid_Internal(DM dm, IS cellIS, PetscReal t, PetscReal X_tShift, Vec locX, Vec locX_t, Mat Jac, Mat JacP, void *user)
5481 {
5482   DM_Plex         *mesh       = (DM_Plex *) dm->data;
5483   const char      *name       = "Hybrid Jacobian";
5484   DM               dmAux      = NULL;
5485   DM               plex       = NULL;
5486   DM               plexA      = NULL;
5487   DMLabel          ghostLabel = NULL;
5488   PetscDS          prob       = NULL;
5489   PetscDS          probAux    = NULL;
5490   PetscSection     section    = NULL;
5491   DMField          coordField = NULL;
5492   Vec              locA;
5493   PetscScalar     *u = NULL, *u_t, *a = NULL;
5494   PetscScalar     *elemMat, *elemMatP;
5495   PetscSection     globalSection, subSection, sectionAux;
5496   IS               chunkIS;
5497   const PetscInt  *cells;
5498   PetscInt        *faces;
5499   PetscHashFormKey key;
5500   PetscInt         cStart, cEnd, numCells;
5501   PetscInt         Nf, fieldI, fieldJ, totDim, totDimAux, numChunks, cellChunkSize, chunk;
5502   PetscInt         maxDegree = PETSC_MAX_INT;
5503   PetscQuadrature  affineQuad = NULL, *quads = NULL;
5504   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
5505   PetscBool        isMatIS = PETSC_FALSE, isMatISP = PETSC_FALSE, hasBdJac, hasBdPrec;
5506   PetscErrorCode   ierr;
5507 
5508   PetscFunctionBegin;
5509   ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5510   ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5511   ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5512   ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
5513   ierr = DMGetSection(dm, &section);CHKERRQ(ierr);
5514   ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
5515   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
5516   ierr = DMGetCellDS(dm, cStart, &prob);CHKERRQ(ierr);
5517   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
5518   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
5519   ierr = PetscDSHasBdJacobian(prob, &hasBdJac);CHKERRQ(ierr);
5520   ierr = PetscDSHasBdJacobianPreconditioner(prob, &hasBdPrec);CHKERRQ(ierr);
5521   ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
5522   if (isMatISP) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);}
5523   if (hasBdPrec && hasBdJac) {ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);}
5524   if (isMatIS && !subSection) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);}
5525   ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr);
5526   if (locA) {
5527     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
5528     ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
5529     ierr = DMGetSection(dmAux, &sectionAux);CHKERRQ(ierr);
5530     ierr = DMGetCellDS(dmAux, cStart, &probAux);CHKERRQ(ierr);
5531     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
5532   }
5533   ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5534   ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
5535   if (maxDegree > 1) {
5536     PetscInt f;
5537     ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
5538     for (f = 0; f < Nf; ++f) {
5539       PetscFE fe;
5540 
5541       ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
5542       if (fe) {
5543         ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
5544         ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr);
5545       }
5546     }
5547   }
5548   cellChunkSize = numCells;
5549   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5550   ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr);
5551   ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr);
5552   ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
5553   ierr = DMGetWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr);
5554   ierr = DMGetWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr);
5555   for (chunk = 0; chunk < numChunks; ++chunk) {
5556     PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
5557 
5558     if (hasBdJac)  {ierr = PetscMemzero(elemMat,  numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);}
5559     if (hasBdPrec) {ierr = PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);}
5560     /* Get faces */
5561     for (c = cS; c < cE; ++c) {
5562       const PetscInt  cell = cells ? cells[c] : c;
5563       const PetscInt *cone;
5564       ierr = DMPlexGetCone(plex, cell, &cone);CHKERRQ(ierr);
5565       faces[(c-cS)*2+0] = cone[0];
5566       faces[(c-cS)*2+1] = cone[1];
5567     }
5568     ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr);
5569     if (maxDegree <= 1) {
5570       if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);}
5571       if (affineQuad)  {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);}
5572     } else {
5573       PetscInt f;
5574       for (f = 0; f < Nf; ++f) {
5575         if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);}
5576       }
5577     }
5578 
5579     key.label = NULL;
5580     key.value = 0;
5581     for (fieldI = 0; fieldI < Nf; ++fieldI) {
5582       PetscFE         feI;
5583       PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[fieldI];
5584       PetscFEGeom    *chunkGeom = NULL, *remGeom = NULL;
5585       PetscQuadrature quad = affineQuad ? affineQuad : quads[fieldI];
5586       PetscInt        numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
5587 
5588       ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &feI);CHKERRQ(ierr);
5589       if (!feI) continue;
5590       ierr = PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5591       ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
5592       ierr = PetscFEGetDimension(feI, &Nb);CHKERRQ(ierr);
5593       blockSize = Nb;
5594       batchSize = numBlocks * blockSize;
5595       ierr      = PetscFESetTileSizes(feI, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5596       numChunks = numCells / (numBatches*batchSize);
5597       Ne        = numChunks*numBatches*batchSize;
5598       Nr        = numCells % (numBatches*batchSize);
5599       offset    = numCells - Nr;
5600       ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
5601       ierr = PetscFEGeomGetChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr);
5602       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5603         PetscFE feJ;
5604 
5605         ierr = PetscDSGetDiscretization(prob, fieldJ, (PetscObject *) &feJ);CHKERRQ(ierr);
5606         if (!feJ) continue;
5607         key.field = fieldI*Nf+fieldJ;
5608         if (hasBdJac) {
5609           ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5610           ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5611         }
5612         if (hasBdPrec) {
5613           ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);
5614           ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr);
5615         }
5616       }
5617       ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr);
5618       ierr = PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
5619     }
5620     /* Insert values into matrix */
5621     for (c = cS; c < cE; ++c) {
5622       const PetscInt cell = cells ? cells[c] : c;
5623       const PetscInt cind = c - cS;
5624 
5625       if (hasBdPrec) {
5626         if (hasBdJac) {
5627           if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5628           if (!isMatIS) {
5629             ierr = DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5630           } else {
5631             Mat lJ;
5632 
5633             ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr);
5634             ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5635           }
5636         }
5637         if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);}
5638         if (!isMatISP) {
5639           ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5640         } else {
5641           Mat lJ;
5642 
5643           ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5644           ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5645         }
5646       } else if (hasBdJac) {
5647         if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5648         if (!isMatISP) {
5649           ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5650         } else {
5651           Mat lJ;
5652 
5653           ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5654           ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5655         }
5656       }
5657     }
5658   }
5659   ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
5660   ierr = DMRestoreWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr);
5661   ierr = DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr);
5662   ierr = PetscFree(faces);CHKERRQ(ierr);
5663   ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);
5664   ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5665   if (maxDegree <= 1) {
5666     ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
5667     ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
5668   } else {
5669     PetscInt f;
5670     for (f = 0; f < Nf; ++f) {
5671       if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]);CHKERRQ(ierr);}
5672       if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);}
5673     }
5674     ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
5675   }
5676   if (dmAux) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
5677   ierr = DMDestroy(&plex);CHKERRQ(ierr);
5678   /* Assemble matrix */
5679   if (hasBdJac && hasBdPrec) {
5680     ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5681     ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5682   }
5683   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5684   ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5685   ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5686   PetscFunctionReturn(0);
5687 }
5688