xref: /petsc/src/dm/impls/plex/plexfem.c (revision ffa8c5705e8ab2cf85ee1d14dbe507a6e2eb5283)
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_%x\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 %D does not match context dimension %D", dim, dim2);
149   for (i = 0; i < dim; i++) mode[i] = 0.;
150   if (d < dim) {
151     mode[d] = 1.; /* Translation along axis d */
152   } else {
153     for (i = 0; i < dim; i++) {
154       for (j = 0; j < dim; j++) {
155         mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */
156       }
157     }
158   }
159   PetscFunctionReturn(0);
160 }
161 
162 /*@
163   DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation
164 
165   Collective on dm
166 
167   Input 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   PetscCheckFalse(Nf && (field < 0 || field >= Nf),comm, PETSC_ERR_ARG_OUTOFRANGE, "Field %D is not in [0, Nf)", 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 %D 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 %D should be %D", c, lda);
581       r += fdof;
582     }
583   }
584   PetscCheck(r == lda,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of rows %D should be %D", 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 %D", 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 %D", 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   PetscCall(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   PetscCall(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   PetscErrorCode   ierr;
1207 
1208   PetscFunctionBegin;
1209   PetscCall(DMGetDimension(dm, &dim));
1210   PetscCall(DMGetCoordinateDim(dm, &coordDim));
1211   fegeom.dimEmbed = coordDim;
1212   PetscCall(DMGetLocalSection(dm, &section));
1213   PetscCall(PetscSectionGetNumFields(section, &numFields));
1214   PetscCall(DMGetBasisTransformDM_Internal(dm, &tdm));
1215   PetscCall(DMGetBasisTransformVec_Internal(dm, &tv));
1216   PetscCall(DMHasBasisTransform(dm, &transform));
1217   for (field = 0; field < numFields; ++field) {
1218     PetscObject  obj;
1219     PetscClassId id;
1220     PetscInt     Nc;
1221 
1222     PetscCall(DMGetField(dm, field, NULL, &obj));
1223     PetscCall(PetscObjectGetClassId(obj, &id));
1224     if (id == PETSCFE_CLASSID) {
1225       PetscFE fe = (PetscFE) obj;
1226 
1227       PetscCall(PetscFEGetQuadrature(fe, &quad));
1228       PetscCall(PetscFEGetNumComponents(fe, &Nc));
1229     } else if (id == PETSCFV_CLASSID) {
1230       PetscFV fv = (PetscFV) obj;
1231 
1232       PetscCall(PetscFVGetQuadrature(fv, &quad));
1233       PetscCall(PetscFVGetNumComponents(fv, &Nc));
1234     } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1235     numComponents += Nc;
1236   }
1237   PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights));
1238   PetscCheckFalse((qNc != 1) && (qNc != numComponents),PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1239   PetscCall(PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ));
1240   PetscCall(DMPlexGetVTKCellHeight(dm, &cellHeight));
1241   PetscCall(DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd));
1242   for (c = cStart; c < cEnd; ++c) {
1243     PetscScalar *x = NULL;
1244     PetscReal    elemDiff = 0.0;
1245     PetscInt     qc = 0;
1246 
1247     PetscCall(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1248     PetscCall(DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x));
1249 
1250     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1251       PetscObject  obj;
1252       PetscClassId id;
1253       void * const ctx = ctxs ? ctxs[field] : NULL;
1254       PetscInt     Nb, Nc, q, fc;
1255 
1256       PetscCall(DMGetField(dm, field, NULL, &obj));
1257       PetscCall(PetscObjectGetClassId(obj, &id));
1258       if (id == PETSCFE_CLASSID)      {PetscCall(PetscFEGetNumComponents((PetscFE) obj, &Nc));PetscCall(PetscFEGetDimension((PetscFE) obj, &Nb));}
1259       else if (id == PETSCFV_CLASSID) {PetscCall(PetscFVGetNumComponents((PetscFV) obj, &Nc));Nb = 1;}
1260       else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1261       if (debug) {
1262         char title[1024];
1263         PetscCall(PetscSNPrintf(title, 1023, "Solution for Field %D", field));
1264         PetscCall(DMPrintCellVector(c, title, Nb, &x[fieldOffset]));
1265       }
1266       for (q = 0; q < Nq; ++q) {
1267         PetscFEGeom qgeom;
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 %D, point %D", (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           PetscCall(ierr);
1287         }
1288         if (transform) PetscCall(DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx));
1289         if (id == PETSCFE_CLASSID)      PetscCall(PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant));
1290         else if (id == PETSCFV_CLASSID) PetscCall(PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant));
1291         else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %" PetscInt_FMT, field);
1292         for (fc = 0; fc < Nc; ++fc) {
1293           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1294           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]), PetscRealPart(interpolant[fc]), PetscRealPart(funcVal[fc])));
1295           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1296         }
1297       }
1298       fieldOffset += Nb;
1299       qc += Nc;
1300     }
1301     PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1302     if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, "  elem %" PetscInt_FMT " diff %g\n", c, (double)elemDiff));
1303     localDiff += elemDiff;
1304   }
1305   PetscCall(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1306   PetscCallMPI(MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm)));
1307   *diff = PetscSqrtReal(*diff);
1308   PetscFunctionReturn(0);
1309 }
1310 
1311 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)
1312 {
1313   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
1314   DM               tdm;
1315   PetscSection     section;
1316   PetscQuadrature  quad;
1317   Vec              localX, tv;
1318   PetscScalar     *funcVal, *interpolant;
1319   const PetscReal *quadWeights;
1320   PetscFEGeom      fegeom;
1321   PetscReal       *coords, *gcoords;
1322   PetscReal        localDiff = 0.0;
1323   PetscInt         dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, c, field, fieldOffset;
1324   PetscBool        transform;
1325   PetscErrorCode   ierr;
1326 
1327   PetscFunctionBegin;
1328   PetscCall(DMGetDimension(dm, &dim));
1329   PetscCall(DMGetCoordinateDim(dm, &coordDim));
1330   fegeom.dimEmbed = coordDim;
1331   PetscCall(DMGetLocalSection(dm, &section));
1332   PetscCall(PetscSectionGetNumFields(section, &numFields));
1333   PetscCall(DMGetLocalVector(dm, &localX));
1334   PetscCall(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1335   PetscCall(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1336   PetscCall(DMGetBasisTransformDM_Internal(dm, &tdm));
1337   PetscCall(DMGetBasisTransformVec_Internal(dm, &tv));
1338   PetscCall(DMHasBasisTransform(dm, &transform));
1339   for (field = 0; field < numFields; ++field) {
1340     PetscFE  fe;
1341     PetscInt Nc;
1342 
1343     PetscCall(DMGetField(dm, field, NULL, (PetscObject *) &fe));
1344     PetscCall(PetscFEGetQuadrature(fe, &quad));
1345     PetscCall(PetscFEGetNumComponents(fe, &Nc));
1346     numComponents += Nc;
1347   }
1348   PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights));
1349   PetscCheckFalse((qNc != 1) && (qNc != numComponents),PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1350   /* PetscCall(DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX)); */
1351   PetscCall(PetscMalloc6(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ,numComponents*coordDim,&interpolant,Nq,&fegeom.detJ));
1352   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1353   for (c = cStart; c < cEnd; ++c) {
1354     PetscScalar *x = NULL;
1355     PetscReal    elemDiff = 0.0;
1356     PetscInt     qc = 0;
1357 
1358     PetscCall(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1359     PetscCall(DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x));
1360 
1361     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1362       PetscFE          fe;
1363       void * const     ctx = ctxs ? ctxs[field] : NULL;
1364       PetscInt         Nb, Nc, q, fc;
1365 
1366       PetscCall(DMGetField(dm, field, NULL, (PetscObject *) &fe));
1367       PetscCall(PetscFEGetDimension(fe, &Nb));
1368       PetscCall(PetscFEGetNumComponents(fe, &Nc));
1369       if (debug) {
1370         char title[1024];
1371         PetscCall(PetscSNPrintf(title, 1023, "Solution for Field %" PetscInt_FMT, field));
1372         PetscCall(DMPrintCellVector(c, title, Nb, &x[fieldOffset]));
1373       }
1374       for (q = 0; q < Nq; ++q) {
1375         PetscFEGeom qgeom;
1376 
1377         qgeom.dimEmbed = fegeom.dimEmbed;
1378         qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1379         qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1380         qgeom.detJ     = &fegeom.detJ[q];
1381         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);
1382         if (transform) {
1383           gcoords = &coords[coordDim*Nq];
1384           PetscCall(DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx));
1385         } else {
1386           gcoords = &coords[coordDim*q];
1387         }
1388         PetscCall(PetscArrayzero(funcVal,Nc));
1389         ierr = (*funcs[field])(coordDim, time, gcoords, n, Nc, funcVal, ctx);
1390         if (ierr) {
1391           PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1392           PetscCall(DMRestoreLocalVector(dm, &localX));
1393           PetscCall(PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ));
1394           PetscCall(ierr);
1395         }
1396         if (transform) PetscCall(DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx));
1397         PetscCall(PetscFEInterpolateGradient_Static(fe, 1, &x[fieldOffset], &qgeom, q, interpolant));
1398         /* Overwrite with the dot product if the normal is given */
1399         if (n) {
1400           for (fc = 0; fc < Nc; ++fc) {
1401             PetscScalar sum = 0.0;
1402             PetscInt    d;
1403             for (d = 0; d < dim; ++d) sum += interpolant[fc*dim+d]*n[d];
1404             interpolant[fc] = sum;
1405           }
1406         }
1407         for (fc = 0; fc < Nc; ++fc) {
1408           const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1409           if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, "    elem %D fieldDer %D,%D diff %g\n", c, field, fc, (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q])));
1410           elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1411         }
1412       }
1413       fieldOffset += Nb;
1414       qc          += Nc;
1415     }
1416     PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1417     if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, "  elem %D diff %g\n", c, (double)elemDiff));
1418     localDiff += elemDiff;
1419   }
1420   PetscCall(PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ));
1421   PetscCall(DMRestoreLocalVector(dm, &localX));
1422   PetscCallMPI(MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm)));
1423   *diff = PetscSqrtReal(*diff);
1424   PetscFunctionReturn(0);
1425 }
1426 
1427 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
1428 {
1429   const PetscInt   debug = ((DM_Plex*)dm->data)->printL2;
1430   DM               tdm;
1431   DMLabel          depthLabel;
1432   PetscSection     section;
1433   Vec              localX, tv;
1434   PetscReal       *localDiff;
1435   PetscInt         dim, depth, dE, Nf, f, Nds, s;
1436   PetscBool        transform;
1437   PetscErrorCode   ierr;
1438 
1439   PetscFunctionBegin;
1440   PetscCall(DMGetDimension(dm, &dim));
1441   PetscCall(DMGetCoordinateDim(dm, &dE));
1442   PetscCall(DMGetLocalSection(dm, &section));
1443   PetscCall(DMGetLocalVector(dm, &localX));
1444   PetscCall(DMGetBasisTransformDM_Internal(dm, &tdm));
1445   PetscCall(DMGetBasisTransformVec_Internal(dm, &tv));
1446   PetscCall(DMHasBasisTransform(dm, &transform));
1447   PetscCall(DMGetNumFields(dm, &Nf));
1448   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
1449   PetscCall(DMLabelGetNumValues(depthLabel, &depth));
1450 
1451   PetscCall(VecSet(localX, 0.0));
1452   PetscCall(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1453   PetscCall(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1454   PetscCall(DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX));
1455   PetscCall(DMGetNumDS(dm, &Nds));
1456   PetscCall(PetscCalloc1(Nf, &localDiff));
1457   for (s = 0; s < Nds; ++s) {
1458     PetscDS          ds;
1459     DMLabel          label;
1460     IS               fieldIS, pointIS;
1461     const PetscInt  *fields, *points = NULL;
1462     PetscQuadrature  quad;
1463     const PetscReal *quadPoints, *quadWeights;
1464     PetscFEGeom      fegeom;
1465     PetscReal       *coords, *gcoords;
1466     PetscScalar     *funcVal, *interpolant;
1467     PetscBool        isCohesive;
1468     PetscInt         qNc, Nq, totNc, cStart = 0, cEnd, c, dsNf;
1469 
1470     PetscCall(DMGetRegionNumDS(dm, s, &label, &fieldIS, &ds));
1471     PetscCall(ISGetIndices(fieldIS, &fields));
1472     PetscCall(PetscDSIsCohesive(ds, &isCohesive));
1473     PetscCall(PetscDSGetNumFields(ds, &dsNf));
1474     PetscCall(PetscDSGetTotalComponents(ds, &totNc));
1475     PetscCall(PetscDSGetQuadrature(ds, &quad));
1476     PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights));
1477     PetscCheckFalse((qNc != 1) && (qNc != totNc),PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, totNc);
1478     PetscCall(PetscCalloc6(totNc, &funcVal, totNc, &interpolant, dE*(Nq+1), &coords,Nq, &fegeom.detJ, dE*dE*Nq, &fegeom.J, dE*dE*Nq, &fegeom.invJ));
1479     if (!label) {
1480       PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1481     } else {
1482       PetscCall(DMLabelGetStratumIS(label, 1, &pointIS));
1483       PetscCall(ISGetLocalSize(pointIS, &cEnd));
1484       PetscCall(ISGetIndices(pointIS, &points));
1485     }
1486     for (c = cStart; c < cEnd; ++c) {
1487       const PetscInt cell  = points ? points[c] : c;
1488       PetscScalar    *x    = NULL;
1489       const PetscInt *cone;
1490       PetscInt        qc   = 0, fOff = 0, dep;
1491 
1492       PetscCall(DMLabelGetValue(depthLabel, cell, &dep));
1493       if (dep != depth-1) continue;
1494       if (isCohesive) {
1495         PetscCall(DMPlexGetCone(dm, cell, &cone));
1496         PetscCall(DMPlexComputeCellGeometryFEM(dm, cone[0], quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1497       } else {
1498         PetscCall(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1499       }
1500       PetscCall(DMPlexVecGetClosure(dm, NULL, localX, cell, NULL, &x));
1501       for (f = 0; f < dsNf; ++f) {
1502         PetscObject  obj;
1503         PetscClassId id;
1504         void * const ctx = ctxs ? ctxs[fields[f]] : NULL;
1505         PetscInt     Nb, Nc, q, fc;
1506         PetscReal    elemDiff = 0.0;
1507         PetscBool    cohesive;
1508 
1509         PetscCall(PetscDSGetCohesive(ds, f, &cohesive));
1510         if (isCohesive && !cohesive) continue;
1511         PetscCall(PetscDSGetDiscretization(ds, f, &obj));
1512         PetscCall(PetscObjectGetClassId(obj, &id));
1513         if (id == PETSCFE_CLASSID)      {PetscCall(PetscFEGetNumComponents((PetscFE) obj, &Nc));PetscCall(PetscFEGetDimension((PetscFE) obj, &Nb));}
1514         else if (id == PETSCFV_CLASSID) {PetscCall(PetscFVGetNumComponents((PetscFV) obj, &Nc));Nb = 1;}
1515         else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1516         if (debug) {
1517           char title[1024];
1518           PetscCall(PetscSNPrintf(title, 1023, "Solution for Field %D", fields[f]));
1519           PetscCall(DMPrintCellVector(cell, title, Nb, &x[fOff]));
1520         }
1521         for (q = 0; q < Nq; ++q) {
1522           PetscFEGeom qgeom;
1523 
1524           qgeom.dimEmbed = fegeom.dimEmbed;
1525           qgeom.J        = &fegeom.J[q*dE*dE];
1526           qgeom.invJ     = &fegeom.invJ[q*dE*dE];
1527           qgeom.detJ     = &fegeom.detJ[q];
1528           PetscCheck(fegeom.detJ[q] > 0.0,PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for cell %D, quadrature point %D", (double)fegeom.detJ[q], cell, q);
1529           if (transform) {
1530             gcoords = &coords[dE*Nq];
1531             PetscCall(DMPlexBasisTransformApplyReal_Internal(dm, &coords[dE*q], PETSC_TRUE, dE, &coords[dE*q], gcoords, dm->transformCtx));
1532           } else {
1533             gcoords = &coords[dE*q];
1534           }
1535           for (fc = 0; fc < Nc; ++fc) funcVal[fc] = 0.;
1536           ierr = (*funcs[fields[f]])(dE, time, gcoords, Nc, funcVal, ctx);
1537           if (ierr) {
1538             PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x));
1539             PetscCall(DMRestoreLocalVector(dm, &localX));
1540             PetscCall(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1541             PetscCall(ierr);
1542           }
1543           if (transform) PetscCall(DMPlexBasisTransformApply_Internal(dm, &coords[dE*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx));
1544           /* Call once for each face, except for lagrange field */
1545           if (id == PETSCFE_CLASSID)      PetscCall(PetscFEInterpolate_Static((PetscFE) obj, &x[fOff], &qgeom, q, interpolant));
1546           else if (id == PETSCFV_CLASSID) PetscCall(PetscFVInterpolate_Static((PetscFV) obj, &x[fOff], q, interpolant));
1547           else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1548           for (fc = 0; fc < Nc; ++fc) {
1549             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1550             if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, "    cell %D field %D,%D point %g %g %g diff %g\n", cell, fields[f], fc, (double)(dE > 0 ? coords[dE*q] : 0.), (double)(dE > 1 ? coords[dE*q+1] : 0.),(double)(dE > 2 ? coords[dE*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q])));
1551             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1552           }
1553         }
1554         fOff += Nb;
1555         qc   += Nc;
1556         localDiff[fields[f]] += elemDiff;
1557         if (debug) PetscCall(PetscPrintf(PETSC_COMM_SELF, "  cell %D field %D cum diff %g\n", cell, fields[f], (double)localDiff[fields[f]]));
1558       }
1559       PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x));
1560     }
1561     if (label) {
1562       PetscCall(ISRestoreIndices(pointIS, &points));
1563       PetscCall(ISDestroy(&pointIS));
1564     }
1565     PetscCall(ISRestoreIndices(fieldIS, &fields));
1566     PetscCall(PetscFree6(funcVal, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ));
1567   }
1568   PetscCall(DMRestoreLocalVector(dm, &localX));
1569   PetscCallMPI(MPIU_Allreduce(localDiff, diff, Nf, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm)));
1570   PetscCall(PetscFree(localDiff));
1571   for (f = 0; f < Nf; ++f) diff[f] = PetscSqrtReal(diff[f]);
1572   PetscFunctionReturn(0);
1573 }
1574 
1575 /*@C
1576   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.
1577 
1578   Collective on dm
1579 
1580   Input Parameters:
1581 + dm    - The DM
1582 . time  - The time
1583 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation
1584 . ctxs  - Optional array of contexts to pass to each function, or NULL.
1585 - X     - The coefficient vector u_h
1586 
1587   Output Parameter:
1588 . D - A Vec which holds the difference ||u - u_h||_2 for each cell
1589 
1590   Level: developer
1591 
1592 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1593 @*/
1594 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D)
1595 {
1596   PetscSection     section;
1597   PetscQuadrature  quad;
1598   Vec              localX;
1599   PetscFEGeom      fegeom;
1600   PetscScalar     *funcVal, *interpolant;
1601   PetscReal       *coords;
1602   const PetscReal *quadPoints, *quadWeights;
1603   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, c, field, fieldOffset;
1604 
1605   PetscFunctionBegin;
1606   PetscCall(VecSet(D, 0.0));
1607   PetscCall(DMGetDimension(dm, &dim));
1608   PetscCall(DMGetCoordinateDim(dm, &coordDim));
1609   PetscCall(DMGetLocalSection(dm, &section));
1610   PetscCall(PetscSectionGetNumFields(section, &numFields));
1611   PetscCall(DMGetLocalVector(dm, &localX));
1612   PetscCall(DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX));
1613   PetscCall(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1614   PetscCall(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1615   for (field = 0; field < numFields; ++field) {
1616     PetscObject  obj;
1617     PetscClassId id;
1618     PetscInt     Nc;
1619 
1620     PetscCall(DMGetField(dm, field, NULL, &obj));
1621     PetscCall(PetscObjectGetClassId(obj, &id));
1622     if (id == PETSCFE_CLASSID) {
1623       PetscFE fe = (PetscFE) obj;
1624 
1625       PetscCall(PetscFEGetQuadrature(fe, &quad));
1626       PetscCall(PetscFEGetNumComponents(fe, &Nc));
1627     } else if (id == PETSCFV_CLASSID) {
1628       PetscFV fv = (PetscFV) obj;
1629 
1630       PetscCall(PetscFVGetQuadrature(fv, &quad));
1631       PetscCall(PetscFVGetNumComponents(fv, &Nc));
1632     } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1633     numComponents += Nc;
1634   }
1635   PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights));
1636   PetscCheckFalse((qNc != 1) && (qNc != numComponents),PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1637   PetscCall(PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ));
1638   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1639   for (c = cStart; c < cEnd; ++c) {
1640     PetscScalar *x = NULL;
1641     PetscScalar  elemDiff = 0.0;
1642     PetscInt     qc = 0;
1643 
1644     PetscCall(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1645     PetscCall(DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x));
1646 
1647     for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1648       PetscObject  obj;
1649       PetscClassId id;
1650       void * const ctx = ctxs ? ctxs[field] : NULL;
1651       PetscInt     Nb, Nc, q, fc;
1652 
1653       PetscCall(DMGetField(dm, field, NULL, &obj));
1654       PetscCall(PetscObjectGetClassId(obj, &id));
1655       if (id == PETSCFE_CLASSID)      {PetscCall(PetscFEGetNumComponents((PetscFE) obj, &Nc));PetscCall(PetscFEGetDimension((PetscFE) obj, &Nb));}
1656       else if (id == PETSCFV_CLASSID) {PetscCall(PetscFVGetNumComponents((PetscFV) obj, &Nc));Nb = 1;}
1657       else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1658       if (funcs[field]) {
1659         for (q = 0; q < Nq; ++q) {
1660           PetscFEGeom qgeom;
1661 
1662           qgeom.dimEmbed = fegeom.dimEmbed;
1663           qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1664           qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1665           qgeom.detJ     = &fegeom.detJ[q];
1666           PetscCheck(fegeom.detJ[q] > 0.0,PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q);
1667           PetscCall((*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx));
1668 #if defined(needs_fix_with_return_code_argument)
1669           if (ierr) {
1670             PetscErrorCode ierr;
1671             PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1672             PetscCall(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1673             PetscCall(DMRestoreLocalVector(dm, &localX));
1674           }
1675 #endif
1676           if (id == PETSCFE_CLASSID)      PetscCall(PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant));
1677           else if (id == PETSCFV_CLASSID) PetscCall(PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant));
1678           else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1679           for (fc = 0; fc < Nc; ++fc) {
1680             const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1681             elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1682           }
1683         }
1684       }
1685       fieldOffset += Nb;
1686       qc          += Nc;
1687     }
1688     PetscCall(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1689     PetscCall(VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES));
1690   }
1691   PetscCall(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1692   PetscCall(DMRestoreLocalVector(dm, &localX));
1693   PetscCall(VecSqrtAbs(D));
1694   PetscFunctionReturn(0);
1695 }
1696 
1697 /*@
1698   DMPlexComputeClementInterpolant - This function computes the L2 projection of the cellwise values of a function u onto P1, and stores it in a Vec.
1699 
1700   Collective on dm
1701 
1702   Input Parameters:
1703 + dm - The DM
1704 - locX  - The coefficient vector u_h
1705 
1706   Output Parameter:
1707 . locC - A Vec which holds the Clement interpolant of the function
1708 
1709   Notes:
1710   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
1711 
1712   Level: developer
1713 
1714 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1715 @*/
1716 PetscErrorCode DMPlexComputeClementInterpolant(DM dm, Vec locX, Vec locC)
1717 {
1718   PetscInt         debug = ((DM_Plex *) dm->data)->printFEM;
1719   DM               dmc;
1720   PetscQuadrature  quad;
1721   PetscScalar     *interpolant, *valsum;
1722   PetscFEGeom      fegeom;
1723   PetscReal       *coords;
1724   const PetscReal *quadPoints, *quadWeights;
1725   PetscInt         dim, cdim, Nf, f, Nc = 0, Nq, qNc, cStart, cEnd, vStart, vEnd, v;
1726 
1727   PetscFunctionBegin;
1728   PetscCall(PetscCitationsRegister(ClementCitation, &Clementcite));
1729   PetscCall(VecGetDM(locC, &dmc));
1730   PetscCall(VecSet(locC, 0.0));
1731   PetscCall(DMGetDimension(dm, &dim));
1732   PetscCall(DMGetCoordinateDim(dm, &cdim));
1733   fegeom.dimEmbed = cdim;
1734   PetscCall(DMGetNumFields(dm, &Nf));
1735   PetscCheck(Nf > 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fields is zero!");
1736   for (f = 0; f < Nf; ++f) {
1737     PetscObject  obj;
1738     PetscClassId id;
1739     PetscInt     fNc;
1740 
1741     PetscCall(DMGetField(dm, f, NULL, &obj));
1742     PetscCall(PetscObjectGetClassId(obj, &id));
1743     if (id == PETSCFE_CLASSID) {
1744       PetscFE fe = (PetscFE) obj;
1745 
1746       PetscCall(PetscFEGetQuadrature(fe, &quad));
1747       PetscCall(PetscFEGetNumComponents(fe, &fNc));
1748     } else if (id == PETSCFV_CLASSID) {
1749       PetscFV fv = (PetscFV) obj;
1750 
1751       PetscCall(PetscFVGetQuadrature(fv, &quad));
1752       PetscCall(PetscFVGetNumComponents(fv, &fNc));
1753     } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
1754     Nc += fNc;
1755   }
1756   PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights));
1757   PetscCheck(qNc == 1,PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D > 1", qNc);
1758   PetscCall(PetscMalloc6(Nc*2, &valsum, Nc, &interpolant, cdim*Nq, &coords, Nq, &fegeom.detJ, cdim*cdim*Nq, &fegeom.J, cdim*cdim*Nq, &fegeom.invJ));
1759   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1760   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1761   for (v = vStart; v < vEnd; ++v) {
1762     PetscScalar volsum = 0.0;
1763     PetscInt   *star   = NULL;
1764     PetscInt    starSize, st, fc;
1765 
1766     PetscCall(PetscArrayzero(valsum, Nc));
1767     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1768     for (st = 0; st < starSize*2; st += 2) {
1769       const PetscInt cell = star[st];
1770       PetscScalar   *val  = &valsum[Nc];
1771       PetscScalar   *x    = NULL;
1772       PetscReal      vol  = 0.0;
1773       PetscInt       foff = 0;
1774 
1775       if ((cell < cStart) || (cell >= cEnd)) continue;
1776       PetscCall(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1777       PetscCall(DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x));
1778       for (f = 0; f < Nf; ++f) {
1779         PetscObject  obj;
1780         PetscClassId id;
1781         PetscInt     Nb, fNc, q;
1782 
1783         PetscCall(PetscArrayzero(val, Nc));
1784         PetscCall(DMGetField(dm, f, NULL, &obj));
1785         PetscCall(PetscObjectGetClassId(obj, &id));
1786         if (id == PETSCFE_CLASSID)      {PetscCall(PetscFEGetNumComponents((PetscFE) obj, &fNc));PetscCall(PetscFEGetDimension((PetscFE) obj, &Nb));}
1787         else if (id == PETSCFV_CLASSID) {PetscCall(PetscFVGetNumComponents((PetscFV) obj, &fNc));Nb = 1;}
1788         else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
1789         for (q = 0; q < Nq; ++q) {
1790           const PetscReal wt = quadWeights[q]*fegeom.detJ[q];
1791           PetscFEGeom     qgeom;
1792 
1793           qgeom.dimEmbed = fegeom.dimEmbed;
1794           qgeom.J        = &fegeom.J[q*cdim*cdim];
1795           qgeom.invJ     = &fegeom.invJ[q*cdim*cdim];
1796           qgeom.detJ     = &fegeom.detJ[q];
1797           PetscCheck(fegeom.detJ[q] > 0.0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double) fegeom.detJ[q], cell, q);
1798           if (id == PETSCFE_CLASSID) PetscCall(PetscFEInterpolate_Static((PetscFE) obj, &x[foff], &qgeom, q, interpolant));
1799           else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
1800           for (fc = 0; fc < fNc; ++fc) val[foff+fc] += interpolant[fc]*wt;
1801           vol += wt;
1802         }
1803         foff += Nb;
1804       }
1805       PetscCall(DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x));
1806       for (fc = 0; fc < Nc; ++fc) valsum[fc] += val[fc];
1807       volsum += vol;
1808       if (debug) {
1809         PetscCall(PetscPrintf(PETSC_COMM_SELF, "Vertex %" PetscInt_FMT " Cell %" PetscInt_FMT " value: [", v, cell));
1810         for (fc = 0; fc < Nc; ++fc) {
1811           if (fc) PetscCall(PetscPrintf(PETSC_COMM_SELF, ", "));
1812           PetscCall(PetscPrintf(PETSC_COMM_SELF, "%g", (double) PetscRealPart(val[fc])));
1813         }
1814         PetscCall(PetscPrintf(PETSC_COMM_SELF, "]\n"));
1815       }
1816     }
1817     for (fc = 0; fc < Nc; ++fc) valsum[fc] /= volsum;
1818     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1819     PetscCall(DMPlexVecSetClosure(dmc, NULL, locC, v, valsum, INSERT_VALUES));
1820   }
1821   PetscCall(PetscFree6(valsum, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ));
1822   PetscFunctionReturn(0);
1823 }
1824 
1825 /*@
1826   DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec.
1827 
1828   Collective on dm
1829 
1830   Input Parameters:
1831 + dm - The DM
1832 - locX  - The coefficient vector u_h
1833 
1834   Output Parameter:
1835 . locC - A Vec which holds the Clement interpolant of the gradient
1836 
1837   Notes:
1838   \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
1839 
1840   Level: developer
1841 
1842 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1843 @*/
1844 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC)
1845 {
1846   DM_Plex         *mesh  = (DM_Plex *) dm->data;
1847   PetscInt         debug = mesh->printFEM;
1848   DM               dmC;
1849   PetscQuadrature  quad;
1850   PetscScalar     *interpolant, *gradsum;
1851   PetscFEGeom      fegeom;
1852   PetscReal       *coords;
1853   const PetscReal *quadPoints, *quadWeights;
1854   PetscInt         dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, vStart, vEnd, v, field, fieldOffset;
1855 
1856   PetscFunctionBegin;
1857   PetscCall(PetscCitationsRegister(ClementCitation, &Clementcite));
1858   PetscCall(VecGetDM(locC, &dmC));
1859   PetscCall(VecSet(locC, 0.0));
1860   PetscCall(DMGetDimension(dm, &dim));
1861   PetscCall(DMGetCoordinateDim(dm, &coordDim));
1862   fegeom.dimEmbed = coordDim;
1863   PetscCall(DMGetNumFields(dm, &numFields));
1864   PetscCheck(numFields,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fields is zero!");
1865   for (field = 0; field < numFields; ++field) {
1866     PetscObject  obj;
1867     PetscClassId id;
1868     PetscInt     Nc;
1869 
1870     PetscCall(DMGetField(dm, field, NULL, &obj));
1871     PetscCall(PetscObjectGetClassId(obj, &id));
1872     if (id == PETSCFE_CLASSID) {
1873       PetscFE fe = (PetscFE) obj;
1874 
1875       PetscCall(PetscFEGetQuadrature(fe, &quad));
1876       PetscCall(PetscFEGetNumComponents(fe, &Nc));
1877     } else if (id == PETSCFV_CLASSID) {
1878       PetscFV fv = (PetscFV) obj;
1879 
1880       PetscCall(PetscFVGetQuadrature(fv, &quad));
1881       PetscCall(PetscFVGetNumComponents(fv, &Nc));
1882     } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1883     numComponents += Nc;
1884   }
1885   PetscCall(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights));
1886   PetscCheckFalse((qNc != 1) && (qNc != numComponents),PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1887   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));
1888   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1889   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1890   for (v = vStart; v < vEnd; ++v) {
1891     PetscScalar volsum = 0.0;
1892     PetscInt   *star   = NULL;
1893     PetscInt    starSize, st, d, fc;
1894 
1895     PetscCall(PetscArrayzero(gradsum, coordDim*numComponents));
1896     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1897     for (st = 0; st < starSize*2; st += 2) {
1898       const PetscInt cell = star[st];
1899       PetscScalar   *grad = &gradsum[coordDim*numComponents];
1900       PetscScalar   *x    = NULL;
1901       PetscReal      vol  = 0.0;
1902 
1903       if ((cell < cStart) || (cell >= cEnd)) continue;
1904       PetscCall(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1905       PetscCall(DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x));
1906       for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1907         PetscObject  obj;
1908         PetscClassId id;
1909         PetscInt     Nb, Nc, q, qc = 0;
1910 
1911         PetscCall(PetscArrayzero(grad, coordDim*numComponents));
1912         PetscCall(DMGetField(dm, field, NULL, &obj));
1913         PetscCall(PetscObjectGetClassId(obj, &id));
1914         if (id == PETSCFE_CLASSID)      {PetscCall(PetscFEGetNumComponents((PetscFE) obj, &Nc));PetscCall(PetscFEGetDimension((PetscFE) obj, &Nb));}
1915         else if (id == PETSCFV_CLASSID) {PetscCall(PetscFVGetNumComponents((PetscFV) obj, &Nc));Nb = 1;}
1916         else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1917         for (q = 0; q < Nq; ++q) {
1918           PetscFEGeom qgeom;
1919 
1920           qgeom.dimEmbed = fegeom.dimEmbed;
1921           qgeom.J        = &fegeom.J[q*coordDim*coordDim];
1922           qgeom.invJ     = &fegeom.invJ[q*coordDim*coordDim];
1923           qgeom.detJ     = &fegeom.detJ[q];
1924           PetscCheck(fegeom.detJ[q] > 0.0,PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], cell, q);
1925           if (id == PETSCFE_CLASSID)      PetscCall(PetscFEInterpolateGradient_Static((PetscFE) obj, 1, &x[fieldOffset], &qgeom, q, interpolant));
1926           else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1927           for (fc = 0; fc < Nc; ++fc) {
1928             const PetscReal wt = quadWeights[q*qNc+qc];
1929 
1930             for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*fegeom.detJ[q];
1931           }
1932           vol += quadWeights[q*qNc]*fegeom.detJ[q];
1933         }
1934         fieldOffset += Nb;
1935         qc          += Nc;
1936       }
1937       PetscCall(DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x));
1938       for (fc = 0; fc < numComponents; ++fc) {
1939         for (d = 0; d < coordDim; ++d) {
1940           gradsum[fc*coordDim+d] += grad[fc*coordDim+d];
1941         }
1942       }
1943       volsum += vol;
1944       if (debug) {
1945         PetscCall(PetscPrintf(PETSC_COMM_SELF, "Vertex %" PetscInt_FMT " Cell %" PetscInt_FMT " gradient: [", v, cell));
1946         for (fc = 0; fc < numComponents; ++fc) {
1947           for (d = 0; d < coordDim; ++d) {
1948             if (fc || d > 0) PetscCall(PetscPrintf(PETSC_COMM_SELF, ", "));
1949             PetscCall(PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d])));
1950           }
1951         }
1952         PetscCall(PetscPrintf(PETSC_COMM_SELF, "]\n"));
1953       }
1954     }
1955     for (fc = 0; fc < numComponents; ++fc) {
1956       for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum;
1957     }
1958     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1959     PetscCall(DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES));
1960   }
1961   PetscCall(PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1962   PetscFunctionReturn(0);
1963 }
1964 
1965 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user)
1966 {
1967   DM                 dmAux = NULL;
1968   PetscDS            prob,    probAux = NULL;
1969   PetscSection       section, sectionAux;
1970   Vec                locX,    locA;
1971   PetscInt           dim, numCells = cEnd - cStart, c, f;
1972   PetscBool          useFVM = PETSC_FALSE;
1973   /* DS */
1974   PetscInt           Nf,    totDim,    *uOff, *uOff_x, numConstants;
1975   PetscInt           NfAux, totDimAux, *aOff;
1976   PetscScalar       *u, *a;
1977   const PetscScalar *constants;
1978   /* Geometry */
1979   PetscFEGeom       *cgeomFEM;
1980   DM                 dmGrad;
1981   PetscQuadrature    affineQuad = NULL;
1982   Vec                cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL;
1983   PetscFVCellGeom   *cgeomFVM;
1984   const PetscScalar *lgrad;
1985   PetscInt           maxDegree;
1986   DMField            coordField;
1987   IS                 cellIS;
1988 
1989   PetscFunctionBegin;
1990   PetscCall(DMGetDS(dm, &prob));
1991   PetscCall(DMGetDimension(dm, &dim));
1992   PetscCall(DMGetLocalSection(dm, &section));
1993   PetscCall(DMGetNumFields(dm, &Nf));
1994   /* Determine which discretizations we have */
1995   for (f = 0; f < Nf; ++f) {
1996     PetscObject  obj;
1997     PetscClassId id;
1998 
1999     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
2000     PetscCall(PetscObjectGetClassId(obj, &id));
2001     if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
2002   }
2003   /* Get local solution with boundary values */
2004   PetscCall(DMGetLocalVector(dm, &locX));
2005   PetscCall(DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL));
2006   PetscCall(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX));
2007   PetscCall(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX));
2008   /* Read DS information */
2009   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
2010   PetscCall(PetscDSGetComponentOffsets(prob, &uOff));
2011   PetscCall(PetscDSGetComponentDerivativeOffsets(prob, &uOff_x));
2012   PetscCall(ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS));
2013   PetscCall(PetscDSGetConstants(prob, &numConstants, &constants));
2014   /* Read Auxiliary DS information */
2015   PetscCall(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
2016   if (locA) {
2017     PetscCall(VecGetDM(locA, &dmAux));
2018     PetscCall(DMGetDS(dmAux, &probAux));
2019     PetscCall(PetscDSGetNumFields(probAux, &NfAux));
2020     PetscCall(DMGetLocalSection(dmAux, &sectionAux));
2021     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
2022     PetscCall(PetscDSGetComponentOffsets(probAux, &aOff));
2023   }
2024   /* Allocate data  arrays */
2025   PetscCall(PetscCalloc1(numCells*totDim, &u));
2026   if (dmAux) PetscCall(PetscMalloc1(numCells*totDimAux, &a));
2027   /* Read out geometry */
2028   PetscCall(DMGetCoordinateField(dm,&coordField));
2029   PetscCall(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
2030   if (maxDegree <= 1) {
2031     PetscCall(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
2032     if (affineQuad) {
2033       PetscCall(DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM));
2034     }
2035   }
2036   if (useFVM) {
2037     PetscFV   fv = NULL;
2038     Vec       grad;
2039     PetscInt  fStart, fEnd;
2040     PetscBool compGrad;
2041 
2042     for (f = 0; f < Nf; ++f) {
2043       PetscObject  obj;
2044       PetscClassId id;
2045 
2046       PetscCall(PetscDSGetDiscretization(prob, f, &obj));
2047       PetscCall(PetscObjectGetClassId(obj, &id));
2048       if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
2049     }
2050     PetscCall(PetscFVGetComputeGradients(fv, &compGrad));
2051     PetscCall(PetscFVSetComputeGradients(fv, PETSC_TRUE));
2052     PetscCall(DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM));
2053     PetscCall(DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad));
2054     PetscCall(PetscFVSetComputeGradients(fv, compGrad));
2055     PetscCall(VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
2056     /* Reconstruct and limit cell gradients */
2057     PetscCall(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
2058     PetscCall(DMGetGlobalVector(dmGrad, &grad));
2059     PetscCall(DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad));
2060     /* Communicate gradient values */
2061     PetscCall(DMGetLocalVector(dmGrad, &locGrad));
2062     PetscCall(DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad));
2063     PetscCall(DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad));
2064     PetscCall(DMRestoreGlobalVector(dmGrad, &grad));
2065     /* Handle non-essential (e.g. outflow) boundary values */
2066     PetscCall(DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad));
2067     PetscCall(VecGetArrayRead(locGrad, &lgrad));
2068   }
2069   /* Read out data from inputs */
2070   for (c = cStart; c < cEnd; ++c) {
2071     PetscScalar *x = NULL;
2072     PetscInt     i;
2073 
2074     PetscCall(DMPlexVecGetClosure(dm, section, locX, c, NULL, &x));
2075     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
2076     PetscCall(DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x));
2077     if (dmAux) {
2078       PetscCall(DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x));
2079       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
2080       PetscCall(DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x));
2081     }
2082   }
2083   /* Do integration for each field */
2084   for (f = 0; f < Nf; ++f) {
2085     PetscObject  obj;
2086     PetscClassId id;
2087     PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
2088 
2089     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
2090     PetscCall(PetscObjectGetClassId(obj, &id));
2091     if (id == PETSCFE_CLASSID) {
2092       PetscFE         fe = (PetscFE) obj;
2093       PetscQuadrature q;
2094       PetscFEGeom     *chunkGeom = NULL;
2095       PetscInt        Nq, Nb;
2096 
2097       PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
2098       PetscCall(PetscFEGetQuadrature(fe, &q));
2099       PetscCall(PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL));
2100       PetscCall(PetscFEGetDimension(fe, &Nb));
2101       blockSize = Nb*Nq;
2102       batchSize = numBlocks * blockSize;
2103       PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
2104       numChunks = numCells / (numBatches*batchSize);
2105       Ne        = numChunks*numBatches*batchSize;
2106       Nr        = numCells % (numBatches*batchSize);
2107       offset    = numCells - Nr;
2108       if (!affineQuad) {
2109         PetscCall(DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM));
2110       }
2111       PetscCall(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
2112       PetscCall(PetscFEIntegrate(prob, f, Ne, chunkGeom, u, probAux, a, cintegral));
2113       PetscCall(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom));
2114       PetscCall(PetscFEIntegrate(prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]));
2115       PetscCall(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom));
2116       if (!affineQuad) {
2117         PetscCall(PetscFEGeomDestroy(&cgeomFEM));
2118       }
2119     } else if (id == PETSCFV_CLASSID) {
2120       PetscInt       foff;
2121       PetscPointFunc obj_func;
2122       PetscScalar    lint;
2123 
2124       PetscCall(PetscDSGetObjective(prob, f, &obj_func));
2125       PetscCall(PetscDSGetFieldOffset(prob, f, &foff));
2126       if (obj_func) {
2127         for (c = 0; c < numCells; ++c) {
2128           PetscScalar *u_x;
2129 
2130           PetscCall(DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x));
2131           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);
2132           cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume;
2133         }
2134       }
2135     } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
2136   }
2137   /* Cleanup data arrays */
2138   if (useFVM) {
2139     PetscCall(VecRestoreArrayRead(locGrad, &lgrad));
2140     PetscCall(VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
2141     PetscCall(DMRestoreLocalVector(dmGrad, &locGrad));
2142     PetscCall(VecDestroy(&faceGeometryFVM));
2143     PetscCall(VecDestroy(&cellGeometryFVM));
2144     PetscCall(DMDestroy(&dmGrad));
2145   }
2146   if (dmAux) PetscCall(PetscFree(a));
2147   PetscCall(PetscFree(u));
2148   /* Cleanup */
2149   if (affineQuad) {
2150     PetscCall(PetscFEGeomDestroy(&cgeomFEM));
2151   }
2152   PetscCall(PetscQuadratureDestroy(&affineQuad));
2153   PetscCall(ISDestroy(&cellIS));
2154   PetscCall(DMRestoreLocalVector(dm, &locX));
2155   PetscFunctionReturn(0);
2156 }
2157 
2158 /*@
2159   DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user
2160 
2161   Input Parameters:
2162 + dm - The mesh
2163 . X  - Global input vector
2164 - user - The user context
2165 
2166   Output Parameter:
2167 . integral - Integral for each field
2168 
2169   Level: developer
2170 
2171 .seealso: DMPlexSNESComputeResidualFEM()
2172 @*/
2173 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user)
2174 {
2175   DM_Plex       *mesh = (DM_Plex *) dm->data;
2176   PetscScalar   *cintegral, *lintegral;
2177   PetscInt       Nf, f, cellHeight, cStart, cEnd, cell;
2178 
2179   PetscFunctionBegin;
2180   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2181   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2182   PetscValidScalarPointer(integral, 3);
2183   PetscCall(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2184   PetscCall(DMGetNumFields(dm, &Nf));
2185   PetscCall(DMPlexGetVTKCellHeight(dm, &cellHeight));
2186   PetscCall(DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd));
2187   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2188   PetscCall(PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral));
2189   PetscCall(DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user));
2190   /* Sum up values */
2191   for (cell = cStart; cell < cEnd; ++cell) {
2192     const PetscInt c = cell - cStart;
2193 
2194     if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]));
2195     for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
2196   }
2197   PetscCallMPI(MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm)));
2198   if (mesh->printFEM) {
2199     PetscCall(PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:"));
2200     for (f = 0; f < Nf; ++f) PetscCall(PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f])));
2201     PetscCall(PetscPrintf(PetscObjectComm((PetscObject) dm), "\n"));
2202   }
2203   PetscCall(PetscFree2(lintegral, cintegral));
2204   PetscCall(PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0));
2205   PetscFunctionReturn(0);
2206 }
2207 
2208 /*@
2209   DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user
2210 
2211   Input Parameters:
2212 + dm - The mesh
2213 . X  - Global input vector
2214 - user - The user context
2215 
2216   Output Parameter:
2217 . integral - Cellwise integrals for each field
2218 
2219   Level: developer
2220 
2221 .seealso: DMPlexSNESComputeResidualFEM()
2222 @*/
2223 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user)
2224 {
2225   DM_Plex       *mesh = (DM_Plex *) dm->data;
2226   DM             dmF;
2227   PetscSection   sectionF;
2228   PetscScalar   *cintegral, *af;
2229   PetscInt       Nf, f, cellHeight, cStart, cEnd, cell;
2230 
2231   PetscFunctionBegin;
2232   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2233   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2234   PetscValidHeaderSpecific(F, VEC_CLASSID, 3);
2235   PetscCall(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2236   PetscCall(DMGetNumFields(dm, &Nf));
2237   PetscCall(DMPlexGetVTKCellHeight(dm, &cellHeight));
2238   PetscCall(DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd));
2239   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2240   PetscCall(PetscCalloc1((cEnd-cStart)*Nf, &cintegral));
2241   PetscCall(DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user));
2242   /* Put values in F*/
2243   PetscCall(VecGetDM(F, &dmF));
2244   PetscCall(DMGetLocalSection(dmF, &sectionF));
2245   PetscCall(VecGetArray(F, &af));
2246   for (cell = cStart; cell < cEnd; ++cell) {
2247     const PetscInt c = cell - cStart;
2248     PetscInt       dof, off;
2249 
2250     if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]));
2251     PetscCall(PetscSectionGetDof(sectionF, cell, &dof));
2252     PetscCall(PetscSectionGetOffset(sectionF, cell, &off));
2253     PetscCheck(dof == Nf,PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf);
2254     for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f];
2255   }
2256   PetscCall(VecRestoreArray(F, &af));
2257   PetscCall(PetscFree(cintegral));
2258   PetscCall(PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0));
2259   PetscFunctionReturn(0);
2260 }
2261 
2262 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS,
2263                                                        void (*func)(PetscInt, PetscInt, PetscInt,
2264                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2265                                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2266                                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2267                                                        PetscScalar *fintegral, void *user)
2268 {
2269   DM                 plex = NULL, plexA = NULL;
2270   DMEnclosureType    encAux;
2271   PetscDS            prob, probAux = NULL;
2272   PetscSection       section, sectionAux = NULL;
2273   Vec                locA = NULL;
2274   DMField            coordField;
2275   PetscInt           Nf,        totDim,        *uOff, *uOff_x;
2276   PetscInt           NfAux = 0, totDimAux = 0, *aOff = NULL;
2277   PetscScalar       *u, *a = NULL;
2278   const PetscScalar *constants;
2279   PetscInt           numConstants, f;
2280 
2281   PetscFunctionBegin;
2282   PetscCall(DMGetCoordinateField(dm, &coordField));
2283   PetscCall(DMConvert(dm, DMPLEX, &plex));
2284   PetscCall(DMGetDS(dm, &prob));
2285   PetscCall(DMGetLocalSection(dm, &section));
2286   PetscCall(PetscSectionGetNumFields(section, &Nf));
2287   /* Determine which discretizations we have */
2288   for (f = 0; f < Nf; ++f) {
2289     PetscObject  obj;
2290     PetscClassId id;
2291 
2292     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
2293     PetscCall(PetscObjectGetClassId(obj, &id));
2294     PetscCheck(id != PETSCFV_CLASSID,PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f);
2295   }
2296   /* Read DS information */
2297   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
2298   PetscCall(PetscDSGetComponentOffsets(prob, &uOff));
2299   PetscCall(PetscDSGetComponentDerivativeOffsets(prob, &uOff_x));
2300   PetscCall(PetscDSGetConstants(prob, &numConstants, &constants));
2301   /* Read Auxiliary DS information */
2302   PetscCall(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
2303   if (locA) {
2304     DM dmAux;
2305 
2306     PetscCall(VecGetDM(locA, &dmAux));
2307     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
2308     PetscCall(DMConvert(dmAux, DMPLEX, &plexA));
2309     PetscCall(DMGetDS(dmAux, &probAux));
2310     PetscCall(PetscDSGetNumFields(probAux, &NfAux));
2311     PetscCall(DMGetLocalSection(dmAux, &sectionAux));
2312     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
2313     PetscCall(PetscDSGetComponentOffsets(probAux, &aOff));
2314   }
2315   /* Integrate over points */
2316   {
2317     PetscFEGeom    *fgeom, *chunkGeom = NULL;
2318     PetscInt        maxDegree;
2319     PetscQuadrature qGeom = NULL;
2320     const PetscInt *points;
2321     PetscInt        numFaces, face, Nq, field;
2322     PetscInt        numChunks, chunkSize, chunk, Nr, offset;
2323 
2324     PetscCall(ISGetLocalSize(pointIS, &numFaces));
2325     PetscCall(ISGetIndices(pointIS, &points));
2326     PetscCall(PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a));
2327     PetscCall(DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree));
2328     for (field = 0; field < Nf; ++field) {
2329       PetscFE fe;
2330 
2331       PetscCall(PetscDSGetDiscretization(prob, field, (PetscObject *) &fe));
2332       if (maxDegree <= 1) PetscCall(DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom));
2333       if (!qGeom) {
2334         PetscCall(PetscFEGetFaceQuadrature(fe, &qGeom));
2335         PetscCall(PetscObjectReference((PetscObject) qGeom));
2336       }
2337       PetscCall(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
2338       PetscCall(DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom));
2339       for (face = 0; face < numFaces; ++face) {
2340         const PetscInt point = points[face], *support;
2341         PetscScalar    *x    = NULL;
2342         PetscInt       i;
2343 
2344         PetscCall(DMPlexGetSupport(dm, point, &support));
2345         PetscCall(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
2346         for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
2347         PetscCall(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
2348         if (locA) {
2349           PetscInt subp;
2350           PetscCall(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
2351           PetscCall(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
2352           for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
2353           PetscCall(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x));
2354         }
2355       }
2356       /* Get blocking */
2357       {
2358         PetscQuadrature q;
2359         PetscInt        numBatches, batchSize, numBlocks, blockSize;
2360         PetscInt        Nq, Nb;
2361 
2362         PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
2363         PetscCall(PetscFEGetQuadrature(fe, &q));
2364         PetscCall(PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL));
2365         PetscCall(PetscFEGetDimension(fe, &Nb));
2366         blockSize = Nb*Nq;
2367         batchSize = numBlocks * blockSize;
2368         chunkSize = numBatches*batchSize;
2369         PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
2370         numChunks = numFaces / chunkSize;
2371         Nr        = numFaces % chunkSize;
2372         offset    = numFaces - Nr;
2373       }
2374       /* Do integration for each field */
2375       for (chunk = 0; chunk < numChunks; ++chunk) {
2376         PetscCall(PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom));
2377         PetscCall(PetscFEIntegrateBd(prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral));
2378         PetscCall(PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom));
2379       }
2380       PetscCall(PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom));
2381       PetscCall(PetscFEIntegrateBd(prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]));
2382       PetscCall(PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom));
2383       /* Cleanup data arrays */
2384       PetscCall(DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom));
2385       PetscCall(PetscQuadratureDestroy(&qGeom));
2386       PetscCall(PetscFree2(u, a));
2387       PetscCall(ISRestoreIndices(pointIS, &points));
2388     }
2389   }
2390   if (plex)  PetscCall(DMDestroy(&plex));
2391   if (plexA) PetscCall(DMDestroy(&plexA));
2392   PetscFunctionReturn(0);
2393 }
2394 
2395 /*@
2396   DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user
2397 
2398   Input Parameters:
2399 + dm      - The mesh
2400 . X       - Global input vector
2401 . label   - The boundary DMLabel
2402 . numVals - The number of label values to use, or PETSC_DETERMINE for all values
2403 . vals    - The label values to use, or PETSC_NULL for all values
2404 . func    - The function to integrate along the boundary
2405 - user    - The user context
2406 
2407   Output Parameter:
2408 . integral - Integral for each field
2409 
2410   Level: developer
2411 
2412 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM()
2413 @*/
2414 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[],
2415                                        void (*func)(PetscInt, PetscInt, PetscInt,
2416                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2417                                                     const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2418                                                     PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2419                                        PetscScalar *integral, void *user)
2420 {
2421   Vec            locX;
2422   PetscSection   section;
2423   DMLabel        depthLabel;
2424   IS             facetIS;
2425   PetscInt       dim, Nf, f, v;
2426 
2427   PetscFunctionBegin;
2428   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2429   PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2430   PetscValidPointer(label, 3);
2431   if (vals) PetscValidIntPointer(vals, 5);
2432   PetscValidScalarPointer(integral, 7);
2433   PetscCall(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2434   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
2435   PetscCall(DMGetDimension(dm, &dim));
2436   PetscCall(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
2437   PetscCall(DMGetLocalSection(dm, &section));
2438   PetscCall(PetscSectionGetNumFields(section, &Nf));
2439   /* Get local solution with boundary values */
2440   PetscCall(DMGetLocalVector(dm, &locX));
2441   PetscCall(DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL));
2442   PetscCall(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX));
2443   PetscCall(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX));
2444   /* Loop over label values */
2445   PetscCall(PetscArrayzero(integral, Nf));
2446   for (v = 0; v < numVals; ++v) {
2447     IS           pointIS;
2448     PetscInt     numFaces, face;
2449     PetscScalar *fintegral;
2450 
2451     PetscCall(DMLabelGetStratumIS(label, vals[v], &pointIS));
2452     if (!pointIS) continue; /* No points with that id on this process */
2453     {
2454       IS isectIS;
2455 
2456       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
2457       PetscCall(ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS));
2458       PetscCall(ISDestroy(&pointIS));
2459       pointIS = isectIS;
2460     }
2461     PetscCall(ISGetLocalSize(pointIS, &numFaces));
2462     PetscCall(PetscCalloc1(numFaces*Nf, &fintegral));
2463     PetscCall(DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user));
2464     /* Sum point contributions into integral */
2465     for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f];
2466     PetscCall(PetscFree(fintegral));
2467     PetscCall(ISDestroy(&pointIS));
2468   }
2469   PetscCall(DMRestoreLocalVector(dm, &locX));
2470   PetscCall(ISDestroy(&facetIS));
2471   PetscCall(PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0));
2472   PetscFunctionReturn(0);
2473 }
2474 
2475 /*@
2476   DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to a uniformly refined DM.
2477 
2478   Input Parameters:
2479 + dmc  - The coarse mesh
2480 . dmf  - The fine mesh
2481 . isRefined - Flag indicating regular refinement, rather than the same topology
2482 - user - The user context
2483 
2484   Output Parameter:
2485 . In  - The interpolation matrix
2486 
2487   Level: developer
2488 
2489 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2490 @*/
2491 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, PetscBool isRefined, Mat In, void *user)
2492 {
2493   DM_Plex          *mesh  = (DM_Plex *) dmc->data;
2494   const char       *name  = "Interpolator";
2495   PetscFE          *feRef;
2496   PetscFV          *fvRef;
2497   PetscSection      fsection, fglobalSection;
2498   PetscSection      csection, cglobalSection;
2499   PetscScalar      *elemMat;
2500   PetscInt          dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, c;
2501   PetscInt          cTotDim=0, rTotDim = 0;
2502 
2503   PetscFunctionBegin;
2504   PetscCall(PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2505   PetscCall(DMGetDimension(dmf, &dim));
2506   PetscCall(DMGetLocalSection(dmf, &fsection));
2507   PetscCall(DMGetGlobalSection(dmf, &fglobalSection));
2508   PetscCall(DMGetLocalSection(dmc, &csection));
2509   PetscCall(DMGetGlobalSection(dmc, &cglobalSection));
2510   PetscCall(PetscSectionGetNumFields(fsection, &Nf));
2511   PetscCall(DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd));
2512   PetscCall(PetscCalloc2(Nf, &feRef, Nf, &fvRef));
2513   for (f = 0; f < Nf; ++f) {
2514     PetscObject  obj, objc;
2515     PetscClassId id, idc;
2516     PetscInt     rNb = 0, Nc = 0, cNb = 0;
2517 
2518     PetscCall(DMGetField(dmf, f, NULL, &obj));
2519     PetscCall(PetscObjectGetClassId(obj, &id));
2520     if (id == PETSCFE_CLASSID) {
2521       PetscFE fe = (PetscFE) obj;
2522 
2523       if (isRefined) {
2524         PetscCall(PetscFERefine(fe, &feRef[f]));
2525       } else {
2526         PetscCall(PetscObjectReference((PetscObject) fe));
2527         feRef[f] = fe;
2528       }
2529       PetscCall(PetscFEGetDimension(feRef[f], &rNb));
2530       PetscCall(PetscFEGetNumComponents(fe, &Nc));
2531     } else if (id == PETSCFV_CLASSID) {
2532       PetscFV        fv = (PetscFV) obj;
2533       PetscDualSpace Q;
2534 
2535       if (isRefined) {
2536         PetscCall(PetscFVRefine(fv, &fvRef[f]));
2537       } else {
2538         PetscCall(PetscObjectReference((PetscObject) fv));
2539         fvRef[f] = fv;
2540       }
2541       PetscCall(PetscFVGetDualSpace(fvRef[f], &Q));
2542       PetscCall(PetscDualSpaceGetDimension(Q, &rNb));
2543       PetscCall(PetscFVGetDualSpace(fv, &Q));
2544       PetscCall(PetscFVGetNumComponents(fv, &Nc));
2545     }
2546     PetscCall(DMGetField(dmc, f, NULL, &objc));
2547     PetscCall(PetscObjectGetClassId(objc, &idc));
2548     if (idc == PETSCFE_CLASSID) {
2549       PetscFE fe = (PetscFE) objc;
2550 
2551       PetscCall(PetscFEGetDimension(fe, &cNb));
2552     } else if (id == PETSCFV_CLASSID) {
2553       PetscFV        fv = (PetscFV) obj;
2554       PetscDualSpace Q;
2555 
2556       PetscCall(PetscFVGetDualSpace(fv, &Q));
2557       PetscCall(PetscDualSpaceGetDimension(Q, &cNb));
2558     }
2559     rTotDim += rNb;
2560     cTotDim += cNb;
2561   }
2562   PetscCall(PetscMalloc1(rTotDim*cTotDim,&elemMat));
2563   PetscCall(PetscArrayzero(elemMat, rTotDim*cTotDim));
2564   for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) {
2565     PetscDualSpace   Qref;
2566     PetscQuadrature  f;
2567     const PetscReal *qpoints, *qweights;
2568     PetscReal       *points;
2569     PetscInt         npoints = 0, Nc, Np, fpdim, i, k, p, d;
2570 
2571     /* Compose points from all dual basis functionals */
2572     if (feRef[fieldI]) {
2573       PetscCall(PetscFEGetDualSpace(feRef[fieldI], &Qref));
2574       PetscCall(PetscFEGetNumComponents(feRef[fieldI], &Nc));
2575     } else {
2576       PetscCall(PetscFVGetDualSpace(fvRef[fieldI], &Qref));
2577       PetscCall(PetscFVGetNumComponents(fvRef[fieldI], &Nc));
2578     }
2579     PetscCall(PetscDualSpaceGetDimension(Qref, &fpdim));
2580     for (i = 0; i < fpdim; ++i) {
2581       PetscCall(PetscDualSpaceGetFunctional(Qref, i, &f));
2582       PetscCall(PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL));
2583       npoints += Np;
2584     }
2585     PetscCall(PetscMalloc1(npoints*dim,&points));
2586     for (i = 0, k = 0; i < fpdim; ++i) {
2587       PetscCall(PetscDualSpaceGetFunctional(Qref, i, &f));
2588       PetscCall(PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL));
2589       for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d];
2590     }
2591 
2592     for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) {
2593       PetscObject  obj;
2594       PetscClassId id;
2595       PetscInt     NcJ = 0, cpdim = 0, j, qNc;
2596 
2597       PetscCall(DMGetField(dmc, fieldJ, NULL, &obj));
2598       PetscCall(PetscObjectGetClassId(obj, &id));
2599       if (id == PETSCFE_CLASSID) {
2600         PetscFE           fe = (PetscFE) obj;
2601         PetscTabulation T  = NULL;
2602 
2603         /* Evaluate basis at points */
2604         PetscCall(PetscFEGetNumComponents(fe, &NcJ));
2605         PetscCall(PetscFEGetDimension(fe, &cpdim));
2606         /* For now, fields only interpolate themselves */
2607         if (fieldI == fieldJ) {
2608           PetscCheck(Nc == NcJ,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ);
2609           PetscCall(PetscFECreateTabulation(fe, 1, npoints, points, 0, &T));
2610           for (i = 0, k = 0; i < fpdim; ++i) {
2611             PetscCall(PetscDualSpaceGetFunctional(Qref, i, &f));
2612             PetscCall(PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights));
2613             PetscCheck(qNc == NcJ,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
2614             for (p = 0; p < Np; ++p, ++k) {
2615               for (j = 0; j < cpdim; ++j) {
2616                 /*
2617                    cTotDim:            Total columns in element interpolation matrix, sum of number of dual basis functionals in each field
2618                    offsetI, offsetJ:   Offsets into the larger element interpolation matrix for different fields
2619                    fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals
2620                    qNC, Nc, Ncj, c:    Number of components in this field
2621                    Np, p:              Number of quad points in the fine grid functional i
2622                    k:                  i*Np + p, overall point number for the interpolation
2623                 */
2624                 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];
2625               }
2626             }
2627           }
2628           PetscCall(PetscTabulationDestroy(&T));
2629         }
2630       } else if (id == PETSCFV_CLASSID) {
2631         PetscFV        fv = (PetscFV) obj;
2632 
2633         /* Evaluate constant function at points */
2634         PetscCall(PetscFVGetNumComponents(fv, &NcJ));
2635         cpdim = 1;
2636         /* For now, fields only interpolate themselves */
2637         if (fieldI == fieldJ) {
2638           PetscCheck(Nc == NcJ,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ);
2639           for (i = 0, k = 0; i < fpdim; ++i) {
2640             PetscCall(PetscDualSpaceGetFunctional(Qref, i, &f));
2641             PetscCall(PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights));
2642             PetscCheck(qNc == NcJ,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
2643             for (p = 0; p < Np; ++p, ++k) {
2644               for (j = 0; j < cpdim; ++j) {
2645                 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c];
2646               }
2647             }
2648           }
2649         }
2650       }
2651       offsetJ += cpdim;
2652     }
2653     offsetI += fpdim;
2654     PetscCall(PetscFree(points));
2655   }
2656   if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat));
2657   /* Preallocate matrix */
2658   {
2659     Mat          preallocator;
2660     PetscScalar *vals;
2661     PetscInt    *cellCIndices, *cellFIndices;
2662     PetscInt     locRows, locCols, cell;
2663 
2664     PetscCall(MatGetLocalSize(In, &locRows, &locCols));
2665     PetscCall(MatCreate(PetscObjectComm((PetscObject) In), &preallocator));
2666     PetscCall(MatSetType(preallocator, MATPREALLOCATOR));
2667     PetscCall(MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE));
2668     PetscCall(MatSetUp(preallocator));
2669     PetscCall(PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices));
2670     for (cell = cStart; cell < cEnd; ++cell) {
2671       if (isRefined) {
2672         PetscCall(DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices));
2673         PetscCall(MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES));
2674       } else {
2675         PetscCall(DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, preallocator, cell, vals, INSERT_VALUES));
2676       }
2677     }
2678     PetscCall(PetscFree3(vals,cellCIndices,cellFIndices));
2679     PetscCall(MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY));
2680     PetscCall(MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY));
2681     PetscCall(MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In));
2682     PetscCall(MatDestroy(&preallocator));
2683   }
2684   /* Fill matrix */
2685   PetscCall(MatZeroEntries(In));
2686   for (c = cStart; c < cEnd; ++c) {
2687     if (isRefined) {
2688       PetscCall(DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES));
2689     } else {
2690       PetscCall(DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES));
2691     }
2692   }
2693   for (f = 0; f < Nf; ++f) PetscCall(PetscFEDestroy(&feRef[f]));
2694   PetscCall(PetscFree2(feRef,fvRef));
2695   PetscCall(PetscFree(elemMat));
2696   PetscCall(MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY));
2697   PetscCall(MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY));
2698   if (mesh->printFEM > 1) {
2699     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name));
2700     PetscCall(MatChop(In, 1.0e-10));
2701     PetscCall(MatView(In, NULL));
2702   }
2703   PetscCall(PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2704   PetscFunctionReturn(0);
2705 }
2706 
2707 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user)
2708 {
2709   SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness");
2710 }
2711 
2712 /*@
2713   DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM.
2714 
2715   Input Parameters:
2716 + dmf  - The fine mesh
2717 . dmc  - The coarse mesh
2718 - user - The user context
2719 
2720   Output Parameter:
2721 . In  - The interpolation matrix
2722 
2723   Level: developer
2724 
2725 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
2726 @*/
2727 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user)
2728 {
2729   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2730   const char    *name = "Interpolator";
2731   PetscDS        prob;
2732   PetscSection   fsection, csection, globalFSection, globalCSection;
2733   PetscHSetIJ    ht;
2734   PetscLayout    rLayout;
2735   PetscInt      *dnz, *onz;
2736   PetscInt       locRows, rStart, rEnd;
2737   PetscReal     *x, *v0, *J, *invJ, detJ;
2738   PetscReal     *v0c, *Jc, *invJc, detJc;
2739   PetscScalar   *elemMat;
2740   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2741 
2742   PetscFunctionBegin;
2743   PetscCall(PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2744   PetscCall(DMGetCoordinateDim(dmc, &dim));
2745   PetscCall(DMGetDS(dmc, &prob));
2746   PetscCall(PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL));
2747   PetscCall(PetscDSGetNumFields(prob, &Nf));
2748   PetscCall(PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ));
2749   PetscCall(PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc));
2750   PetscCall(DMGetLocalSection(dmf, &fsection));
2751   PetscCall(DMGetGlobalSection(dmf, &globalFSection));
2752   PetscCall(DMGetLocalSection(dmc, &csection));
2753   PetscCall(DMGetGlobalSection(dmc, &globalCSection));
2754   PetscCall(DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd));
2755   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
2756   PetscCall(PetscMalloc1(totDim, &elemMat));
2757 
2758   PetscCall(MatGetLocalSize(In, &locRows, NULL));
2759   PetscCall(PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout));
2760   PetscCall(PetscLayoutSetLocalSize(rLayout, locRows));
2761   PetscCall(PetscLayoutSetBlockSize(rLayout, 1));
2762   PetscCall(PetscLayoutSetUp(rLayout));
2763   PetscCall(PetscLayoutGetRange(rLayout, &rStart, &rEnd));
2764   PetscCall(PetscLayoutDestroy(&rLayout));
2765   PetscCall(PetscCalloc2(locRows,&dnz,locRows,&onz));
2766   PetscCall(PetscHSetIJCreate(&ht));
2767   for (field = 0; field < Nf; ++field) {
2768     PetscObject      obj;
2769     PetscClassId     id;
2770     PetscDualSpace   Q = NULL;
2771     PetscQuadrature  f;
2772     const PetscReal *qpoints;
2773     PetscInt         Nc, Np, fpdim, i, d;
2774 
2775     PetscCall(PetscDSGetDiscretization(prob, field, &obj));
2776     PetscCall(PetscObjectGetClassId(obj, &id));
2777     if (id == PETSCFE_CLASSID) {
2778       PetscFE fe = (PetscFE) obj;
2779 
2780       PetscCall(PetscFEGetDualSpace(fe, &Q));
2781       PetscCall(PetscFEGetNumComponents(fe, &Nc));
2782     } else if (id == PETSCFV_CLASSID) {
2783       PetscFV fv = (PetscFV) obj;
2784 
2785       PetscCall(PetscFVGetDualSpace(fv, &Q));
2786       Nc   = 1;
2787     }
2788     PetscCall(PetscDualSpaceGetDimension(Q, &fpdim));
2789     /* For each fine grid cell */
2790     for (cell = cStart; cell < cEnd; ++cell) {
2791       PetscInt *findices,   *cindices;
2792       PetscInt  numFIndices, numCIndices;
2793 
2794       PetscCall(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2795       PetscCall(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
2796       PetscCheck(numFIndices == fpdim,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2797       for (i = 0; i < fpdim; ++i) {
2798         Vec             pointVec;
2799         PetscScalar    *pV;
2800         PetscSF         coarseCellSF = NULL;
2801         const PetscSFNode *coarseCells;
2802         PetscInt        numCoarseCells, q, c;
2803 
2804         /* Get points from the dual basis functional quadrature */
2805         PetscCall(PetscDualSpaceGetFunctional(Q, i, &f));
2806         PetscCall(PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL));
2807         PetscCall(VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec));
2808         PetscCall(VecSetBlockSize(pointVec, dim));
2809         PetscCall(VecGetArray(pointVec, &pV));
2810         for (q = 0; q < Np; ++q) {
2811           const PetscReal xi0[3] = {-1., -1., -1.};
2812 
2813           /* Transform point to real space */
2814           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2815           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2816         }
2817         PetscCall(VecRestoreArray(pointVec, &pV));
2818         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2819         /* OPT: Pack all quad points from fine cell */
2820         PetscCall(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
2821         PetscCall(PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view"));
2822         /* Update preallocation info */
2823         PetscCall(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
2824         PetscCheck(numCoarseCells == Np,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2825         {
2826           PetscHashIJKey key;
2827           PetscBool      missing;
2828 
2829           key.i = findices[i];
2830           if (key.i >= 0) {
2831             /* Get indices for coarse elements */
2832             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2833               PetscCall(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2834               for (c = 0; c < numCIndices; ++c) {
2835                 key.j = cindices[c];
2836                 if (key.j < 0) continue;
2837                 PetscCall(PetscHSetIJQueryAdd(ht, key, &missing));
2838                 if (missing) {
2839                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2840                   else                                     ++onz[key.i-rStart];
2841                 }
2842               }
2843               PetscCall(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2844             }
2845           }
2846         }
2847         PetscCall(PetscSFDestroy(&coarseCellSF));
2848         PetscCall(VecDestroy(&pointVec));
2849       }
2850       PetscCall(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2851     }
2852   }
2853   PetscCall(PetscHSetIJDestroy(&ht));
2854   PetscCall(MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL));
2855   PetscCall(MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
2856   PetscCall(PetscFree2(dnz,onz));
2857   for (field = 0; field < Nf; ++field) {
2858     PetscObject       obj;
2859     PetscClassId      id;
2860     PetscDualSpace    Q = NULL;
2861     PetscTabulation T = NULL;
2862     PetscQuadrature   f;
2863     const PetscReal  *qpoints, *qweights;
2864     PetscInt          Nc, qNc, Np, fpdim, i, d;
2865 
2866     PetscCall(PetscDSGetDiscretization(prob, field, &obj));
2867     PetscCall(PetscObjectGetClassId(obj, &id));
2868     if (id == PETSCFE_CLASSID) {
2869       PetscFE fe = (PetscFE) obj;
2870 
2871       PetscCall(PetscFEGetDualSpace(fe, &Q));
2872       PetscCall(PetscFEGetNumComponents(fe, &Nc));
2873       PetscCall(PetscFECreateTabulation(fe, 1, 1, x, 0, &T));
2874     } else if (id == PETSCFV_CLASSID) {
2875       PetscFV fv = (PetscFV) obj;
2876 
2877       PetscCall(PetscFVGetDualSpace(fv, &Q));
2878       Nc   = 1;
2879     } else SETERRQ(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %D",field);
2880     PetscCall(PetscDualSpaceGetDimension(Q, &fpdim));
2881     /* For each fine grid cell */
2882     for (cell = cStart; cell < cEnd; ++cell) {
2883       PetscInt *findices,   *cindices;
2884       PetscInt  numFIndices, numCIndices;
2885 
2886       PetscCall(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2887       PetscCall(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
2888       PetscCheck(numFIndices == fpdim,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2889       for (i = 0; i < fpdim; ++i) {
2890         Vec             pointVec;
2891         PetscScalar    *pV;
2892         PetscSF         coarseCellSF = NULL;
2893         const PetscSFNode *coarseCells;
2894         PetscInt        numCoarseCells, cpdim, q, c, j;
2895 
2896         /* Get points from the dual basis functional quadrature */
2897         PetscCall(PetscDualSpaceGetFunctional(Q, i, &f));
2898         PetscCall(PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights));
2899         PetscCheck(qNc == Nc,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, Nc);
2900         PetscCall(VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec));
2901         PetscCall(VecSetBlockSize(pointVec, dim));
2902         PetscCall(VecGetArray(pointVec, &pV));
2903         for (q = 0; q < Np; ++q) {
2904           const PetscReal xi0[3] = {-1., -1., -1.};
2905 
2906           /* Transform point to real space */
2907           CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2908           for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2909         }
2910         PetscCall(VecRestoreArray(pointVec, &pV));
2911         /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2912         /* OPT: Read this out from preallocation information */
2913         PetscCall(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
2914         /* Update preallocation info */
2915         PetscCall(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
2916         PetscCheck(numCoarseCells == Np,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2917         PetscCall(VecGetArray(pointVec, &pV));
2918         for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2919           PetscReal pVReal[3];
2920           const PetscReal xi0[3] = {-1., -1., -1.};
2921 
2922           PetscCall(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2923           /* Transform points from real space to coarse reference space */
2924           PetscCall(DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc));
2925           for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2926           CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
2927 
2928           if (id == PETSCFE_CLASSID) {
2929             PetscFE fe = (PetscFE) obj;
2930 
2931             /* Evaluate coarse basis on contained point */
2932             PetscCall(PetscFEGetDimension(fe, &cpdim));
2933             PetscCall(PetscFEComputeTabulation(fe, 1, x, 0, T));
2934             PetscCall(PetscArrayzero(elemMat, cpdim));
2935             /* Get elemMat entries by multiplying by weight */
2936             for (j = 0; j < cpdim; ++j) {
2937               for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*qweights[ccell*qNc + c];
2938             }
2939           } else {
2940             cpdim = 1;
2941             for (j = 0; j < cpdim; ++j) {
2942               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c];
2943             }
2944           }
2945           /* Update interpolator */
2946           if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat));
2947           PetscCheck(numCIndices == cpdim,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2948           PetscCall(MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES));
2949           PetscCall(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2950         }
2951         PetscCall(VecRestoreArray(pointVec, &pV));
2952         PetscCall(PetscSFDestroy(&coarseCellSF));
2953         PetscCall(VecDestroy(&pointVec));
2954       }
2955       PetscCall(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2956     }
2957     if (id == PETSCFE_CLASSID) PetscCall(PetscTabulationDestroy(&T));
2958   }
2959   PetscCall(PetscFree3(v0,J,invJ));
2960   PetscCall(PetscFree3(v0c,Jc,invJc));
2961   PetscCall(PetscFree(elemMat));
2962   PetscCall(MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY));
2963   PetscCall(MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY));
2964   PetscCall(PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2965   PetscFunctionReturn(0);
2966 }
2967 
2968 /*@
2969   DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM.
2970 
2971   Input Parameters:
2972 + dmf  - The fine mesh
2973 . dmc  - The coarse mesh
2974 - user - The user context
2975 
2976   Output Parameter:
2977 . mass  - The mass matrix
2978 
2979   Level: developer
2980 
2981 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2982 @*/
2983 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user)
2984 {
2985   DM_Plex       *mesh = (DM_Plex *) dmf->data;
2986   const char    *name = "Mass Matrix";
2987   PetscDS        prob;
2988   PetscSection   fsection, csection, globalFSection, globalCSection;
2989   PetscHSetIJ    ht;
2990   PetscLayout    rLayout;
2991   PetscInt      *dnz, *onz;
2992   PetscInt       locRows, rStart, rEnd;
2993   PetscReal     *x, *v0, *J, *invJ, detJ;
2994   PetscReal     *v0c, *Jc, *invJc, detJc;
2995   PetscScalar   *elemMat;
2996   PetscInt       dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2997 
2998   PetscFunctionBegin;
2999   PetscCall(DMGetCoordinateDim(dmc, &dim));
3000   PetscCall(DMGetDS(dmc, &prob));
3001   PetscCall(PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL));
3002   PetscCall(PetscDSGetNumFields(prob, &Nf));
3003   PetscCall(PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ));
3004   PetscCall(PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc));
3005   PetscCall(DMGetLocalSection(dmf, &fsection));
3006   PetscCall(DMGetGlobalSection(dmf, &globalFSection));
3007   PetscCall(DMGetLocalSection(dmc, &csection));
3008   PetscCall(DMGetGlobalSection(dmc, &globalCSection));
3009   PetscCall(DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd));
3010   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
3011   PetscCall(PetscMalloc1(totDim, &elemMat));
3012 
3013   PetscCall(MatGetLocalSize(mass, &locRows, NULL));
3014   PetscCall(PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout));
3015   PetscCall(PetscLayoutSetLocalSize(rLayout, locRows));
3016   PetscCall(PetscLayoutSetBlockSize(rLayout, 1));
3017   PetscCall(PetscLayoutSetUp(rLayout));
3018   PetscCall(PetscLayoutGetRange(rLayout, &rStart, &rEnd));
3019   PetscCall(PetscLayoutDestroy(&rLayout));
3020   PetscCall(PetscCalloc2(locRows,&dnz,locRows,&onz));
3021   PetscCall(PetscHSetIJCreate(&ht));
3022   for (field = 0; field < Nf; ++field) {
3023     PetscObject      obj;
3024     PetscClassId     id;
3025     PetscQuadrature  quad;
3026     const PetscReal *qpoints;
3027     PetscInt         Nq, Nc, i, d;
3028 
3029     PetscCall(PetscDSGetDiscretization(prob, field, &obj));
3030     PetscCall(PetscObjectGetClassId(obj, &id));
3031     if (id == PETSCFE_CLASSID) PetscCall(PetscFEGetQuadrature((PetscFE) obj, &quad));
3032     else                       PetscCall(PetscFVGetQuadrature((PetscFV) obj, &quad));
3033     PetscCall(PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL));
3034     /* For each fine grid cell */
3035     for (cell = cStart; cell < cEnd; ++cell) {
3036       Vec                pointVec;
3037       PetscScalar       *pV;
3038       PetscSF            coarseCellSF = NULL;
3039       const PetscSFNode *coarseCells;
3040       PetscInt           numCoarseCells, q, c;
3041       PetscInt          *findices,   *cindices;
3042       PetscInt           numFIndices, numCIndices;
3043 
3044       PetscCall(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3045       PetscCall(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
3046       /* Get points from the quadrature */
3047       PetscCall(VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec));
3048       PetscCall(VecSetBlockSize(pointVec, dim));
3049       PetscCall(VecGetArray(pointVec, &pV));
3050       for (q = 0; q < Nq; ++q) {
3051         const PetscReal xi0[3] = {-1., -1., -1.};
3052 
3053         /* Transform point to real space */
3054         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
3055         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
3056       }
3057       PetscCall(VecRestoreArray(pointVec, &pV));
3058       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3059       PetscCall(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
3060       PetscCall(PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view"));
3061       /* Update preallocation info */
3062       PetscCall(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
3063       PetscCheck(numCoarseCells == Nq,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
3064       {
3065         PetscHashIJKey key;
3066         PetscBool      missing;
3067 
3068         for (i = 0; i < numFIndices; ++i) {
3069           key.i = findices[i];
3070           if (key.i >= 0) {
3071             /* Get indices for coarse elements */
3072             for (ccell = 0; ccell < numCoarseCells; ++ccell) {
3073               PetscCall(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3074               for (c = 0; c < numCIndices; ++c) {
3075                 key.j = cindices[c];
3076                 if (key.j < 0) continue;
3077                 PetscCall(PetscHSetIJQueryAdd(ht, key, &missing));
3078                 if (missing) {
3079                   if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
3080                   else                                     ++onz[key.i-rStart];
3081                 }
3082               }
3083               PetscCall(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3084             }
3085           }
3086         }
3087       }
3088       PetscCall(PetscSFDestroy(&coarseCellSF));
3089       PetscCall(VecDestroy(&pointVec));
3090       PetscCall(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3091     }
3092   }
3093   PetscCall(PetscHSetIJDestroy(&ht));
3094   PetscCall(MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL));
3095   PetscCall(MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
3096   PetscCall(PetscFree2(dnz,onz));
3097   for (field = 0; field < Nf; ++field) {
3098     PetscObject       obj;
3099     PetscClassId      id;
3100     PetscTabulation T, Tfine;
3101     PetscQuadrature   quad;
3102     const PetscReal  *qpoints, *qweights;
3103     PetscInt          Nq, Nc, i, d;
3104 
3105     PetscCall(PetscDSGetDiscretization(prob, field, &obj));
3106     PetscCall(PetscObjectGetClassId(obj, &id));
3107     if (id == PETSCFE_CLASSID) {
3108       PetscCall(PetscFEGetQuadrature((PetscFE) obj, &quad));
3109       PetscCall(PetscFEGetCellTabulation((PetscFE) obj, 1, &Tfine));
3110       PetscCall(PetscFECreateTabulation((PetscFE) obj, 1, 1, x, 0, &T));
3111     } else {
3112       PetscCall(PetscFVGetQuadrature((PetscFV) obj, &quad));
3113     }
3114     PetscCall(PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights));
3115     /* For each fine grid cell */
3116     for (cell = cStart; cell < cEnd; ++cell) {
3117       Vec                pointVec;
3118       PetscScalar       *pV;
3119       PetscSF            coarseCellSF = NULL;
3120       const PetscSFNode *coarseCells;
3121       PetscInt           numCoarseCells, cpdim, q, c, j;
3122       PetscInt          *findices,   *cindices;
3123       PetscInt           numFIndices, numCIndices;
3124 
3125       PetscCall(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3126       PetscCall(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
3127       /* Get points from the quadrature */
3128       PetscCall(VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec));
3129       PetscCall(VecSetBlockSize(pointVec, dim));
3130       PetscCall(VecGetArray(pointVec, &pV));
3131       for (q = 0; q < Nq; ++q) {
3132         const PetscReal xi0[3] = {-1., -1., -1.};
3133 
3134         /* Transform point to real space */
3135         CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
3136         for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
3137       }
3138       PetscCall(VecRestoreArray(pointVec, &pV));
3139       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3140       PetscCall(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
3141       /* Update matrix */
3142       PetscCall(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
3143       PetscCheck(numCoarseCells == Nq,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
3144       PetscCall(VecGetArray(pointVec, &pV));
3145       for (ccell = 0; ccell < numCoarseCells; ++ccell) {
3146         PetscReal pVReal[3];
3147         const PetscReal xi0[3] = {-1., -1., -1.};
3148 
3149         PetscCall(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3150         /* Transform points from real space to coarse reference space */
3151         PetscCall(DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc));
3152         for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
3153         CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
3154 
3155         if (id == PETSCFE_CLASSID) {
3156           PetscFE fe = (PetscFE) obj;
3157 
3158           /* Evaluate coarse basis on contained point */
3159           PetscCall(PetscFEGetDimension(fe, &cpdim));
3160           PetscCall(PetscFEComputeTabulation(fe, 1, x, 0, T));
3161           /* Get elemMat entries by multiplying by weight */
3162           for (i = 0; i < numFIndices; ++i) {
3163             PetscCall(PetscArrayzero(elemMat, cpdim));
3164             for (j = 0; j < cpdim; ++j) {
3165               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;
3166             }
3167             /* Update interpolator */
3168             if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat));
3169             PetscCheck(numCIndices == cpdim,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3170             PetscCall(MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES));
3171           }
3172         } else {
3173           cpdim = 1;
3174           for (i = 0; i < numFIndices; ++i) {
3175             PetscCall(PetscArrayzero(elemMat, cpdim));
3176             for (j = 0; j < cpdim; ++j) {
3177               for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ;
3178             }
3179             /* Update interpolator */
3180             if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat));
3181             PetscCall(PetscPrintf(PETSC_COMM_SELF, "Nq: %D %D Nf: %D %D Nc: %D %D\n", ccell, Nq, i, numFIndices, j, numCIndices));
3182             PetscCheck(numCIndices == cpdim,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3183             PetscCall(MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES));
3184           }
3185         }
3186         PetscCall(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3187       }
3188       PetscCall(VecRestoreArray(pointVec, &pV));
3189       PetscCall(PetscSFDestroy(&coarseCellSF));
3190       PetscCall(VecDestroy(&pointVec));
3191       PetscCall(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3192     }
3193     if (id == PETSCFE_CLASSID) PetscCall(PetscTabulationDestroy(&T));
3194   }
3195   PetscCall(PetscFree3(v0,J,invJ));
3196   PetscCall(PetscFree3(v0c,Jc,invJc));
3197   PetscCall(PetscFree(elemMat));
3198   PetscCall(MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY));
3199   PetscCall(MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY));
3200   PetscFunctionReturn(0);
3201 }
3202 
3203 /*@
3204   DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns
3205 
3206   Input Parameters:
3207 + dmc  - The coarse mesh
3208 - dmf  - The fine mesh
3209 - user - The user context
3210 
3211   Output Parameter:
3212 . sc   - The mapping
3213 
3214   Level: developer
3215 
3216 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
3217 @*/
3218 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user)
3219 {
3220   PetscDS        prob;
3221   PetscFE       *feRef;
3222   PetscFV       *fvRef;
3223   Vec            fv, cv;
3224   IS             fis, cis;
3225   PetscSection   fsection, fglobalSection, csection, cglobalSection;
3226   PetscInt      *cmap, *cellCIndices, *cellFIndices, *cindices, *findices;
3227   PetscInt       cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, c, dim, d, startC, endC, offsetC, offsetF, m;
3228   PetscBool     *needAvg;
3229 
3230   PetscFunctionBegin;
3231   PetscCall(PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0));
3232   PetscCall(DMGetDimension(dmf, &dim));
3233   PetscCall(DMGetLocalSection(dmf, &fsection));
3234   PetscCall(DMGetGlobalSection(dmf, &fglobalSection));
3235   PetscCall(DMGetLocalSection(dmc, &csection));
3236   PetscCall(DMGetGlobalSection(dmc, &cglobalSection));
3237   PetscCall(PetscSectionGetNumFields(fsection, &Nf));
3238   PetscCall(DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd));
3239   PetscCall(DMGetDS(dmc, &prob));
3240   PetscCall(PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg));
3241   for (f = 0; f < Nf; ++f) {
3242     PetscObject  obj;
3243     PetscClassId id;
3244     PetscInt     fNb = 0, Nc = 0;
3245 
3246     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
3247     PetscCall(PetscObjectGetClassId(obj, &id));
3248     if (id == PETSCFE_CLASSID) {
3249       PetscFE    fe = (PetscFE) obj;
3250       PetscSpace sp;
3251       PetscInt   maxDegree;
3252 
3253       PetscCall(PetscFERefine(fe, &feRef[f]));
3254       PetscCall(PetscFEGetDimension(feRef[f], &fNb));
3255       PetscCall(PetscFEGetNumComponents(fe, &Nc));
3256       PetscCall(PetscFEGetBasisSpace(fe, &sp));
3257       PetscCall(PetscSpaceGetDegree(sp, NULL, &maxDegree));
3258       if (!maxDegree) needAvg[f] = PETSC_TRUE;
3259     } else if (id == PETSCFV_CLASSID) {
3260       PetscFV        fv = (PetscFV) obj;
3261       PetscDualSpace Q;
3262 
3263       PetscCall(PetscFVRefine(fv, &fvRef[f]));
3264       PetscCall(PetscFVGetDualSpace(fvRef[f], &Q));
3265       PetscCall(PetscDualSpaceGetDimension(Q, &fNb));
3266       PetscCall(PetscFVGetNumComponents(fv, &Nc));
3267       needAvg[f] = PETSC_TRUE;
3268     }
3269     fTotDim += fNb;
3270   }
3271   PetscCall(PetscDSGetTotalDimension(prob, &cTotDim));
3272   PetscCall(PetscMalloc1(cTotDim,&cmap));
3273   for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) {
3274     PetscFE        feC;
3275     PetscFV        fvC;
3276     PetscDualSpace QF, QC;
3277     PetscInt       order = -1, NcF, NcC, fpdim, cpdim;
3278 
3279     if (feRef[field]) {
3280       PetscCall(PetscDSGetDiscretization(prob, field, (PetscObject *) &feC));
3281       PetscCall(PetscFEGetNumComponents(feC, &NcC));
3282       PetscCall(PetscFEGetNumComponents(feRef[field], &NcF));
3283       PetscCall(PetscFEGetDualSpace(feRef[field], &QF));
3284       PetscCall(PetscDualSpaceGetOrder(QF, &order));
3285       PetscCall(PetscDualSpaceGetDimension(QF, &fpdim));
3286       PetscCall(PetscFEGetDualSpace(feC, &QC));
3287       PetscCall(PetscDualSpaceGetDimension(QC, &cpdim));
3288     } else {
3289       PetscCall(PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC));
3290       PetscCall(PetscFVGetNumComponents(fvC, &NcC));
3291       PetscCall(PetscFVGetNumComponents(fvRef[field], &NcF));
3292       PetscCall(PetscFVGetDualSpace(fvRef[field], &QF));
3293       PetscCall(PetscDualSpaceGetDimension(QF, &fpdim));
3294       PetscCall(PetscFVGetDualSpace(fvC, &QC));
3295       PetscCall(PetscDualSpaceGetDimension(QC, &cpdim));
3296     }
3297     PetscCheck(NcF == NcC,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", NcF, NcC);
3298     for (c = 0; c < cpdim; ++c) {
3299       PetscQuadrature  cfunc;
3300       const PetscReal *cqpoints, *cqweights;
3301       PetscInt         NqcC, NpC;
3302       PetscBool        found = PETSC_FALSE;
3303 
3304       PetscCall(PetscDualSpaceGetFunctional(QC, c, &cfunc));
3305       PetscCall(PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights));
3306       PetscCheck(NqcC == NcC,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcC, NcC);
3307       PetscCheckFalse(NpC != 1 && feRef[field],PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments");
3308       for (f = 0; f < fpdim; ++f) {
3309         PetscQuadrature  ffunc;
3310         const PetscReal *fqpoints, *fqweights;
3311         PetscReal        sum = 0.0;
3312         PetscInt         NqcF, NpF;
3313 
3314         PetscCall(PetscDualSpaceGetFunctional(QF, f, &ffunc));
3315         PetscCall(PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights));
3316         PetscCheck(NqcF == NcF,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcF, NcF);
3317         if (NpC != NpF) continue;
3318         for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]);
3319         if (sum > 1.0e-9) continue;
3320         for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]);
3321         if (sum < 1.0e-9) continue;
3322         cmap[offsetC+c] = offsetF+f;
3323         found = PETSC_TRUE;
3324         break;
3325       }
3326       if (!found) {
3327         /* TODO We really want the average here, but some asshole put VecScatter in the interface */
3328         if (fvRef[field] || (feRef[field] && order == 0)) {
3329           cmap[offsetC+c] = offsetF+0;
3330         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection");
3331       }
3332     }
3333     offsetC += cpdim;
3334     offsetF += fpdim;
3335   }
3336   for (f = 0; f < Nf; ++f) {PetscCall(PetscFEDestroy(&feRef[f]));PetscCall(PetscFVDestroy(&fvRef[f]));}
3337   PetscCall(PetscFree3(feRef,fvRef,needAvg));
3338 
3339   PetscCall(DMGetGlobalVector(dmf, &fv));
3340   PetscCall(DMGetGlobalVector(dmc, &cv));
3341   PetscCall(VecGetOwnershipRange(cv, &startC, &endC));
3342   PetscCall(PetscSectionGetConstrainedStorageSize(cglobalSection, &m));
3343   PetscCall(PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices));
3344   PetscCall(PetscMalloc1(m,&cindices));
3345   PetscCall(PetscMalloc1(m,&findices));
3346   for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
3347   for (c = cStart; c < cEnd; ++c) {
3348     PetscCall(DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices));
3349     for (d = 0; d < cTotDim; ++d) {
3350       if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue;
3351       PetscCheckFalse((findices[cellCIndices[d]-startC] >= 0) && (findices[cellCIndices[d]-startC] != cellFIndices[cmap[d]]),PETSC_COMM_SELF, PETSC_ERR_PLIB, "Coarse dof %D maps to both %D and %D", cindices[cellCIndices[d]-startC], findices[cellCIndices[d]-startC], cellFIndices[cmap[d]]);
3352       cindices[cellCIndices[d]-startC] = cellCIndices[d];
3353       findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]];
3354     }
3355   }
3356   PetscCall(PetscFree(cmap));
3357   PetscCall(PetscFree2(cellCIndices,cellFIndices));
3358 
3359   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis));
3360   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis));
3361   PetscCall(VecScatterCreate(cv, cis, fv, fis, sc));
3362   PetscCall(ISDestroy(&cis));
3363   PetscCall(ISDestroy(&fis));
3364   PetscCall(DMRestoreGlobalVector(dmf, &fv));
3365   PetscCall(DMRestoreGlobalVector(dmc, &cv));
3366   PetscCall(PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0));
3367   PetscFunctionReturn(0);
3368 }
3369 
3370 /*@C
3371   DMPlexGetCellFields - Retrieve the field values values for a chunk of cells
3372 
3373   Input Parameters:
3374 + dm     - The DM
3375 . cellIS - The cells to include
3376 . locX   - A local vector with the solution fields
3377 . locX_t - A local vector with solution field time derivatives, or NULL
3378 - locA   - A local vector with auxiliary fields, or NULL
3379 
3380   Output Parameters:
3381 + u   - The field coefficients
3382 . u_t - The fields derivative coefficients
3383 - a   - The auxiliary field coefficients
3384 
3385   Level: developer
3386 
3387 .seealso: DMPlexGetFaceFields()
3388 @*/
3389 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3390 {
3391   DM              plex, plexA = NULL;
3392   DMEnclosureType encAux;
3393   PetscSection    section, sectionAux;
3394   PetscDS         prob;
3395   const PetscInt *cells;
3396   PetscInt        cStart, cEnd, numCells, totDim, totDimAux, c;
3397 
3398   PetscFunctionBegin;
3399   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3400   PetscValidHeaderSpecific(locX, VEC_CLASSID, 3);
3401   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 4);}
3402   if (locA)   {PetscValidHeaderSpecific(locA, VEC_CLASSID, 5);}
3403   PetscValidPointer(u, 6);
3404   PetscValidPointer(u_t, 7);
3405   PetscValidPointer(a, 8);
3406   PetscCall(DMPlexConvertPlex(dm, &plex, PETSC_FALSE));
3407   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
3408   PetscCall(DMGetLocalSection(dm, &section));
3409   PetscCall(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
3410   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
3411   if (locA) {
3412     DM      dmAux;
3413     PetscDS probAux;
3414 
3415     PetscCall(VecGetDM(locA, &dmAux));
3416     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
3417     PetscCall(DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE));
3418     PetscCall(DMGetLocalSection(dmAux, &sectionAux));
3419     PetscCall(DMGetDS(dmAux, &probAux));
3420     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
3421   }
3422   numCells = cEnd - cStart;
3423   PetscCall(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u));
3424   if (locX_t) PetscCall(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t)); else {*u_t = NULL;}
3425   if (locA)   PetscCall(DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a)); else {*a = NULL;}
3426   for (c = cStart; c < cEnd; ++c) {
3427     const PetscInt cell = cells ? cells[c] : c;
3428     const PetscInt cind = c - cStart;
3429     PetscScalar   *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a;
3430     PetscInt       i;
3431 
3432     PetscCall(DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x));
3433     for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i];
3434     PetscCall(DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x));
3435     if (locX_t) {
3436       PetscCall(DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t));
3437       for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i];
3438       PetscCall(DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t));
3439     }
3440     if (locA) {
3441       PetscInt subcell;
3442       PetscCall(DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell));
3443       PetscCall(DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x));
3444       for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i];
3445       PetscCall(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x));
3446     }
3447   }
3448   PetscCall(DMDestroy(&plex));
3449   if (locA) PetscCall(DMDestroy(&plexA));
3450   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
3451   PetscFunctionReturn(0);
3452 }
3453 
3454 /*@C
3455   DMPlexRestoreCellFields - Restore the field values values for a chunk of cells
3456 
3457   Input Parameters:
3458 + dm     - The DM
3459 . cellIS - The cells to include
3460 . locX   - A local vector with the solution fields
3461 . locX_t - A local vector with solution field time derivatives, or NULL
3462 - locA   - A local vector with auxiliary fields, or NULL
3463 
3464   Output Parameters:
3465 + u   - The field coefficients
3466 . u_t - The fields derivative coefficients
3467 - a   - The auxiliary field coefficients
3468 
3469   Level: developer
3470 
3471 .seealso: DMPlexGetFaceFields()
3472 @*/
3473 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3474 {
3475   PetscFunctionBegin;
3476   PetscCall(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u));
3477   if (locX_t) PetscCall(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t));
3478   if (locA)   PetscCall(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a));
3479   PetscFunctionReturn(0);
3480 }
3481 
3482 /*
3483   Get the auxiliary field vectors for the negative side (s = 0) and positive side (s = 1) of the interfaace
3484 */
3485 static PetscErrorCode DMPlexGetHybridAuxFields(DM dm, DM dmAux[], PetscDS dsAux[], IS cellIS, Vec locA[], PetscScalar *a[])
3486 {
3487   DM              plexA[2];
3488   DMEnclosureType encAux[2];
3489   PetscSection    sectionAux[2];
3490   const PetscInt *cells;
3491   PetscInt        cStart, cEnd, numCells, c, s, totDimAux[2];
3492 
3493   PetscFunctionBegin;
3494   PetscValidPointer(locA, 5);
3495   if (!locA[0] || !locA[1]) PetscFunctionReturn(0);
3496   PetscValidPointer(dmAux, 2);
3497   PetscValidPointer(dsAux, 3);
3498   PetscValidPointer(a, 6);
3499   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
3500   numCells = cEnd - cStart;
3501   for (s = 0; s < 2; ++s) {
3502     PetscValidHeaderSpecific(dmAux[s], DM_CLASSID, 2);
3503     PetscValidHeaderSpecific(dsAux[s], PETSCDS_CLASSID, 3);
3504     PetscValidHeaderSpecific(locA[s], VEC_CLASSID, 5);
3505     PetscCall(DMPlexConvertPlex(dmAux[s], &plexA[s], PETSC_FALSE));
3506     PetscCall(DMGetEnclosureRelation(dmAux[s], dm, &encAux[s]));
3507     PetscCall(DMGetLocalSection(dmAux[s], &sectionAux[s]));
3508     PetscCall(PetscDSGetTotalDimension(dsAux[s], &totDimAux[s]));
3509     PetscCall(DMGetWorkArray(dmAux[s], numCells*totDimAux[s], MPIU_SCALAR, &a[s]));
3510   }
3511   for (c = cStart; c < cEnd; ++c) {
3512     const PetscInt  cell = cells ? cells[c] : c;
3513     const PetscInt  cind = c - cStart;
3514     const PetscInt *cone, *ornt;
3515 
3516     PetscCall(DMPlexGetCone(dm, cell, &cone));
3517     PetscCall(DMPlexGetConeOrientation(dm, cell, &ornt));
3518     PetscCheckFalse(ornt[0],PETSC_COMM_SELF, PETSC_ERR_SUP, "Face %D in hybrid cell %D has orientation %D != 0", cone[0], cell, ornt[0]);
3519     for (s = 0; s < 2; ++s) {
3520       const PetscInt *support;
3521       PetscScalar    *x = NULL, *al = a[s];
3522       const PetscInt  tdA = totDimAux[s];
3523       PetscInt        ssize, scell;
3524       PetscInt        subface, Na, i;
3525 
3526       PetscCall(DMPlexGetSupport(dm, cone[s], &support));
3527       PetscCall(DMPlexGetSupportSize(dm, cone[s], &ssize));
3528       PetscCheckFalse(ssize != 2,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D from cell %D has support size %D != 2", cone[s], cell, ssize);
3529       if      (support[0] == cell) scell = support[1];
3530       else if (support[1] == cell) scell = support[0];
3531       else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[s], cell);
3532 
3533       PetscCall(DMGetEnclosurePoint(plexA[s], dm, encAux[s], scell, &subface));
3534       PetscCall(DMPlexVecGetClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x));
3535       for (i = 0; i < Na; ++i) al[cind*tdA+i] = x[i];
3536       PetscCall(DMPlexVecRestoreClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x));
3537     }
3538   }
3539   for (s = 0; s < 2; ++s) PetscCall(DMDestroy(&plexA[s]));
3540   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
3541   PetscFunctionReturn(0);
3542 }
3543 
3544 static PetscErrorCode DMPlexRestoreHybridAuxFields(DM dmAux[], PetscDS dsAux[], IS cellIS, Vec locA[], PetscScalar *a[])
3545 {
3546   PetscFunctionBegin;
3547   if (!locA[0] || !locA[1]) PetscFunctionReturn(0);
3548   PetscCall(DMRestoreWorkArray(dmAux[0], 0, MPIU_SCALAR, &a[0]));
3549   PetscCall(DMRestoreWorkArray(dmAux[1], 0, MPIU_SCALAR, &a[1]));
3550   PetscFunctionReturn(0);
3551 }
3552 
3553 /*@C
3554   DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces
3555 
3556   Input Parameters:
3557 + dm     - The DM
3558 . fStart - The first face to include
3559 . fEnd   - The first face to exclude
3560 . locX   - A local vector with the solution fields
3561 . locX_t - A local vector with solution field time derivatives, or NULL
3562 . faceGeometry - A local vector with face geometry
3563 . cellGeometry - A local vector with cell geometry
3564 - locaGrad - A local vector with field gradients, or NULL
3565 
3566   Output Parameters:
3567 + Nface - The number of faces with field values
3568 . uL - The field values at the left side of the face
3569 - uR - The field values at the right side of the face
3570 
3571   Level: developer
3572 
3573 .seealso: DMPlexGetCellFields()
3574 @*/
3575 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)
3576 {
3577   DM                 dmFace, dmCell, dmGrad = NULL;
3578   PetscSection       section;
3579   PetscDS            prob;
3580   DMLabel            ghostLabel;
3581   const PetscScalar *facegeom, *cellgeom, *x, *lgrad;
3582   PetscBool         *isFE;
3583   PetscInt           dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face;
3584 
3585   PetscFunctionBegin;
3586   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3587   PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
3588   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
3589   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6);
3590   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7);
3591   if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);}
3592   PetscValidPointer(uL, 10);
3593   PetscValidPointer(uR, 11);
3594   PetscCall(DMGetDimension(dm, &dim));
3595   PetscCall(DMGetDS(dm, &prob));
3596   PetscCall(DMGetLocalSection(dm, &section));
3597   PetscCall(PetscDSGetNumFields(prob, &Nf));
3598   PetscCall(PetscDSGetTotalComponents(prob, &Nc));
3599   PetscCall(PetscMalloc1(Nf, &isFE));
3600   for (f = 0; f < Nf; ++f) {
3601     PetscObject  obj;
3602     PetscClassId id;
3603 
3604     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
3605     PetscCall(PetscObjectGetClassId(obj, &id));
3606     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
3607     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
3608     else                            {isFE[f] = PETSC_FALSE;}
3609   }
3610   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
3611   PetscCall(VecGetArrayRead(locX, &x));
3612   PetscCall(VecGetDM(faceGeometry, &dmFace));
3613   PetscCall(VecGetArrayRead(faceGeometry, &facegeom));
3614   PetscCall(VecGetDM(cellGeometry, &dmCell));
3615   PetscCall(VecGetArrayRead(cellGeometry, &cellgeom));
3616   if (locGrad) {
3617     PetscCall(VecGetDM(locGrad, &dmGrad));
3618     PetscCall(VecGetArrayRead(locGrad, &lgrad));
3619   }
3620   PetscCall(DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL));
3621   PetscCall(DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR));
3622   /* Right now just eat the extra work for FE (could make a cell loop) */
3623   for (face = fStart, iface = 0; face < fEnd; ++face) {
3624     const PetscInt        *cells;
3625     PetscFVFaceGeom       *fg;
3626     PetscFVCellGeom       *cgL, *cgR;
3627     PetscScalar           *xL, *xR, *gL, *gR;
3628     PetscScalar           *uLl = *uL, *uRl = *uR;
3629     PetscInt               ghost, nsupp, nchild;
3630 
3631     PetscCall(DMLabelGetValue(ghostLabel, face, &ghost));
3632     PetscCall(DMPlexGetSupportSize(dm, face, &nsupp));
3633     PetscCall(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
3634     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3635     PetscCall(DMPlexPointLocalRead(dmFace, face, facegeom, &fg));
3636     PetscCall(DMPlexGetSupport(dm, face, &cells));
3637     PetscCall(DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL));
3638     PetscCall(DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR));
3639     for (f = 0; f < Nf; ++f) {
3640       PetscInt off;
3641 
3642       PetscCall(PetscDSGetComponentOffset(prob, f, &off));
3643       if (isFE[f]) {
3644         const PetscInt *cone;
3645         PetscInt        comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d;
3646 
3647         xL = xR = NULL;
3648         PetscCall(PetscSectionGetFieldComponents(section, f, &comp));
3649         PetscCall(DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL));
3650         PetscCall(DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR));
3651         PetscCall(DMPlexGetCone(dm, cells[0], &cone));
3652         PetscCall(DMPlexGetConeSize(dm, cells[0], &coneSizeL));
3653         for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break;
3654         PetscCall(DMPlexGetCone(dm, cells[1], &cone));
3655         PetscCall(DMPlexGetConeSize(dm, cells[1], &coneSizeR));
3656         for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break;
3657         PetscCheckFalse(faceLocL == coneSizeL && faceLocR == coneSizeR,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of cell %D or cell %D", face, cells[0], cells[1]);
3658         /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */
3659         /* TODO: this is a hack that might not be right for nonconforming */
3660         if (faceLocL < coneSizeL) {
3661           PetscCall(PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]));
3662           if (rdof == ldof && faceLocR < coneSizeR) PetscCall(PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]));
3663           else              {for (d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];}
3664         }
3665         else {
3666           PetscCall(PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]));
3667           PetscCall(PetscSectionGetFieldComponents(section, f, &comp));
3668           for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d];
3669         }
3670         PetscCall(DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL));
3671         PetscCall(DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR));
3672       } else {
3673         PetscFV  fv;
3674         PetscInt numComp, c;
3675 
3676         PetscCall(PetscDSGetDiscretization(prob, f, (PetscObject *) &fv));
3677         PetscCall(PetscFVGetNumComponents(fv, &numComp));
3678         PetscCall(DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL));
3679         PetscCall(DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR));
3680         if (dmGrad) {
3681           PetscReal dxL[3], dxR[3];
3682 
3683           PetscCall(DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL));
3684           PetscCall(DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR));
3685           DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL);
3686           DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR);
3687           for (c = 0; c < numComp; ++c) {
3688             uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL);
3689             uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR);
3690           }
3691         } else {
3692           for (c = 0; c < numComp; ++c) {
3693             uLl[iface*Nc+off+c] = xL[c];
3694             uRl[iface*Nc+off+c] = xR[c];
3695           }
3696         }
3697       }
3698     }
3699     ++iface;
3700   }
3701   *Nface = iface;
3702   PetscCall(VecRestoreArrayRead(locX, &x));
3703   PetscCall(VecRestoreArrayRead(faceGeometry, &facegeom));
3704   PetscCall(VecRestoreArrayRead(cellGeometry, &cellgeom));
3705   if (locGrad) {
3706     PetscCall(VecRestoreArrayRead(locGrad, &lgrad));
3707   }
3708   PetscCall(PetscFree(isFE));
3709   PetscFunctionReturn(0);
3710 }
3711 
3712 /*@C
3713   DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces
3714 
3715   Input Parameters:
3716 + dm     - The DM
3717 . fStart - The first face to include
3718 . fEnd   - The first face to exclude
3719 . locX   - A local vector with the solution fields
3720 . locX_t - A local vector with solution field time derivatives, or NULL
3721 . faceGeometry - A local vector with face geometry
3722 . cellGeometry - A local vector with cell geometry
3723 - locaGrad - A local vector with field gradients, or NULL
3724 
3725   Output Parameters:
3726 + Nface - The number of faces with field values
3727 . uL - The field values at the left side of the face
3728 - uR - The field values at the right side of the face
3729 
3730   Level: developer
3731 
3732 .seealso: DMPlexGetFaceFields()
3733 @*/
3734 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)
3735 {
3736   PetscFunctionBegin;
3737   PetscCall(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL));
3738   PetscCall(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR));
3739   PetscFunctionReturn(0);
3740 }
3741 
3742 /*@C
3743   DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces
3744 
3745   Input Parameters:
3746 + dm     - The DM
3747 . fStart - The first face to include
3748 . fEnd   - The first face to exclude
3749 . faceGeometry - A local vector with face geometry
3750 - cellGeometry - A local vector with cell geometry
3751 
3752   Output Parameters:
3753 + Nface - The number of faces with field values
3754 . fgeom - The extract the face centroid and normal
3755 - vol   - The cell volume
3756 
3757   Level: developer
3758 
3759 .seealso: DMPlexGetCellFields()
3760 @*/
3761 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3762 {
3763   DM                 dmFace, dmCell;
3764   DMLabel            ghostLabel;
3765   const PetscScalar *facegeom, *cellgeom;
3766   PetscInt           dim, numFaces = fEnd - fStart, iface, face;
3767 
3768   PetscFunctionBegin;
3769   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3770   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4);
3771   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5);
3772   PetscValidPointer(fgeom, 7);
3773   PetscValidPointer(vol, 8);
3774   PetscCall(DMGetDimension(dm, &dim));
3775   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
3776   PetscCall(VecGetDM(faceGeometry, &dmFace));
3777   PetscCall(VecGetArrayRead(faceGeometry, &facegeom));
3778   PetscCall(VecGetDM(cellGeometry, &dmCell));
3779   PetscCall(VecGetArrayRead(cellGeometry, &cellgeom));
3780   PetscCall(PetscMalloc1(numFaces, fgeom));
3781   PetscCall(DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol));
3782   for (face = fStart, iface = 0; face < fEnd; ++face) {
3783     const PetscInt        *cells;
3784     PetscFVFaceGeom       *fg;
3785     PetscFVCellGeom       *cgL, *cgR;
3786     PetscFVFaceGeom       *fgeoml = *fgeom;
3787     PetscReal             *voll   = *vol;
3788     PetscInt               ghost, d, nchild, nsupp;
3789 
3790     PetscCall(DMLabelGetValue(ghostLabel, face, &ghost));
3791     PetscCall(DMPlexGetSupportSize(dm, face, &nsupp));
3792     PetscCall(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
3793     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3794     PetscCall(DMPlexPointLocalRead(dmFace, face, facegeom, &fg));
3795     PetscCall(DMPlexGetSupport(dm, face, &cells));
3796     PetscCall(DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL));
3797     PetscCall(DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR));
3798     for (d = 0; d < dim; ++d) {
3799       fgeoml[iface].centroid[d] = fg->centroid[d];
3800       fgeoml[iface].normal[d]   = fg->normal[d];
3801     }
3802     voll[iface*2+0] = cgL->volume;
3803     voll[iface*2+1] = cgR->volume;
3804     ++iface;
3805   }
3806   *Nface = iface;
3807   PetscCall(VecRestoreArrayRead(faceGeometry, &facegeom));
3808   PetscCall(VecRestoreArrayRead(cellGeometry, &cellgeom));
3809   PetscFunctionReturn(0);
3810 }
3811 
3812 /*@C
3813   DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces
3814 
3815   Input Parameters:
3816 + dm     - The DM
3817 . fStart - The first face to include
3818 . fEnd   - The first face to exclude
3819 . faceGeometry - A local vector with face geometry
3820 - cellGeometry - A local vector with cell geometry
3821 
3822   Output Parameters:
3823 + Nface - The number of faces with field values
3824 . fgeom - The extract the face centroid and normal
3825 - vol   - The cell volume
3826 
3827   Level: developer
3828 
3829 .seealso: DMPlexGetFaceFields()
3830 @*/
3831 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3832 {
3833   PetscFunctionBegin;
3834   PetscCall(PetscFree(*fgeom));
3835   PetscCall(DMRestoreWorkArray(dm, 0, MPIU_REAL, vol));
3836   PetscFunctionReturn(0);
3837 }
3838 
3839 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3840 {
3841   char            composeStr[33] = {0};
3842   PetscObjectId   id;
3843   PetscContainer  container;
3844 
3845   PetscFunctionBegin;
3846   PetscCall(PetscObjectGetId((PetscObject)quad,&id));
3847   PetscCall(PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id));
3848   PetscCall(PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container));
3849   if (container) {
3850     PetscCall(PetscContainerGetPointer(container, (void **) geom));
3851   } else {
3852     PetscCall(DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom));
3853     PetscCall(PetscContainerCreate(PETSC_COMM_SELF,&container));
3854     PetscCall(PetscContainerSetPointer(container, (void *) *geom));
3855     PetscCall(PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom));
3856     PetscCall(PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container));
3857     PetscCall(PetscContainerDestroy(&container));
3858   }
3859   PetscFunctionReturn(0);
3860 }
3861 
3862 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3863 {
3864   PetscFunctionBegin;
3865   *geom = NULL;
3866   PetscFunctionReturn(0);
3867 }
3868 
3869 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user)
3870 {
3871   DM_Plex         *mesh       = (DM_Plex *) dm->data;
3872   const char      *name       = "Residual";
3873   DM               dmAux      = NULL;
3874   DMLabel          ghostLabel = NULL;
3875   PetscDS          prob       = NULL;
3876   PetscDS          probAux    = NULL;
3877   PetscBool        useFEM     = PETSC_FALSE;
3878   PetscBool        isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
3879   DMField          coordField = NULL;
3880   Vec              locA;
3881   PetscScalar     *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL;
3882   IS               chunkIS;
3883   const PetscInt  *cells;
3884   PetscInt         cStart, cEnd, numCells;
3885   PetscInt         Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd;
3886   PetscInt         maxDegree = PETSC_MAX_INT;
3887   PetscFormKey key;
3888   PetscQuadrature  affineQuad = NULL, *quads = NULL;
3889   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
3890 
3891   PetscFunctionBegin;
3892   PetscCall(PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0));
3893   /* FEM+FVM */
3894   /* 1: Get sizes from dm and dmAux */
3895   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
3896   PetscCall(DMGetDS(dm, &prob));
3897   PetscCall(PetscDSGetNumFields(prob, &Nf));
3898   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
3899   PetscCall(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
3900   if (locA) {
3901     PetscCall(VecGetDM(locA, &dmAux));
3902     PetscCall(DMGetDS(dmAux, &probAux));
3903     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
3904   }
3905   /* 2: Get geometric data */
3906   for (f = 0; f < Nf; ++f) {
3907     PetscObject  obj;
3908     PetscClassId id;
3909     PetscBool    fimp;
3910 
3911     PetscCall(PetscDSGetImplicit(prob, f, &fimp));
3912     if (isImplicit != fimp) continue;
3913     PetscCall(PetscDSGetDiscretization(prob, f, &obj));
3914     PetscCall(PetscObjectGetClassId(obj, &id));
3915     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
3916     PetscCheck(id != PETSCFV_CLASSID,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented");
3917   }
3918   if (useFEM) {
3919     PetscCall(DMGetCoordinateField(dm, &coordField));
3920     PetscCall(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
3921     if (maxDegree <= 1) {
3922       PetscCall(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
3923       if (affineQuad) {
3924         PetscCall(DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
3925       }
3926     } else {
3927       PetscCall(PetscCalloc2(Nf,&quads,Nf,&geoms));
3928       for (f = 0; f < Nf; ++f) {
3929         PetscObject  obj;
3930         PetscClassId id;
3931         PetscBool    fimp;
3932 
3933         PetscCall(PetscDSGetImplicit(prob, f, &fimp));
3934         if (isImplicit != fimp) continue;
3935         PetscCall(PetscDSGetDiscretization(prob, f, &obj));
3936         PetscCall(PetscObjectGetClassId(obj, &id));
3937         if (id == PETSCFE_CLASSID) {
3938           PetscFE fe = (PetscFE) obj;
3939 
3940           PetscCall(PetscFEGetQuadrature(fe, &quads[f]));
3941           PetscCall(PetscObjectReference((PetscObject)quads[f]));
3942           PetscCall(DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
3943         }
3944       }
3945     }
3946   }
3947   /* Loop over chunks */
3948   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
3949   PetscCall(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
3950   if (useFEM) PetscCall(ISCreate(PETSC_COMM_SELF, &chunkIS));
3951   numCells      = cEnd - cStart;
3952   numChunks     = 1;
3953   cellChunkSize = numCells/numChunks;
3954   numChunks     = PetscMin(1,numCells);
3955   key.label     = NULL;
3956   key.value     = 0;
3957   key.part      = 0;
3958   for (chunk = 0; chunk < numChunks; ++chunk) {
3959     PetscScalar     *elemVec, *fluxL = NULL, *fluxR = NULL;
3960     PetscReal       *vol = NULL;
3961     PetscFVFaceGeom *fgeom = NULL;
3962     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
3963     PetscInt         numFaces = 0;
3964 
3965     /* Extract field coefficients */
3966     if (useFEM) {
3967       PetscCall(ISGetPointSubrange(chunkIS, cS, cE, cells));
3968       PetscCall(DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
3969       PetscCall(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
3970       PetscCall(PetscArrayzero(elemVec, numCells*totDim));
3971     }
3972     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
3973     /* Loop over fields */
3974     for (f = 0; f < Nf; ++f) {
3975       PetscObject  obj;
3976       PetscClassId id;
3977       PetscBool    fimp;
3978       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
3979 
3980       key.field = f;
3981       PetscCall(PetscDSGetImplicit(prob, f, &fimp));
3982       if (isImplicit != fimp) continue;
3983       PetscCall(PetscDSGetDiscretization(prob, f, &obj));
3984       PetscCall(PetscObjectGetClassId(obj, &id));
3985       if (id == PETSCFE_CLASSID) {
3986         PetscFE         fe = (PetscFE) obj;
3987         PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
3988         PetscFEGeom    *chunkGeom = NULL;
3989         PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
3990         PetscInt        Nq, Nb;
3991 
3992         PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
3993         PetscCall(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
3994         PetscCall(PetscFEGetDimension(fe, &Nb));
3995         blockSize = Nb;
3996         batchSize = numBlocks * blockSize;
3997         PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
3998         numChunks = numCells / (numBatches*batchSize);
3999         Ne        = numChunks*numBatches*batchSize;
4000         Nr        = numCells % (numBatches*batchSize);
4001         offset    = numCells - Nr;
4002         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
4003         /*   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) */
4004         PetscCall(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
4005         PetscCall(PetscFEIntegrateResidual(prob, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec));
4006         PetscCall(PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom));
4007         PetscCall(PetscFEIntegrateResidual(prob, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]));
4008         PetscCall(PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom));
4009       } else if (id == PETSCFV_CLASSID) {
4010         PetscFV fv = (PetscFV) obj;
4011 
4012         Ne = numFaces;
4013         /* Riemann solve over faces (need fields at face centroids) */
4014         /*   We need to evaluate FE fields at those coordinates */
4015         PetscCall(PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR));
4016       } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
4017     }
4018     /* Loop over domain */
4019     if (useFEM) {
4020       /* Add elemVec to locX */
4021       for (c = cS; c < cE; ++c) {
4022         const PetscInt cell = cells ? cells[c] : c;
4023         const PetscInt cind = c - cStart;
4024 
4025         if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
4026         if (ghostLabel) {
4027           PetscInt ghostVal;
4028 
4029           PetscCall(DMLabelGetValue(ghostLabel,cell,&ghostVal));
4030           if (ghostVal > 0) continue;
4031         }
4032         PetscCall(DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES));
4033       }
4034     }
4035     /* Handle time derivative */
4036     if (locX_t) {
4037       PetscScalar *x_t, *fa;
4038 
4039       PetscCall(VecGetArray(locF, &fa));
4040       PetscCall(VecGetArray(locX_t, &x_t));
4041       for (f = 0; f < Nf; ++f) {
4042         PetscFV      fv;
4043         PetscObject  obj;
4044         PetscClassId id;
4045         PetscInt     pdim, d;
4046 
4047         PetscCall(PetscDSGetDiscretization(prob, f, &obj));
4048         PetscCall(PetscObjectGetClassId(obj, &id));
4049         if (id != PETSCFV_CLASSID) continue;
4050         fv   = (PetscFV) obj;
4051         PetscCall(PetscFVGetNumComponents(fv, &pdim));
4052         for (c = cS; c < cE; ++c) {
4053           const PetscInt cell = cells ? cells[c] : c;
4054           PetscScalar   *u_t, *r;
4055 
4056           if (ghostLabel) {
4057             PetscInt ghostVal;
4058 
4059             PetscCall(DMLabelGetValue(ghostLabel, cell, &ghostVal));
4060             if (ghostVal > 0) continue;
4061           }
4062           PetscCall(DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t));
4063           PetscCall(DMPlexPointLocalFieldRef(dm, cell, f, fa, &r));
4064           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4065         }
4066       }
4067       PetscCall(VecRestoreArray(locX_t, &x_t));
4068       PetscCall(VecRestoreArray(locF, &fa));
4069     }
4070     if (useFEM) {
4071       PetscCall(DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4072       PetscCall(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4073     }
4074   }
4075   if (useFEM) PetscCall(ISDestroy(&chunkIS));
4076   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
4077   /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */
4078   if (useFEM) {
4079     if (maxDegree <= 1) {
4080       PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4081       PetscCall(PetscQuadratureDestroy(&affineQuad));
4082     } else {
4083       for (f = 0; f < Nf; ++f) {
4084         PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4085         PetscCall(PetscQuadratureDestroy(&quads[f]));
4086       }
4087       PetscCall(PetscFree2(quads,geoms));
4088     }
4089   }
4090   PetscCall(PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0));
4091   PetscFunctionReturn(0);
4092 }
4093 
4094 /*
4095   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
4096 
4097   X   - The local solution vector
4098   X_t - The local solution time derivative vector, or NULL
4099 */
4100 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS,
4101                                                     PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx)
4102 {
4103   DM_Plex         *mesh  = (DM_Plex *) dm->data;
4104   const char      *name = "Jacobian", *nameP = "JacobianPre";
4105   DM               dmAux = NULL;
4106   PetscDS          prob,   probAux = NULL;
4107   PetscSection     sectionAux = NULL;
4108   Vec              A;
4109   DMField          coordField;
4110   PetscFEGeom     *cgeomFEM;
4111   PetscQuadrature  qGeom = NULL;
4112   Mat              J = Jac, JP = JacP;
4113   PetscScalar     *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL;
4114   PetscBool        hasJac, hasPrec, hasDyn, assembleJac, *isFE, hasFV = PETSC_FALSE;
4115   const PetscInt  *cells;
4116   PetscFormKey key;
4117   PetscInt         Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0;
4118 
4119   PetscFunctionBegin;
4120   PetscCall(ISGetLocalSize(cellIS, &numCells));
4121   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4122   PetscCall(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
4123   PetscCall(DMGetDS(dm, &prob));
4124   PetscCall(DMGetAuxiliaryVec(dm, NULL, 0, 0, &A));
4125   if (A) {
4126     PetscCall(VecGetDM(A, &dmAux));
4127     PetscCall(DMGetLocalSection(dmAux, &sectionAux));
4128     PetscCall(DMGetDS(dmAux, &probAux));
4129   }
4130   /* Get flags */
4131   PetscCall(PetscDSGetNumFields(prob, &Nf));
4132   PetscCall(DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE));
4133   for (fieldI = 0; fieldI < Nf; ++fieldI) {
4134     PetscObject  disc;
4135     PetscClassId id;
4136     PetscCall(PetscDSGetDiscretization(prob, fieldI, &disc));
4137     PetscCall(PetscObjectGetClassId(disc, &id));
4138     if (id == PETSCFE_CLASSID)      {isFE[fieldI] = PETSC_TRUE;}
4139     else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;}
4140   }
4141   PetscCall(PetscDSHasJacobian(prob, &hasJac));
4142   PetscCall(PetscDSHasJacobianPreconditioner(prob, &hasPrec));
4143   PetscCall(PetscDSHasDynamicJacobian(prob, &hasDyn));
4144   assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE;
4145   hasDyn      = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
4146   if (hasFV) PetscCall(MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE)); /* No allocated space for FV stuff, so ignore the zero entries */
4147   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
4148   if (probAux) PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
4149   /* Compute batch sizes */
4150   if (isFE[0]) {
4151     PetscFE         fe;
4152     PetscQuadrature q;
4153     PetscInt        numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb;
4154 
4155     PetscCall(PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe));
4156     PetscCall(PetscFEGetQuadrature(fe, &q));
4157     PetscCall(PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL));
4158     PetscCall(PetscFEGetDimension(fe, &Nb));
4159     PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
4160     blockSize = Nb*numQuadPoints;
4161     batchSize = numBlocks  * blockSize;
4162     chunkSize = numBatches * batchSize;
4163     numChunks = numCells / chunkSize + numCells % chunkSize;
4164     PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
4165   } else {
4166     chunkSize = numCells;
4167     numChunks = 1;
4168   }
4169   /* Get work space */
4170   wsz  = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize;
4171   PetscCall(DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work));
4172   PetscCall(PetscArrayzero(work, wsz));
4173   off      = 0;
4174   u        = X       ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
4175   u_t      = X_t     ? (sz = chunkSize*totDim,        off += sz, work+off-sz) : NULL;
4176   a        = dmAux   ? (sz = chunkSize*totDimAux,     off += sz, work+off-sz) : NULL;
4177   elemMat  = hasJac  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4178   elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4179   elemMatD = hasDyn  ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4180   PetscCheck(off == wsz,PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz);
4181   /* Setup geometry */
4182   PetscCall(DMGetCoordinateField(dm, &coordField));
4183   PetscCall(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
4184   if (maxDegree <= 1) PetscCall(DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom));
4185   if (!qGeom) {
4186     PetscFE fe;
4187 
4188     PetscCall(PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe));
4189     PetscCall(PetscFEGetQuadrature(fe, &qGeom));
4190     PetscCall(PetscObjectReference((PetscObject) qGeom));
4191   }
4192   PetscCall(DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM));
4193   /* Compute volume integrals */
4194   if (assembleJac) PetscCall(MatZeroEntries(J));
4195   PetscCall(MatZeroEntries(JP));
4196   key.label = NULL;
4197   key.value = 0;
4198   key.part  = 0;
4199   for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) {
4200     const PetscInt   Ncell = PetscMin(chunkSize, numCells - offCell);
4201     PetscInt         c;
4202 
4203     /* Extract values */
4204     for (c = 0; c < Ncell; ++c) {
4205       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4206       PetscScalar   *x = NULL,  *x_t = NULL;
4207       PetscInt       i;
4208 
4209       if (X) {
4210         PetscCall(DMPlexVecGetClosure(dm, section, X, cell, NULL, &x));
4211         for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
4212         PetscCall(DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x));
4213       }
4214       if (X_t) {
4215         PetscCall(DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t));
4216         for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
4217         PetscCall(DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t));
4218       }
4219       if (dmAux) {
4220         PetscCall(DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x));
4221         for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
4222         PetscCall(DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x));
4223       }
4224     }
4225     for (fieldI = 0; fieldI < Nf; ++fieldI) {
4226       PetscFE fe;
4227       PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
4228       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
4229         key.field = fieldI*Nf + fieldJ;
4230         if (hasJac)  PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN,     key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat));
4231         if (hasPrec) PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP));
4232         if (hasDyn)  PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD));
4233       }
4234       /* For finite volume, add the identity */
4235       if (!isFE[fieldI]) {
4236         PetscFV  fv;
4237         PetscInt eOffset = 0, Nc, fc, foff;
4238 
4239         PetscCall(PetscDSGetFieldOffset(prob, fieldI, &foff));
4240         PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv));
4241         PetscCall(PetscFVGetNumComponents(fv, &Nc));
4242         for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) {
4243           for (fc = 0; fc < Nc; ++fc) {
4244             const PetscInt i = foff + fc;
4245             if (hasJac)  {elemMat [eOffset+i*totDim+i] = 1.0;}
4246             if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;}
4247           }
4248         }
4249       }
4250     }
4251     /*   Add contribution from X_t */
4252     if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
4253     /* Insert values into matrix */
4254     for (c = 0; c < Ncell; ++c) {
4255       const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4256       if (mesh->printFEM > 1) {
4257         if (hasJac)  PetscCall(DMPrintCellMatrix(cell, name,  totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]));
4258         if (hasPrec) PetscCall(DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]));
4259       }
4260       if (assembleJac) PetscCall(DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES));
4261       PetscCall(DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES));
4262     }
4263   }
4264   /* Cleanup */
4265   PetscCall(DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM));
4266   PetscCall(PetscQuadratureDestroy(&qGeom));
4267   if (hasFV) PetscCall(MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
4268   PetscCall(DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE));
4269   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));
4270   /* Compute boundary integrals */
4271   /* PetscCall(DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx)); */
4272   /* Assemble matrix */
4273   if (assembleJac) {PetscCall(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));PetscCall(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));}
4274   PetscCall(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));PetscCall(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
4275   PetscCall(PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0));
4276   PetscFunctionReturn(0);
4277 }
4278 
4279 /******** FEM Assembly Function ********/
4280 
4281 static PetscErrorCode DMConvertPlex_Internal(DM dm, DM *plex, PetscBool copy)
4282 {
4283   PetscBool      isPlex;
4284 
4285   PetscFunctionBegin;
4286   PetscCall(PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex));
4287   if (isPlex) {
4288     *plex = dm;
4289     PetscCall(PetscObjectReference((PetscObject) dm));
4290   } else {
4291     PetscCall(PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex));
4292     if (!*plex) {
4293       PetscCall(DMConvert(dm,DMPLEX,plex));
4294       PetscCall(PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex));
4295       if (copy) {
4296         PetscCall(DMCopyAuxiliaryVec(dm, *plex));
4297       }
4298     } else {
4299       PetscCall(PetscObjectReference((PetscObject) *plex));
4300     }
4301   }
4302   PetscFunctionReturn(0);
4303 }
4304 
4305 /*@
4306   DMPlexGetGeometryFVM - Return precomputed geometric data
4307 
4308   Collective on DM
4309 
4310   Input Parameter:
4311 . dm - The DM
4312 
4313   Output Parameters:
4314 + facegeom - The values precomputed from face geometry
4315 . cellgeom - The values precomputed from cell geometry
4316 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell
4317 
4318   Level: developer
4319 
4320 .seealso: DMTSSetRHSFunctionLocal()
4321 @*/
4322 PetscErrorCode DMPlexGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
4323 {
4324   DM             plex;
4325 
4326   PetscFunctionBegin;
4327   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4328   PetscCall(DMConvertPlex_Internal(dm,&plex,PETSC_TRUE));
4329   PetscCall(DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL));
4330   if (minRadius) PetscCall(DMPlexGetMinRadius(plex, minRadius));
4331   PetscCall(DMDestroy(&plex));
4332   PetscFunctionReturn(0);
4333 }
4334 
4335 /*@
4336   DMPlexGetGradientDM - Return gradient data layout
4337 
4338   Collective on DM
4339 
4340   Input Parameters:
4341 + dm - The DM
4342 - fv - The PetscFV
4343 
4344   Output Parameter:
4345 . dmGrad - The layout for gradient values
4346 
4347   Level: developer
4348 
4349 .seealso: DMPlexGetGeometryFVM()
4350 @*/
4351 PetscErrorCode DMPlexGetGradientDM(DM dm, PetscFV fv, DM *dmGrad)
4352 {
4353   DM             plex;
4354   PetscBool      computeGradients;
4355 
4356   PetscFunctionBegin;
4357   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4358   PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2);
4359   PetscValidPointer(dmGrad,3);
4360   PetscCall(PetscFVGetComputeGradients(fv, &computeGradients));
4361   if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
4362   PetscCall(DMConvertPlex_Internal(dm,&plex,PETSC_TRUE));
4363   PetscCall(DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad));
4364   PetscCall(DMDestroy(&plex));
4365   PetscFunctionReturn(0);
4366 }
4367 
4368 static PetscErrorCode DMPlexComputeBdResidual_Single_Internal(DM dm, PetscReal t, PetscWeakForm wf, PetscFormKey key, Vec locX, Vec locX_t, Vec locF, DMField coordField, IS facetIS)
4369 {
4370   DM_Plex         *mesh = (DM_Plex *) dm->data;
4371   DM               plex = NULL, plexA = NULL;
4372   DMEnclosureType  encAux;
4373   PetscDS          prob, probAux = NULL;
4374   PetscSection     section, sectionAux = NULL;
4375   Vec              locA = NULL;
4376   PetscScalar     *u = NULL, *u_t = NULL, *a = NULL, *elemVec = NULL;
4377   PetscInt         totDim, totDimAux = 0;
4378 
4379   PetscFunctionBegin;
4380   PetscCall(DMConvert(dm, DMPLEX, &plex));
4381   PetscCall(DMGetLocalSection(dm, &section));
4382   PetscCall(DMGetDS(dm, &prob));
4383   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
4384   PetscCall(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &locA));
4385   if (locA) {
4386     DM dmAux;
4387 
4388     PetscCall(VecGetDM(locA, &dmAux));
4389     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
4390     PetscCall(DMConvert(dmAux, DMPLEX, &plexA));
4391     PetscCall(DMGetDS(plexA, &probAux));
4392     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
4393     PetscCall(DMGetLocalSection(plexA, &sectionAux));
4394   }
4395   {
4396     PetscFEGeom     *fgeom;
4397     PetscInt         maxDegree;
4398     PetscQuadrature  qGeom = NULL;
4399     IS               pointIS;
4400     const PetscInt  *points;
4401     PetscInt         numFaces, face, Nq;
4402 
4403     PetscCall(DMLabelGetStratumIS(key.label, key.value, &pointIS));
4404     if (!pointIS) goto end; /* No points with that id on this process */
4405     {
4406       IS isectIS;
4407 
4408       /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
4409       PetscCall(ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS));
4410       PetscCall(ISDestroy(&pointIS));
4411       pointIS = isectIS;
4412     }
4413     PetscCall(ISGetLocalSize(pointIS,&numFaces));
4414     PetscCall(ISGetIndices(pointIS,&points));
4415     PetscCall(PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a));
4416     PetscCall(DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree));
4417     if (maxDegree <= 1) {
4418       PetscCall(DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom));
4419     }
4420     if (!qGeom) {
4421       PetscFE fe;
4422 
4423       PetscCall(PetscDSGetDiscretization(prob, key.field, (PetscObject *) &fe));
4424       PetscCall(PetscFEGetFaceQuadrature(fe, &qGeom));
4425       PetscCall(PetscObjectReference((PetscObject)qGeom));
4426     }
4427     PetscCall(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
4428     PetscCall(DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
4429     for (face = 0; face < numFaces; ++face) {
4430       const PetscInt point = points[face], *support;
4431       PetscScalar   *x     = NULL;
4432       PetscInt       i;
4433 
4434       PetscCall(DMPlexGetSupport(dm, point, &support));
4435       PetscCall(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
4436       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
4437       PetscCall(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
4438       if (locX_t) {
4439         PetscCall(DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x));
4440         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
4441         PetscCall(DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x));
4442       }
4443       if (locA) {
4444         PetscInt subp;
4445 
4446         PetscCall(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
4447         PetscCall(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
4448         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
4449         PetscCall(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x));
4450       }
4451     }
4452     PetscCall(PetscArrayzero(elemVec, numFaces*totDim));
4453     {
4454       PetscFE         fe;
4455       PetscInt        Nb;
4456       PetscFEGeom     *chunkGeom = NULL;
4457       /* Conforming batches */
4458       PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
4459       /* Remainder */
4460       PetscInt        Nr, offset;
4461 
4462       PetscCall(PetscDSGetDiscretization(prob, key.field, (PetscObject *) &fe));
4463       PetscCall(PetscFEGetDimension(fe, &Nb));
4464       PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
4465       /* TODO: documentation is unclear about what is going on with these numbers: how should Nb / Nq factor in ? */
4466       blockSize = Nb;
4467       batchSize = numBlocks * blockSize;
4468       PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
4469       numChunks = numFaces / (numBatches*batchSize);
4470       Ne        = numChunks*numBatches*batchSize;
4471       Nr        = numFaces % (numBatches*batchSize);
4472       offset    = numFaces - Nr;
4473       PetscCall(PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom));
4474       PetscCall(PetscFEIntegrateBdResidual(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec));
4475       PetscCall(PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom));
4476       PetscCall(PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom));
4477       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]));
4478       PetscCall(PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom));
4479     }
4480     for (face = 0; face < numFaces; ++face) {
4481       const PetscInt point = points[face], *support;
4482 
4483       if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]));
4484       PetscCall(DMPlexGetSupport(plex, point, &support));
4485       PetscCall(DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES));
4486     }
4487     PetscCall(DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
4488     PetscCall(PetscQuadratureDestroy(&qGeom));
4489     PetscCall(ISRestoreIndices(pointIS, &points));
4490     PetscCall(ISDestroy(&pointIS));
4491     PetscCall(PetscFree4(u, u_t, elemVec, a));
4492   }
4493   end:
4494   PetscCall(DMDestroy(&plex));
4495   PetscCall(DMDestroy(&plexA));
4496   PetscFunctionReturn(0);
4497 }
4498 
4499 PetscErrorCode DMPlexComputeBdResidualSingle(DM dm, PetscReal t, PetscWeakForm wf, PetscFormKey key, Vec locX, Vec locX_t, Vec locF)
4500 {
4501   DMField        coordField;
4502   DMLabel        depthLabel;
4503   IS             facetIS;
4504   PetscInt       dim;
4505 
4506   PetscFunctionBegin;
4507   PetscCall(DMGetDimension(dm, &dim));
4508   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
4509   PetscCall(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
4510   PetscCall(DMGetCoordinateField(dm, &coordField));
4511   PetscCall(DMPlexComputeBdResidual_Single_Internal(dm, t, wf, key, locX, locX_t, locF, coordField, facetIS));
4512   PetscCall(ISDestroy(&facetIS));
4513   PetscFunctionReturn(0);
4514 }
4515 
4516 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4517 {
4518   PetscDS        prob;
4519   PetscInt       numBd, bd;
4520   DMField        coordField = NULL;
4521   IS             facetIS    = NULL;
4522   DMLabel        depthLabel;
4523   PetscInt       dim;
4524 
4525   PetscFunctionBegin;
4526   PetscCall(DMGetDS(dm, &prob));
4527   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
4528   PetscCall(DMGetDimension(dm, &dim));
4529   PetscCall(DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS));
4530   PetscCall(PetscDSGetNumBoundary(prob, &numBd));
4531   for (bd = 0; bd < numBd; ++bd) {
4532     PetscWeakForm           wf;
4533     DMBoundaryConditionType type;
4534     DMLabel                 label;
4535     const PetscInt         *values;
4536     PetscInt                field, numValues, v;
4537     PetscObject             obj;
4538     PetscClassId            id;
4539     PetscFormKey            key;
4540 
4541     PetscCall(PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &field, NULL, NULL, NULL, NULL, NULL));
4542     PetscCall(PetscDSGetDiscretization(prob, field, &obj));
4543     PetscCall(PetscObjectGetClassId(obj, &id));
4544     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
4545     if (!facetIS) {
4546       DMLabel  depthLabel;
4547       PetscInt dim;
4548 
4549       PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
4550       PetscCall(DMGetDimension(dm, &dim));
4551       PetscCall(DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS));
4552     }
4553     PetscCall(DMGetCoordinateField(dm, &coordField));
4554     for (v = 0; v < numValues; ++v) {
4555       key.label = label;
4556       key.value = values[v];
4557       key.field = field;
4558       key.part  = 0;
4559       PetscCall(DMPlexComputeBdResidual_Single_Internal(dm, t, wf, key, locX, locX_t, locF, coordField, facetIS));
4560     }
4561   }
4562   PetscCall(ISDestroy(&facetIS));
4563   PetscFunctionReturn(0);
4564 }
4565 
4566 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, PetscFormKey key, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4567 {
4568   DM_Plex         *mesh       = (DM_Plex *) dm->data;
4569   const char      *name       = "Residual";
4570   DM               dmAux      = NULL;
4571   DM               dmGrad     = NULL;
4572   DMLabel          ghostLabel = NULL;
4573   PetscDS          ds         = NULL;
4574   PetscDS          dsAux      = NULL;
4575   PetscSection     section    = NULL;
4576   PetscBool        useFEM     = PETSC_FALSE;
4577   PetscBool        useFVM     = PETSC_FALSE;
4578   PetscBool        isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
4579   PetscFV          fvm        = NULL;
4580   PetscFVCellGeom *cgeomFVM   = NULL;
4581   PetscFVFaceGeom *fgeomFVM   = NULL;
4582   DMField          coordField = NULL;
4583   Vec              locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL;
4584   PetscScalar     *u = NULL, *u_t, *a, *uL, *uR;
4585   IS               chunkIS;
4586   const PetscInt  *cells;
4587   PetscInt         cStart, cEnd, numCells;
4588   PetscInt         Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd;
4589   PetscInt         maxDegree = PETSC_MAX_INT;
4590   PetscQuadrature  affineQuad = NULL, *quads = NULL;
4591   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
4592 
4593   PetscFunctionBegin;
4594   PetscCall(PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0));
4595   /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4596   /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */
4597   /* FEM+FVM */
4598   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4599   PetscCall(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
4600   /* 1: Get sizes from dm and dmAux */
4601   PetscCall(DMGetLocalSection(dm, &section));
4602   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
4603   PetscCall(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &ds));
4604   PetscCall(PetscDSGetNumFields(ds, &Nf));
4605   PetscCall(PetscDSGetTotalDimension(ds, &totDim));
4606   PetscCall(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &locA));
4607   if (locA) {
4608     PetscInt subcell;
4609     PetscCall(VecGetDM(locA, &dmAux));
4610     PetscCall(DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell));
4611     PetscCall(DMGetCellDS(dmAux, subcell, &dsAux));
4612     PetscCall(PetscDSGetTotalDimension(dsAux, &totDimAux));
4613   }
4614   /* 2: Get geometric data */
4615   for (f = 0; f < Nf; ++f) {
4616     PetscObject  obj;
4617     PetscClassId id;
4618     PetscBool    fimp;
4619 
4620     PetscCall(PetscDSGetImplicit(ds, f, &fimp));
4621     if (isImplicit != fimp) continue;
4622     PetscCall(PetscDSGetDiscretization(ds, f, &obj));
4623     PetscCall(PetscObjectGetClassId(obj, &id));
4624     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
4625     if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
4626   }
4627   if (useFEM) {
4628     PetscCall(DMGetCoordinateField(dm, &coordField));
4629     PetscCall(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
4630     if (maxDegree <= 1) {
4631       PetscCall(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
4632       if (affineQuad) {
4633         PetscCall(DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4634       }
4635     } else {
4636       PetscCall(PetscCalloc2(Nf,&quads,Nf,&geoms));
4637       for (f = 0; f < Nf; ++f) {
4638         PetscObject  obj;
4639         PetscClassId id;
4640         PetscBool    fimp;
4641 
4642         PetscCall(PetscDSGetImplicit(ds, f, &fimp));
4643         if (isImplicit != fimp) continue;
4644         PetscCall(PetscDSGetDiscretization(ds, f, &obj));
4645         PetscCall(PetscObjectGetClassId(obj, &id));
4646         if (id == PETSCFE_CLASSID) {
4647           PetscFE fe = (PetscFE) obj;
4648 
4649           PetscCall(PetscFEGetQuadrature(fe, &quads[f]));
4650           PetscCall(PetscObjectReference((PetscObject)quads[f]));
4651           PetscCall(DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4652         }
4653       }
4654     }
4655   }
4656   if (useFVM) {
4657     PetscCall(DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL));
4658     PetscCall(VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM));
4659     PetscCall(VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
4660     /* Reconstruct and limit cell gradients */
4661     PetscCall(DMPlexGetGradientDM(dm, fvm, &dmGrad));
4662     if (dmGrad) {
4663       PetscCall(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
4664       PetscCall(DMGetGlobalVector(dmGrad, &grad));
4665       PetscCall(DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad));
4666       /* Communicate gradient values */
4667       PetscCall(DMGetLocalVector(dmGrad, &locGrad));
4668       PetscCall(DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad));
4669       PetscCall(DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad));
4670       PetscCall(DMRestoreGlobalVector(dmGrad, &grad));
4671     }
4672     /* Handle non-essential (e.g. outflow) boundary values */
4673     PetscCall(DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad));
4674   }
4675   /* Loop over chunks */
4676   if (useFEM) PetscCall(ISCreate(PETSC_COMM_SELF, &chunkIS));
4677   numCells      = cEnd - cStart;
4678   numChunks     = 1;
4679   cellChunkSize = numCells/numChunks;
4680   faceChunkSize = (fEnd - fStart)/numChunks;
4681   numChunks     = PetscMin(1,numCells);
4682   for (chunk = 0; chunk < numChunks; ++chunk) {
4683     PetscScalar     *elemVec, *fluxL, *fluxR;
4684     PetscReal       *vol;
4685     PetscFVFaceGeom *fgeom;
4686     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
4687     PetscInt         fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face;
4688 
4689     /* Extract field coefficients */
4690     if (useFEM) {
4691       PetscCall(ISGetPointSubrange(chunkIS, cS, cE, cells));
4692       PetscCall(DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4693       PetscCall(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4694       PetscCall(PetscArrayzero(elemVec, numCells*totDim));
4695     }
4696     if (useFVM) {
4697       PetscCall(DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR));
4698       PetscCall(DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol));
4699       PetscCall(DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL));
4700       PetscCall(DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR));
4701       PetscCall(PetscArrayzero(fluxL, numFaces*totDim));
4702       PetscCall(PetscArrayzero(fluxR, numFaces*totDim));
4703     }
4704     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
4705     /* Loop over fields */
4706     for (f = 0; f < Nf; ++f) {
4707       PetscObject  obj;
4708       PetscClassId id;
4709       PetscBool    fimp;
4710       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
4711 
4712       key.field = f;
4713       PetscCall(PetscDSGetImplicit(ds, f, &fimp));
4714       if (isImplicit != fimp) continue;
4715       PetscCall(PetscDSGetDiscretization(ds, f, &obj));
4716       PetscCall(PetscObjectGetClassId(obj, &id));
4717       if (id == PETSCFE_CLASSID) {
4718         PetscFE         fe = (PetscFE) obj;
4719         PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
4720         PetscFEGeom    *chunkGeom = NULL;
4721         PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
4722         PetscInt        Nq, Nb;
4723 
4724         PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
4725         PetscCall(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
4726         PetscCall(PetscFEGetDimension(fe, &Nb));
4727         blockSize = Nb;
4728         batchSize = numBlocks * blockSize;
4729         PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
4730         numChunks = numCells / (numBatches*batchSize);
4731         Ne        = numChunks*numBatches*batchSize;
4732         Nr        = numCells % (numBatches*batchSize);
4733         offset    = numCells - Nr;
4734         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
4735         /*   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) */
4736         PetscCall(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
4737         PetscCall(PetscFEIntegrateResidual(ds, key, Ne, chunkGeom, u, u_t, dsAux, a, t, elemVec));
4738         PetscCall(PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom));
4739         PetscCall(PetscFEIntegrateResidual(ds, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]));
4740         PetscCall(PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom));
4741       } else if (id == PETSCFV_CLASSID) {
4742         PetscFV fv = (PetscFV) obj;
4743 
4744         Ne = numFaces;
4745         /* Riemann solve over faces (need fields at face centroids) */
4746         /*   We need to evaluate FE fields at those coordinates */
4747         PetscCall(PetscFVIntegrateRHSFunction(fv, ds, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR));
4748       } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
4749     }
4750     /* Loop over domain */
4751     if (useFEM) {
4752       /* Add elemVec to locX */
4753       for (c = cS; c < cE; ++c) {
4754         const PetscInt cell = cells ? cells[c] : c;
4755         const PetscInt cind = c - cStart;
4756 
4757         if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
4758         if (ghostLabel) {
4759           PetscInt ghostVal;
4760 
4761           PetscCall(DMLabelGetValue(ghostLabel,cell,&ghostVal));
4762           if (ghostVal > 0) continue;
4763         }
4764         PetscCall(DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES));
4765       }
4766     }
4767     if (useFVM) {
4768       PetscScalar *fa;
4769       PetscInt     iface;
4770 
4771       PetscCall(VecGetArray(locF, &fa));
4772       for (f = 0; f < Nf; ++f) {
4773         PetscFV      fv;
4774         PetscObject  obj;
4775         PetscClassId id;
4776         PetscInt     foff, pdim;
4777 
4778         PetscCall(PetscDSGetDiscretization(ds, f, &obj));
4779         PetscCall(PetscDSGetFieldOffset(ds, f, &foff));
4780         PetscCall(PetscObjectGetClassId(obj, &id));
4781         if (id != PETSCFV_CLASSID) continue;
4782         fv   = (PetscFV) obj;
4783         PetscCall(PetscFVGetNumComponents(fv, &pdim));
4784         /* Accumulate fluxes to cells */
4785         for (face = fS, iface = 0; face < fE; ++face) {
4786           const PetscInt *scells;
4787           PetscScalar    *fL = NULL, *fR = NULL;
4788           PetscInt        ghost, d, nsupp, nchild;
4789 
4790           PetscCall(DMLabelGetValue(ghostLabel, face, &ghost));
4791           PetscCall(DMPlexGetSupportSize(dm, face, &nsupp));
4792           PetscCall(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
4793           if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
4794           PetscCall(DMPlexGetSupport(dm, face, &scells));
4795           PetscCall(DMLabelGetValue(ghostLabel,scells[0],&ghost));
4796           if (ghost <= 0) PetscCall(DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL));
4797           PetscCall(DMLabelGetValue(ghostLabel,scells[1],&ghost));
4798           if (ghost <= 0) PetscCall(DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR));
4799           for (d = 0; d < pdim; ++d) {
4800             if (fL) fL[d] -= fluxL[iface*totDim+foff+d];
4801             if (fR) fR[d] += fluxR[iface*totDim+foff+d];
4802           }
4803           ++iface;
4804         }
4805       }
4806       PetscCall(VecRestoreArray(locF, &fa));
4807     }
4808     /* Handle time derivative */
4809     if (locX_t) {
4810       PetscScalar *x_t, *fa;
4811 
4812       PetscCall(VecGetArray(locF, &fa));
4813       PetscCall(VecGetArray(locX_t, &x_t));
4814       for (f = 0; f < Nf; ++f) {
4815         PetscFV      fv;
4816         PetscObject  obj;
4817         PetscClassId id;
4818         PetscInt     pdim, d;
4819 
4820         PetscCall(PetscDSGetDiscretization(ds, f, &obj));
4821         PetscCall(PetscObjectGetClassId(obj, &id));
4822         if (id != PETSCFV_CLASSID) continue;
4823         fv   = (PetscFV) obj;
4824         PetscCall(PetscFVGetNumComponents(fv, &pdim));
4825         for (c = cS; c < cE; ++c) {
4826           const PetscInt cell = cells ? cells[c] : c;
4827           PetscScalar   *u_t, *r;
4828 
4829           if (ghostLabel) {
4830             PetscInt ghostVal;
4831 
4832             PetscCall(DMLabelGetValue(ghostLabel, cell, &ghostVal));
4833             if (ghostVal > 0) continue;
4834           }
4835           PetscCall(DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t));
4836           PetscCall(DMPlexPointLocalFieldRef(dm, cell, f, fa, &r));
4837           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4838         }
4839       }
4840       PetscCall(VecRestoreArray(locX_t, &x_t));
4841       PetscCall(VecRestoreArray(locF, &fa));
4842     }
4843     if (useFEM) {
4844       PetscCall(DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4845       PetscCall(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4846     }
4847     if (useFVM) {
4848       PetscCall(DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR));
4849       PetscCall(DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol));
4850       PetscCall(DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL));
4851       PetscCall(DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR));
4852       if (dmGrad) PetscCall(DMRestoreLocalVector(dmGrad, &locGrad));
4853     }
4854   }
4855   if (useFEM) PetscCall(ISDestroy(&chunkIS));
4856   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
4857 
4858   if (useFEM) {
4859     PetscCall(DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user));
4860 
4861     if (maxDegree <= 1) {
4862       PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4863       PetscCall(PetscQuadratureDestroy(&affineQuad));
4864     } else {
4865       for (f = 0; f < Nf; ++f) {
4866         PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4867         PetscCall(PetscQuadratureDestroy(&quads[f]));
4868       }
4869       PetscCall(PetscFree2(quads,geoms));
4870     }
4871   }
4872 
4873   /* FEM */
4874   /* 1: Get sizes from dm and dmAux */
4875   /* 2: Get geometric data */
4876   /* 3: Handle boundary values */
4877   /* 4: Loop over domain */
4878   /*   Extract coefficients */
4879   /* Loop over fields */
4880   /*   Set tiling for FE*/
4881   /*   Integrate FE residual to get elemVec */
4882   /*     Loop over subdomain */
4883   /*       Loop over quad points */
4884   /*         Transform coords to real space */
4885   /*         Evaluate field and aux fields at point */
4886   /*         Evaluate residual at point */
4887   /*         Transform residual to real space */
4888   /*       Add residual to elemVec */
4889   /* Loop over domain */
4890   /*   Add elemVec to locX */
4891 
4892   /* FVM */
4893   /* Get geometric data */
4894   /* If using gradients */
4895   /*   Compute gradient data */
4896   /*   Loop over domain faces */
4897   /*     Count computational faces */
4898   /*     Reconstruct cell gradient */
4899   /*   Loop over domain cells */
4900   /*     Limit cell gradients */
4901   /* Handle boundary values */
4902   /* Loop over domain faces */
4903   /*   Read out field, centroid, normal, volume for each side of face */
4904   /* Riemann solve over faces */
4905   /* Loop over domain faces */
4906   /*   Accumulate fluxes to cells */
4907   /* TODO Change printFEM to printDisc here */
4908   if (mesh->printFEM) {
4909     Vec         locFbc;
4910     PetscInt    pStart, pEnd, p, maxDof;
4911     PetscScalar *zeroes;
4912 
4913     PetscCall(VecDuplicate(locF,&locFbc));
4914     PetscCall(VecCopy(locF,locFbc));
4915     PetscCall(PetscSectionGetChart(section,&pStart,&pEnd));
4916     PetscCall(PetscSectionGetMaxDof(section,&maxDof));
4917     PetscCall(PetscCalloc1(maxDof,&zeroes));
4918     for (p = pStart; p < pEnd; p++) {
4919       PetscCall(VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES));
4920     }
4921     PetscCall(PetscFree(zeroes));
4922     PetscCall(DMPrintLocalVec(dm, name, mesh->printTol, locFbc));
4923     PetscCall(VecDestroy(&locFbc));
4924   }
4925   PetscCall(PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0));
4926   PetscFunctionReturn(0);
4927 }
4928 
4929 /*
4930   1) Allow multiple kernels for BdResidual for hybrid DS
4931 
4932   DONE 2) Get out dsAux for either side at the same time as cohesive cell dsAux
4933 
4934   DONE 3) Change DMGetCellFields() to get different aux data a[] for each side
4935      - I think I just need to replace a[] with the closure from each face
4936 
4937   4) Run both kernels for each non-hybrid field with correct dsAux, and then hybrid field as before
4938 */
4939 PetscErrorCode DMPlexComputeResidual_Hybrid_Internal(DM dm, PetscFormKey key[], IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4940 {
4941   DM_Plex         *mesh       = (DM_Plex *) dm->data;
4942   const char      *name       = "Hybrid Residual";
4943   DM               dmAux[3]   = {NULL, NULL, NULL};
4944   DMLabel          ghostLabel = NULL;
4945   PetscDS          ds         = NULL;
4946   PetscDS          dsAux[3]   = {NULL, NULL, NULL};
4947   Vec              locA[3]    = {NULL, NULL, NULL};
4948   PetscSection     section    = NULL;
4949   DMField          coordField = NULL;
4950   PetscScalar     *u = NULL, *u_t, *a[3];
4951   PetscScalar     *elemVec;
4952   IS               chunkIS;
4953   const PetscInt  *cells;
4954   PetscInt        *faces;
4955   PetscInt         cStart, cEnd, numCells;
4956   PetscInt         Nf, f, totDim, totDimAux[3], numChunks, cellChunkSize, chunk;
4957   PetscInt         maxDegree = PETSC_MAX_INT;
4958   PetscQuadrature  affineQuad = NULL, *quads = NULL;
4959   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
4960 
4961   PetscFunctionBegin;
4962   if ((key[0].label == key[1].label) && (key[0].value == key[1].value) && (key[0].part == key[1].part)) {
4963     const char *name;
4964     PetscCall(PetscObjectGetName((PetscObject) key[0].label, &name));
4965     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Form keys for each side of a cohesive surface must be different (%s, %D, %D)", name, key[0].value, key[0].part);
4966   }
4967   PetscCall(PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0));
4968   /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4969   /* FEM */
4970   PetscCall(ISGetLocalSize(cellIS, &numCells));
4971   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4972   /* 1: Get sizes from dm and dmAux */
4973   PetscCall(DMGetSection(dm, &section));
4974   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
4975   PetscCall(DMGetCellDS(dm, cStart, &ds));
4976   PetscCall(PetscDSGetNumFields(ds, &Nf));
4977   PetscCall(PetscDSGetTotalDimension(ds, &totDim));
4978   PetscCall(DMGetAuxiliaryVec(dm, key[2].label, key[2].value, key[2].part, &locA[2]));
4979   if (locA[2]) {
4980     PetscCall(VecGetDM(locA[2], &dmAux[2]));
4981     PetscCall(DMGetCellDS(dmAux[2], cStart, &dsAux[2]));
4982     PetscCall(PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]));
4983     {
4984       const PetscInt *cone;
4985       PetscInt        c;
4986 
4987       PetscCall(DMPlexGetCone(dm, cStart, &cone));
4988       for (c = 0; c < 2; ++c) {
4989         const PetscInt *support;
4990         PetscInt ssize, s;
4991 
4992         PetscCall(DMPlexGetSupport(dm, cone[c], &support));
4993         PetscCall(DMPlexGetSupportSize(dm, cone[c], &ssize));
4994         PetscCheck(ssize == 2,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D from cell %D has support size %D != 2", cone[c], cStart, ssize);
4995         if      (support[0] == cStart) s = 1;
4996         else if (support[1] == cStart) s = 0;
4997         else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart);
4998         PetscCall(DMGetAuxiliaryVec(dm, key[c].label, key[c].value, key[c].part, &locA[c]));
4999         if (locA[c]) PetscCall(VecGetDM(locA[c], &dmAux[c]));
5000         else         {dmAux[c] = dmAux[2];}
5001         PetscCall(DMGetCellDS(dmAux[c], support[s], &dsAux[c]));
5002         PetscCall(PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]));
5003       }
5004     }
5005   }
5006   /* 2: Setup geometric data */
5007   PetscCall(DMGetCoordinateField(dm, &coordField));
5008   PetscCall(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
5009   if (maxDegree > 1) {
5010     PetscCall(PetscCalloc2(Nf, &quads, Nf, &geoms));
5011     for (f = 0; f < Nf; ++f) {
5012       PetscFE fe;
5013 
5014       PetscCall(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5015       if (fe) {
5016         PetscCall(PetscFEGetQuadrature(fe, &quads[f]));
5017         PetscCall(PetscObjectReference((PetscObject) quads[f]));
5018       }
5019     }
5020   }
5021   /* Loop over chunks */
5022   cellChunkSize = numCells;
5023   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5024   PetscCall(PetscCalloc1(2*cellChunkSize, &faces));
5025   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS));
5026   /* Extract field coefficients */
5027   /* NOTE This needs the end cap faces to have identical orientations */
5028   PetscCall(DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5029   PetscCall(DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a));
5030   PetscCall(DMGetWorkArray(dm, cellChunkSize*totDim, MPIU_SCALAR, &elemVec));
5031   for (chunk = 0; chunk < numChunks; ++chunk) {
5032     PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
5033 
5034     PetscCall(PetscMemzero(elemVec, cellChunkSize*totDim * sizeof(PetscScalar)));
5035     /* Get faces */
5036     for (c = cS; c < cE; ++c) {
5037       const PetscInt  cell = cells ? cells[c] : c;
5038       const PetscInt *cone;
5039       PetscCall(DMPlexGetCone(dm, cell, &cone));
5040       faces[(c-cS)*2+0] = cone[0];
5041       faces[(c-cS)*2+1] = cone[1];
5042     }
5043     PetscCall(ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER));
5044     /* Get geometric data */
5045     if (maxDegree <= 1) {
5046       if (!affineQuad) PetscCall(DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad));
5047       if (affineQuad)  PetscCall(DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom));
5048     } else {
5049       for (f = 0; f < Nf; ++f) {
5050         if (quads[f]) PetscCall(DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]));
5051       }
5052     }
5053     /* Loop over fields */
5054     for (f = 0; f < Nf; ++f) {
5055       PetscFE         fe;
5056       PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[f];
5057       PetscFEGeom    *chunkGeom = NULL, *remGeom = NULL;
5058       PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
5059       PetscInt        numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
5060       PetscBool       isCohesiveField;
5061 
5062       PetscCall(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5063       if (!fe) continue;
5064       PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5065       PetscCall(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
5066       PetscCall(PetscFEGetDimension(fe, &Nb));
5067       blockSize = Nb;
5068       batchSize = numBlocks * blockSize;
5069       PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
5070       numChunks = numCells / (numBatches*batchSize);
5071       Ne        = numChunks*numBatches*batchSize;
5072       Nr        = numCells % (numBatches*batchSize);
5073       offset    = numCells - Nr;
5074       PetscCall(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
5075       PetscCall(PetscFEGeomGetChunk(geom,offset,numCells,&remGeom));
5076       PetscCall(PetscDSGetCohesive(ds, f, &isCohesiveField));
5077       chunkGeom->isCohesive = remGeom->isCohesive = PETSC_TRUE;
5078       key[0].field = f;
5079       key[1].field = f;
5080       key[2].field = f;
5081       PetscCall(PetscFEIntegrateHybridResidual(ds, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, elemVec));
5082       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]));
5083       PetscCall(PetscFEIntegrateHybridResidual(ds, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, elemVec));
5084       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]));
5085       PetscCall(PetscFEIntegrateHybridResidual(ds, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, elemVec));
5086       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]));
5087       PetscCall(PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom));
5088       PetscCall(PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom));
5089     }
5090     /* Add elemVec to locX */
5091     for (c = cS; c < cE; ++c) {
5092       const PetscInt cell = cells ? cells[c] : c;
5093       const PetscInt cind = c - cStart;
5094 
5095       if (mesh->printFEM > 1) PetscCall(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
5096       if (ghostLabel) {
5097         PetscInt ghostVal;
5098 
5099         PetscCall(DMLabelGetValue(ghostLabel,cell,&ghostVal));
5100         if (ghostVal > 0) continue;
5101       }
5102       PetscCall(DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES));
5103     }
5104   }
5105   PetscCall(DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5106   PetscCall(DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a));
5107   PetscCall(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
5108   PetscCall(PetscFree(faces));
5109   PetscCall(ISDestroy(&chunkIS));
5110   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5111   if (maxDegree <= 1) {
5112     PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
5113     PetscCall(PetscQuadratureDestroy(&affineQuad));
5114   } else {
5115     for (f = 0; f < Nf; ++f) {
5116       if (geoms) PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
5117       if (quads) PetscCall(PetscQuadratureDestroy(&quads[f]));
5118     }
5119     PetscCall(PetscFree2(quads,geoms));
5120   }
5121   PetscCall(PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0));
5122   PetscFunctionReturn(0);
5123 }
5124 
5125 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)
5126 {
5127   DM_Plex        *mesh = (DM_Plex *) dm->data;
5128   DM              plex = NULL, plexA = NULL, tdm;
5129   DMEnclosureType encAux;
5130   PetscDS         prob, probAux = NULL;
5131   PetscSection    section, sectionAux = NULL;
5132   PetscSection    globalSection;
5133   Vec             locA = NULL, tv;
5134   PetscScalar    *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL;
5135   PetscInt        v;
5136   PetscInt        Nf, totDim, totDimAux = 0;
5137   PetscBool       transform;
5138 
5139   PetscFunctionBegin;
5140   PetscCall(DMConvert(dm, DMPLEX, &plex));
5141   PetscCall(DMHasBasisTransform(dm, &transform));
5142   PetscCall(DMGetBasisTransformDM_Internal(dm, &tdm));
5143   PetscCall(DMGetBasisTransformVec_Internal(dm, &tv));
5144   PetscCall(DMGetLocalSection(dm, &section));
5145   PetscCall(DMGetDS(dm, &prob));
5146   PetscCall(PetscDSGetNumFields(prob, &Nf));
5147   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
5148   PetscCall(DMGetAuxiliaryVec(dm, label, values[0], 0, &locA));
5149   if (locA) {
5150     DM dmAux;
5151 
5152     PetscCall(VecGetDM(locA, &dmAux));
5153     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
5154     PetscCall(DMConvert(dmAux, DMPLEX, &plexA));
5155     PetscCall(DMGetDS(plexA, &probAux));
5156     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
5157     PetscCall(DMGetLocalSection(plexA, &sectionAux));
5158   }
5159 
5160   PetscCall(DMGetGlobalSection(dm, &globalSection));
5161   for (v = 0; v < numValues; ++v) {
5162     PetscFEGeom     *fgeom;
5163     PetscInt         maxDegree;
5164     PetscQuadrature  qGeom = NULL;
5165     IS               pointIS;
5166     const PetscInt  *points;
5167     PetscFormKey key;
5168     PetscInt         numFaces, face, Nq;
5169 
5170     key.label = label;
5171     key.value = values[v];
5172     key.part  = 0;
5173     PetscCall(DMLabelGetStratumIS(label, values[v], &pointIS));
5174     if (!pointIS) continue; /* No points with that id on this process */
5175     {
5176       IS isectIS;
5177 
5178       /* TODO: Special cases of ISIntersect where it is quick to check a prior if one is a superset of the other */
5179       PetscCall(ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS));
5180       PetscCall(ISDestroy(&pointIS));
5181       pointIS = isectIS;
5182     }
5183     PetscCall(ISGetLocalSize(pointIS, &numFaces));
5184     PetscCall(ISGetIndices(pointIS, &points));
5185     PetscCall(PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a));
5186     PetscCall(DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree));
5187     if (maxDegree <= 1) {
5188       PetscCall(DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom));
5189     }
5190     if (!qGeom) {
5191       PetscFE fe;
5192 
5193       PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5194       PetscCall(PetscFEGetFaceQuadrature(fe, &qGeom));
5195       PetscCall(PetscObjectReference((PetscObject)qGeom));
5196     }
5197     PetscCall(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5198     PetscCall(DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
5199     for (face = 0; face < numFaces; ++face) {
5200       const PetscInt point = points[face], *support;
5201       PetscScalar   *x     = NULL;
5202       PetscInt       i;
5203 
5204       PetscCall(DMPlexGetSupport(dm, point, &support));
5205       PetscCall(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
5206       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
5207       PetscCall(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
5208       if (locX_t) {
5209         PetscCall(DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x));
5210         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
5211         PetscCall(DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x));
5212       }
5213       if (locA) {
5214         PetscInt subp;
5215         PetscCall(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
5216         PetscCall(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
5217         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
5218         PetscCall(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x));
5219       }
5220     }
5221     PetscCall(PetscArrayzero(elemMat, numFaces*totDim*totDim));
5222     {
5223       PetscFE         fe;
5224       PetscInt        Nb;
5225       /* Conforming batches */
5226       PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5227       /* Remainder */
5228       PetscFEGeom    *chunkGeom = NULL;
5229       PetscInt        fieldJ, Nr, offset;
5230 
5231       PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5232       PetscCall(PetscFEGetDimension(fe, &Nb));
5233       PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5234       blockSize = Nb;
5235       batchSize = numBlocks * blockSize;
5236       PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
5237       numChunks = numFaces / (numBatches*batchSize);
5238       Ne        = numChunks*numBatches*batchSize;
5239       Nr        = numFaces % (numBatches*batchSize);
5240       offset    = numFaces - Nr;
5241       PetscCall(PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom));
5242       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5243         key.field = fieldI*Nf+fieldJ;
5244         PetscCall(PetscFEIntegrateBdJacobian(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5245       }
5246       PetscCall(PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom));
5247       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5248         key.field = fieldI*Nf+fieldJ;
5249         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]));
5250       }
5251       PetscCall(PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom));
5252     }
5253     for (face = 0; face < numFaces; ++face) {
5254       const PetscInt point = points[face], *support;
5255 
5256       /* Transform to global basis before insertion in Jacobian */
5257       PetscCall(DMPlexGetSupport(plex, point, &support));
5258       if (transform) PetscCall(DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]));
5259       if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]));
5260       PetscCall(DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES));
5261     }
5262     PetscCall(DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
5263     PetscCall(PetscQuadratureDestroy(&qGeom));
5264     PetscCall(ISRestoreIndices(pointIS, &points));
5265     PetscCall(ISDestroy(&pointIS));
5266     PetscCall(PetscFree4(u, u_t, elemMat, a));
5267   }
5268   if (plex)  PetscCall(DMDestroy(&plex));
5269   if (plexA) PetscCall(DMDestroy(&plexA));
5270   PetscFunctionReturn(0);
5271 }
5272 
5273 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)
5274 {
5275   DMField        coordField;
5276   DMLabel        depthLabel;
5277   IS             facetIS;
5278   PetscInt       dim;
5279 
5280   PetscFunctionBegin;
5281   PetscCall(DMGetDimension(dm, &dim));
5282   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
5283   PetscCall(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
5284   PetscCall(DMGetCoordinateField(dm, &coordField));
5285   PetscCall(DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS));
5286   PetscCall(ISDestroy(&facetIS));
5287   PetscFunctionReturn(0);
5288 }
5289 
5290 PetscErrorCode DMPlexComputeBdJacobian_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, PetscReal X_tShift, Mat Jac, Mat JacP, void *user)
5291 {
5292   PetscDS          prob;
5293   PetscInt         dim, numBd, bd;
5294   DMLabel          depthLabel;
5295   DMField          coordField = NULL;
5296   IS               facetIS;
5297 
5298   PetscFunctionBegin;
5299   PetscCall(DMGetDS(dm, &prob));
5300   PetscCall(DMPlexGetDepthLabel(dm, &depthLabel));
5301   PetscCall(DMGetDimension(dm, &dim));
5302   PetscCall(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
5303   PetscCall(PetscDSGetNumBoundary(prob, &numBd));
5304   PetscCall(DMGetCoordinateField(dm, &coordField));
5305   for (bd = 0; bd < numBd; ++bd) {
5306     PetscWeakForm           wf;
5307     DMBoundaryConditionType type;
5308     DMLabel                 label;
5309     const PetscInt         *values;
5310     PetscInt                fieldI, numValues;
5311     PetscObject             obj;
5312     PetscClassId            id;
5313 
5314     PetscCall(PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &fieldI, NULL, NULL, NULL, NULL, NULL));
5315     PetscCall(PetscDSGetDiscretization(prob, fieldI, &obj));
5316     PetscCall(PetscObjectGetClassId(obj, &id));
5317     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
5318     PetscCall(DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS));
5319   }
5320   PetscCall(ISDestroy(&facetIS));
5321   PetscFunctionReturn(0);
5322 }
5323 
5324 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)
5325 {
5326   DM_Plex        *mesh  = (DM_Plex *) dm->data;
5327   const char     *name  = "Jacobian";
5328   DM              dmAux = NULL, plex, tdm;
5329   DMEnclosureType encAux;
5330   Vec             A, tv;
5331   DMField         coordField;
5332   PetscDS         prob, probAux = NULL;
5333   PetscSection    section, globalSection, sectionAux;
5334   PetscScalar    *elemMat, *elemMatP, *elemMatD, *u, *u_t, *a = NULL;
5335   const PetscInt *cells;
5336   PetscInt        Nf, fieldI, fieldJ;
5337   PetscInt        totDim, totDimAux, cStart, cEnd, numCells, c;
5338   PetscBool       hasJac, hasPrec, hasDyn, hasFV = PETSC_FALSE, transform;
5339 
5340   PetscFunctionBegin;
5341   PetscCall(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5342   PetscCall(ISGetLocalSize(cellIS, &numCells));
5343   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5344   PetscCall(DMHasBasisTransform(dm, &transform));
5345   PetscCall(DMGetBasisTransformDM_Internal(dm, &tdm));
5346   PetscCall(DMGetBasisTransformVec_Internal(dm, &tv));
5347   PetscCall(DMGetLocalSection(dm, &section));
5348   PetscCall(DMGetGlobalSection(dm, &globalSection));
5349   PetscCall(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
5350   PetscCall(PetscDSGetNumFields(prob, &Nf));
5351   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
5352   PetscCall(PetscDSHasJacobian(prob, &hasJac));
5353   PetscCall(PetscDSHasJacobianPreconditioner(prob, &hasPrec));
5354   /* user passed in the same matrix, avoid double contributions and
5355      only assemble the Jacobian */
5356   if (hasJac && Jac == JacP) hasPrec = PETSC_FALSE;
5357   PetscCall(PetscDSHasDynamicJacobian(prob, &hasDyn));
5358   hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5359   PetscCall(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &A));
5360   if (A) {
5361     PetscCall(VecGetDM(A, &dmAux));
5362     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
5363     PetscCall(DMConvert(dmAux, DMPLEX, &plex));
5364     PetscCall(DMGetLocalSection(plex, &sectionAux));
5365     PetscCall(DMGetDS(dmAux, &probAux));
5366     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
5367   }
5368   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));
5369   if (dmAux) PetscCall(PetscMalloc1(numCells*totDimAux, &a));
5370   PetscCall(DMGetCoordinateField(dm, &coordField));
5371   for (c = cStart; c < cEnd; ++c) {
5372     const PetscInt cell = cells ? cells[c] : c;
5373     const PetscInt cind = c - cStart;
5374     PetscScalar   *x = NULL,  *x_t = NULL;
5375     PetscInt       i;
5376 
5377     PetscCall(DMPlexVecGetClosure(dm, section, X, cell, NULL, &x));
5378     for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5379     PetscCall(DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x));
5380     if (X_t) {
5381       PetscCall(DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t));
5382       for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i];
5383       PetscCall(DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t));
5384     }
5385     if (dmAux) {
5386       PetscInt subcell;
5387       PetscCall(DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell));
5388       PetscCall(DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x));
5389       for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5390       PetscCall(DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x));
5391     }
5392   }
5393   if (hasJac)  PetscCall(PetscArrayzero(elemMat,  numCells*totDim*totDim));
5394   if (hasPrec) PetscCall(PetscArrayzero(elemMatP, numCells*totDim*totDim));
5395   if (hasDyn)  PetscCall(PetscArrayzero(elemMatD, numCells*totDim*totDim));
5396   for (fieldI = 0; fieldI < Nf; ++fieldI) {
5397     PetscClassId    id;
5398     PetscFE         fe;
5399     PetscQuadrature qGeom = NULL;
5400     PetscInt        Nb;
5401     /* Conforming batches */
5402     PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5403     /* Remainder */
5404     PetscInt        Nr, offset, Nq;
5405     PetscInt        maxDegree;
5406     PetscFEGeom     *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL;
5407 
5408     PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5409     PetscCall(PetscObjectGetClassId((PetscObject) fe, &id));
5410     if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;}
5411     PetscCall(PetscFEGetDimension(fe, &Nb));
5412     PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5413     PetscCall(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
5414     if (maxDegree <= 1) {
5415       PetscCall(DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom));
5416     }
5417     if (!qGeom) {
5418       PetscCall(PetscFEGetQuadrature(fe,&qGeom));
5419       PetscCall(PetscObjectReference((PetscObject)qGeom));
5420     }
5421     PetscCall(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5422     PetscCall(DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5423     blockSize = Nb;
5424     batchSize = numBlocks * blockSize;
5425     PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
5426     numChunks = numCells / (numBatches*batchSize);
5427     Ne        = numChunks*numBatches*batchSize;
5428     Nr        = numCells % (numBatches*batchSize);
5429     offset    = numCells - Nr;
5430     PetscCall(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
5431     PetscCall(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom));
5432     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5433       key.field = fieldI*Nf+fieldJ;
5434       if (hasJac) {
5435         PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5436         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]));
5437       }
5438       if (hasPrec) {
5439         PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP));
5440         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]));
5441       }
5442       if (hasDyn) {
5443         PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD));
5444         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]));
5445       }
5446     }
5447     PetscCall(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom));
5448     PetscCall(PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom));
5449     PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5450     PetscCall(PetscQuadratureDestroy(&qGeom));
5451   }
5452   /*   Add contribution from X_t */
5453   if (hasDyn) {for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
5454   if (hasFV) {
5455     PetscClassId id;
5456     PetscFV      fv;
5457     PetscInt     offsetI, NcI, NbI = 1, fc, f;
5458 
5459     for (fieldI = 0; fieldI < Nf; ++fieldI) {
5460       PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv));
5461       PetscCall(PetscDSGetFieldOffset(prob, fieldI, &offsetI));
5462       PetscCall(PetscObjectGetClassId((PetscObject) fv, &id));
5463       if (id != PETSCFV_CLASSID) continue;
5464       /* Put in the identity */
5465       PetscCall(PetscFVGetNumComponents(fv, &NcI));
5466       for (c = cStart; c < cEnd; ++c) {
5467         const PetscInt cind    = c - cStart;
5468         const PetscInt eOffset = cind*totDim*totDim;
5469         for (fc = 0; fc < NcI; ++fc) {
5470           for (f = 0; f < NbI; ++f) {
5471             const PetscInt i = offsetI + f*NcI+fc;
5472             if (hasPrec) {
5473               if (hasJac) {elemMat[eOffset+i*totDim+i] = 1.0;}
5474               elemMatP[eOffset+i*totDim+i] = 1.0;
5475             } else {elemMat[eOffset+i*totDim+i] = 1.0;}
5476           }
5477         }
5478       }
5479     }
5480     /* No allocated space for FV stuff, so ignore the zero entries */
5481     PetscCall(MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE));
5482   }
5483   /* Insert values into matrix */
5484   for (c = cStart; c < cEnd; ++c) {
5485     const PetscInt cell = cells ? cells[c] : c;
5486     const PetscInt cind = c - cStart;
5487 
5488     /* Transform to global basis before insertion in Jacobian */
5489     if (transform) PetscCall(DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]));
5490     if (hasPrec) {
5491       if (hasJac) {
5492         if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5493         PetscCall(DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5494       }
5495       if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]));
5496       PetscCall(DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES));
5497     } else {
5498       if (hasJac) {
5499         if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5500         PetscCall(DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5501       }
5502     }
5503   }
5504   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5505   if (hasFV) PetscCall(MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
5506   PetscCall(PetscFree5(u,u_t,elemMat,elemMatP,elemMatD));
5507   if (dmAux) {
5508     PetscCall(PetscFree(a));
5509     PetscCall(DMDestroy(&plex));
5510   }
5511   /* Compute boundary integrals */
5512   PetscCall(DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user));
5513   /* Assemble matrix */
5514   if (hasJac && hasPrec) {
5515     PetscCall(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));
5516     PetscCall(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));
5517   }
5518   PetscCall(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));
5519   PetscCall(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
5520   PetscCall(PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0));
5521   PetscFunctionReturn(0);
5522 }
5523 
5524 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)
5525 {
5526   DM_Plex         *mesh          = (DM_Plex *) dm->data;
5527   const char      *name          = "Hybrid Jacobian";
5528   DM               dmAux[3]      = {NULL, NULL, NULL};
5529   DMLabel          ghostLabel    = NULL;
5530   DM               plex          = NULL;
5531   DM               plexA         = NULL;
5532   PetscDS          ds            = NULL;
5533   PetscDS          dsAux[3]      = {NULL, NULL, NULL};
5534   Vec              locA[3]       = {NULL, NULL, NULL};
5535   PetscSection     section       = NULL;
5536   PetscSection     sectionAux[3] = {NULL, NULL, NULL};
5537   DMField          coordField    = NULL;
5538   PetscScalar     *u = NULL, *u_t, *a[3];
5539   PetscScalar     *elemMat, *elemMatP;
5540   PetscSection     globalSection;
5541   IS               chunkIS;
5542   const PetscInt  *cells;
5543   PetscInt        *faces;
5544   PetscInt         cStart, cEnd, numCells;
5545   PetscInt         Nf, fieldI, fieldJ, totDim, totDimAux[3], numChunks, cellChunkSize, chunk;
5546   PetscInt         maxDegree = PETSC_MAX_INT;
5547   PetscQuadrature  affineQuad = NULL, *quads = NULL;
5548   PetscFEGeom     *affineGeom = NULL, **geoms = NULL;
5549   PetscBool        hasBdJac, hasBdPrec;
5550 
5551   PetscFunctionBegin;
5552   if ((key[0].label == key[1].label) && (key[0].value == key[1].value) && (key[0].part == key[1].part)) {
5553     const char *name;
5554     PetscCall(PetscObjectGetName((PetscObject) key[0].label, &name));
5555     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Form keys for each side of a cohesive surface must be different (%s, %D, %D)", name, key[0].value, key[0].part);
5556   }
5557   PetscCall(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5558   PetscCall(ISGetLocalSize(cellIS, &numCells));
5559   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5560   PetscCall(DMConvert(dm, DMPLEX, &plex));
5561   PetscCall(DMGetSection(dm, &section));
5562   PetscCall(DMGetGlobalSection(dm, &globalSection));
5563   PetscCall(DMGetLabel(dm, "ghost", &ghostLabel));
5564   PetscCall(DMGetCellDS(dm, cStart, &ds));
5565   PetscCall(PetscDSGetNumFields(ds, &Nf));
5566   PetscCall(PetscDSGetTotalDimension(ds, &totDim));
5567   PetscCall(PetscDSHasBdJacobian(ds, &hasBdJac));
5568   PetscCall(PetscDSHasBdJacobianPreconditioner(ds, &hasBdPrec));
5569   PetscCall(DMGetAuxiliaryVec(dm, key[2].label, key[2].value, key[2].part, &locA[2]));
5570   if (locA[2]) {
5571     PetscCall(VecGetDM(locA[2], &dmAux[2]));
5572     PetscCall(DMConvert(dmAux[2], DMPLEX, &plexA));
5573     PetscCall(DMGetSection(dmAux[2], &sectionAux[2]));
5574     PetscCall(DMGetCellDS(dmAux[2], cStart, &dsAux[2]));
5575     PetscCall(PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]));
5576     {
5577       const PetscInt *cone;
5578       PetscInt        c;
5579 
5580       PetscCall(DMPlexGetCone(dm, cStart, &cone));
5581       for (c = 0; c < 2; ++c) {
5582         const PetscInt *support;
5583         PetscInt ssize, s;
5584 
5585         PetscCall(DMPlexGetSupport(dm, cone[c], &support));
5586         PetscCall(DMPlexGetSupportSize(dm, cone[c], &ssize));
5587         PetscCheck(ssize == 2,PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D from cell %D has support size %D != 2", cone[c], cStart, ssize);
5588         if      (support[0] == cStart) s = 1;
5589         else if (support[1] == cStart) s = 0;
5590         else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart);
5591         PetscCall(DMGetAuxiliaryVec(dm, key[c].label, key[c].value, key[c].part, &locA[c]));
5592         if (locA[c]) PetscCall(VecGetDM(locA[c], &dmAux[c]));
5593         else         {dmAux[c] = dmAux[2];}
5594         PetscCall(DMGetCellDS(dmAux[c], support[s], &dsAux[c]));
5595         PetscCall(PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]));
5596       }
5597     }
5598   }
5599   PetscCall(DMGetCoordinateField(dm, &coordField));
5600   PetscCall(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
5601   if (maxDegree > 1) {
5602     PetscInt f;
5603     PetscCall(PetscCalloc2(Nf, &quads, Nf, &geoms));
5604     for (f = 0; f < Nf; ++f) {
5605       PetscFE fe;
5606 
5607       PetscCall(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5608       if (fe) {
5609         PetscCall(PetscFEGetQuadrature(fe, &quads[f]));
5610         PetscCall(PetscObjectReference((PetscObject) quads[f]));
5611       }
5612     }
5613   }
5614   cellChunkSize = numCells;
5615   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5616   PetscCall(PetscCalloc1(2*cellChunkSize, &faces));
5617   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS));
5618   PetscCall(DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5619   PetscCall(DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a));
5620   PetscCall(DMGetWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat));
5621   PetscCall(DMGetWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP));
5622   for (chunk = 0; chunk < numChunks; ++chunk) {
5623     PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
5624 
5625     if (hasBdJac)  PetscCall(PetscMemzero(elemMat,  numCells*totDim*totDim * sizeof(PetscScalar)));
5626     if (hasBdPrec) PetscCall(PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar)));
5627     /* Get faces */
5628     for (c = cS; c < cE; ++c) {
5629       const PetscInt  cell = cells ? cells[c] : c;
5630       const PetscInt *cone;
5631       PetscCall(DMPlexGetCone(plex, cell, &cone));
5632       faces[(c-cS)*2+0] = cone[0];
5633       faces[(c-cS)*2+1] = cone[1];
5634     }
5635     PetscCall(ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER));
5636     if (maxDegree <= 1) {
5637       if (!affineQuad) PetscCall(DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad));
5638       if (affineQuad)  PetscCall(DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom));
5639     } else {
5640       PetscInt f;
5641       for (f = 0; f < Nf; ++f) {
5642         if (quads[f]) PetscCall(DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]));
5643       }
5644     }
5645 
5646     for (fieldI = 0; fieldI < Nf; ++fieldI) {
5647       PetscFE         feI;
5648       PetscFEGeom    *geom = affineGeom ? affineGeom : geoms[fieldI];
5649       PetscFEGeom    *chunkGeom = NULL, *remGeom = NULL;
5650       PetscQuadrature quad = affineQuad ? affineQuad : quads[fieldI];
5651       PetscInt        numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
5652       PetscBool       isCohesiveField;
5653 
5654       PetscCall(PetscDSGetDiscretization(ds, fieldI, (PetscObject *) &feI));
5655       if (!feI) continue;
5656       PetscCall(PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches));
5657       PetscCall(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
5658       PetscCall(PetscFEGetDimension(feI, &Nb));
5659       blockSize = Nb;
5660       batchSize = numBlocks * blockSize;
5661       PetscCall(PetscFESetTileSizes(feI, blockSize, numBlocks, batchSize, numBatches));
5662       numChunks = numCells / (numBatches*batchSize);
5663       Ne        = numChunks*numBatches*batchSize;
5664       Nr        = numCells % (numBatches*batchSize);
5665       offset    = numCells - Nr;
5666       PetscCall(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
5667       PetscCall(PetscFEGeomGetChunk(geom,offset,numCells,&remGeom));
5668       PetscCall(PetscDSGetCohesive(ds, fieldI, &isCohesiveField));
5669       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5670         PetscFE feJ;
5671 
5672         PetscCall(PetscDSGetDiscretization(ds, fieldJ, (PetscObject *) &feJ));
5673         if (!feJ) continue;
5674         key[0].field = fieldI*Nf+fieldJ;
5675         key[1].field = fieldI*Nf+fieldJ;
5676         key[2].field = fieldI*Nf+fieldJ;
5677         if (hasBdJac) {
5678           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMat));
5679           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]));
5680           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMat));
5681           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]));
5682         }
5683         if (hasBdPrec) {
5684           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMatP));
5685           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]));
5686           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMatP));
5687           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]));
5688         }
5689         if (hasBdJac) {
5690           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMat));
5691           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]));
5692         }
5693         if (hasBdPrec) {
5694           PetscCall(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMatP));
5695           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]));
5696         }
5697       }
5698       PetscCall(PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom));
5699       PetscCall(PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom));
5700     }
5701     /* Insert values into matrix */
5702     for (c = cS; c < cE; ++c) {
5703       const PetscInt cell = cells ? cells[c] : c;
5704       const PetscInt cind = c - cS;
5705 
5706       if (hasBdPrec) {
5707         if (hasBdJac) {
5708           if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5709           PetscCall(DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5710         }
5711         if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]));
5712         PetscCall(DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES));
5713       } else if (hasBdJac) {
5714         if (mesh->printFEM > 1) PetscCall(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5715         PetscCall(DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5716       }
5717     }
5718   }
5719   PetscCall(DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5720   PetscCall(DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a));
5721   PetscCall(DMRestoreWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat));
5722   PetscCall(DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP));
5723   PetscCall(PetscFree(faces));
5724   PetscCall(ISDestroy(&chunkIS));
5725   PetscCall(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5726   if (maxDegree <= 1) {
5727     PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
5728     PetscCall(PetscQuadratureDestroy(&affineQuad));
5729   } else {
5730     PetscInt f;
5731     for (f = 0; f < Nf; ++f) {
5732       if (geoms) PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]));
5733       if (quads) PetscCall(PetscQuadratureDestroy(&quads[f]));
5734     }
5735     PetscCall(PetscFree2(quads,geoms));
5736   }
5737   if (dmAux[2]) PetscCall(DMDestroy(&plexA));
5738   PetscCall(DMDestroy(&plex));
5739   /* Assemble matrix */
5740   if (hasBdJac && hasBdPrec) {
5741     PetscCall(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));
5742     PetscCall(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));
5743   }
5744   PetscCall(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));
5745   PetscCall(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
5746   PetscCall(PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0));
5747   PetscFunctionReturn(0);
5748 }
5749 
5750 /*
5751   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.
5752 
5753   Input Parameters:
5754 + dm     - The mesh
5755 . key    - The PetscWeakFormKey indcating where integration should happen
5756 . cellIS - The cells to integrate over
5757 . t      - The time
5758 . X_tShift - The multiplier for the Jacobian with repsect to X_t
5759 . X      - Local solution vector
5760 . X_t    - Time-derivative of the local solution vector
5761 . Y      - Local input vector
5762 - user   - the user context
5763 
5764   Output Parameter:
5765 . Z - Local output vector
5766 
5767   Note:
5768   We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator,
5769   like a GPU, or vectorize on a multicore machine.
5770 */
5771 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)
5772 {
5773   DM_Plex        *mesh  = (DM_Plex *) dm->data;
5774   const char     *name  = "Jacobian";
5775   DM              dmAux = NULL, plex, plexAux = NULL;
5776   DMEnclosureType encAux;
5777   Vec             A;
5778   DMField         coordField;
5779   PetscDS         prob, probAux = NULL;
5780   PetscQuadrature quad;
5781   PetscSection    section, globalSection, sectionAux;
5782   PetscScalar    *elemMat, *elemMatD, *u, *u_t, *a = NULL, *y, *z;
5783   const PetscInt *cells;
5784   PetscInt        Nf, fieldI, fieldJ;
5785   PetscInt        totDim, totDimAux = 0, cStart, cEnd, numCells, c;
5786   PetscBool       hasDyn;
5787 
5788   PetscFunctionBegin;
5789   PetscCall(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5790   PetscCall(DMConvert(dm, DMPLEX, &plex));
5791   if (!cellIS) {
5792     PetscInt depth;
5793 
5794     PetscCall(DMPlexGetDepth(plex, &depth));
5795     PetscCall(DMGetStratumIS(plex, "dim", depth, &cellIS));
5796     if (!cellIS) PetscCall(DMGetStratumIS(plex, "depth", depth, &cellIS));
5797   } else {
5798     PetscCall(PetscObjectReference((PetscObject) cellIS));
5799   }
5800   PetscCall(ISGetLocalSize(cellIS, &numCells));
5801   PetscCall(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5802   PetscCall(DMGetLocalSection(dm, &section));
5803   PetscCall(DMGetGlobalSection(dm, &globalSection));
5804   PetscCall(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
5805   PetscCall(PetscDSGetNumFields(prob, &Nf));
5806   PetscCall(PetscDSGetTotalDimension(prob, &totDim));
5807   PetscCall(PetscDSHasDynamicJacobian(prob, &hasDyn));
5808   hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5809   PetscCall(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &A));
5810   if (A) {
5811     PetscCall(VecGetDM(A, &dmAux));
5812     PetscCall(DMGetEnclosureRelation(dmAux, dm, &encAux));
5813     PetscCall(DMConvert(dmAux, DMPLEX, &plexAux));
5814     PetscCall(DMGetLocalSection(plexAux, &sectionAux));
5815     PetscCall(DMGetDS(dmAux, &probAux));
5816     PetscCall(PetscDSGetTotalDimension(probAux, &totDimAux));
5817   }
5818   PetscCall(VecSet(Z, 0.0));
5819   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));
5820   if (dmAux) PetscCall(PetscMalloc1(numCells*totDimAux, &a));
5821   PetscCall(DMGetCoordinateField(dm, &coordField));
5822   for (c = cStart; c < cEnd; ++c) {
5823     const PetscInt cell = cells ? cells[c] : c;
5824     const PetscInt cind = c - cStart;
5825     PetscScalar   *x = NULL,  *x_t = NULL;
5826     PetscInt       i;
5827 
5828     PetscCall(DMPlexVecGetClosure(plex, section, X, cell, NULL, &x));
5829     for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5830     PetscCall(DMPlexVecRestoreClosure(plex, section, X, cell, NULL, &x));
5831     if (X_t) {
5832       PetscCall(DMPlexVecGetClosure(plex, section, X_t, cell, NULL, &x_t));
5833       for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i];
5834       PetscCall(DMPlexVecRestoreClosure(plex, section, X_t, cell, NULL, &x_t));
5835     }
5836     if (dmAux) {
5837       PetscInt subcell;
5838       PetscCall(DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell));
5839       PetscCall(DMPlexVecGetClosure(plexAux, sectionAux, A, subcell, NULL, &x));
5840       for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5841       PetscCall(DMPlexVecRestoreClosure(plexAux, sectionAux, A, subcell, NULL, &x));
5842     }
5843     PetscCall(DMPlexVecGetClosure(plex, section, Y, cell, NULL, &x));
5844     for (i = 0; i < totDim; ++i) y[cind*totDim+i] = x[i];
5845     PetscCall(DMPlexVecRestoreClosure(plex, section, Y, cell, NULL, &x));
5846   }
5847   PetscCall(PetscArrayzero(elemMat, numCells*totDim*totDim));
5848   if (hasDyn)  PetscCall(PetscArrayzero(elemMatD, numCells*totDim*totDim));
5849   for (fieldI = 0; fieldI < Nf; ++fieldI) {
5850     PetscFE  fe;
5851     PetscInt Nb;
5852     /* Conforming batches */
5853     PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5854     /* Remainder */
5855     PetscInt Nr, offset, Nq;
5856     PetscQuadrature qGeom = NULL;
5857     PetscInt    maxDegree;
5858     PetscFEGeom *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL;
5859 
5860     PetscCall(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5861     PetscCall(PetscFEGetQuadrature(fe, &quad));
5862     PetscCall(PetscFEGetDimension(fe, &Nb));
5863     PetscCall(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5864     PetscCall(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
5865     if (maxDegree <= 1) PetscCall(DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom));
5866     if (!qGeom) {
5867       PetscCall(PetscFEGetQuadrature(fe,&qGeom));
5868       PetscCall(PetscObjectReference((PetscObject)qGeom));
5869     }
5870     PetscCall(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5871     PetscCall(DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5872     blockSize = Nb;
5873     batchSize = numBlocks * blockSize;
5874     PetscCall(PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches));
5875     numChunks = numCells / (numBatches*batchSize);
5876     Ne        = numChunks*numBatches*batchSize;
5877     Nr        = numCells % (numBatches*batchSize);
5878     offset    = numCells - Nr;
5879     PetscCall(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
5880     PetscCall(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom));
5881     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5882       key.field = fieldI*Nf + fieldJ;
5883       PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5884       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]));
5885       if (hasDyn) {
5886         PetscCall(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD));
5887         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]));
5888       }
5889     }
5890     PetscCall(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom));
5891     PetscCall(PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom));
5892     PetscCall(DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5893     PetscCall(PetscQuadratureDestroy(&qGeom));
5894   }
5895   if (hasDyn) {
5896     for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];
5897   }
5898   for (c = cStart; c < cEnd; ++c) {
5899     const PetscInt     cell = cells ? cells[c] : c;
5900     const PetscInt     cind = c - cStart;
5901     const PetscBLASInt M = totDim, one = 1;
5902     const PetscScalar  a = 1.0, b = 0.0;
5903 
5904     PetscStackCallBLAS("BLASgemv", BLASgemv_("N", &M, &M, &a, &elemMat[cind*totDim*totDim], &M, &y[cind*totDim], &one, &b, z, &one));
5905     if (mesh->printFEM > 1) {
5906       PetscCall(DMPrintCellMatrix(c, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5907       PetscCall(DMPrintCellVector(c, "Y",  totDim, &y[cind*totDim]));
5908       PetscCall(DMPrintCellVector(c, "Z",  totDim, z));
5909     }
5910     PetscCall(DMPlexVecSetClosure(dm, section, Z, cell, z, ADD_VALUES));
5911   }
5912   PetscCall(PetscFree6(u,u_t,elemMat,elemMatD,y,z));
5913   if (mesh->printFEM) {
5914     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)Z), "Z:\n"));
5915     PetscCall(VecView(Z, NULL));
5916   }
5917   PetscCall(PetscFree(a));
5918   PetscCall(ISDestroy(&cellIS));
5919   PetscCall(DMDestroy(&plexAux));
5920   PetscCall(DMDestroy(&plex));
5921   PetscCall(PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0));
5922   PetscFunctionReturn(0);
5923 }
5924