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