xref: /petsc/src/dm/impls/plex/plexfem.c (revision 4722d44b6a5b01b43c4f156b4449c8da334227e2)
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   CHKERRQ(PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex));
25   if (isPlex) {
26     *plex = dm;
27     CHKERRQ(PetscObjectReference((PetscObject) dm));
28   } else {
29     CHKERRQ(PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex));
30     if (!*plex) {
31       CHKERRQ(DMConvert(dm, DMPLEX, plex));
32       CHKERRQ(PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex));
33       if (copy) {
34         DMSubDomainHookLink link;
35 
36         CHKERRQ(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) CHKERRQ((*link->ddhook)(dm, *plex, link->ctx));
40         }
41       }
42     } else {
43       CHKERRQ(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   CHKERRQ(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   CHKERRQ(PetscObjectGetId((PetscObject)quad,&id));
66   CHKERRQ(PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id));
67   CHKERRQ(PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container));
68   if (container) {
69     CHKERRQ(PetscContainerGetPointer(container, (void **) geom));
70   } else {
71     CHKERRQ(DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom));
72     CHKERRQ(PetscContainerCreate(PETSC_COMM_SELF,&container));
73     CHKERRQ(PetscContainerSetPointer(container, (void *) *geom));
74     CHKERRQ(PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom));
75     CHKERRQ(PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container));
76     CHKERRQ(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   CHKERRQ(PetscObjectGetComm((PetscObject) dm, &comm));
190   CHKERRQ(DMGetDimension(dm, &dim));
191   CHKERRQ(DMGetCoordinateDim(dm, &dimEmbed));
192   CHKERRQ(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     CHKERRQ(MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp));
196     PetscFunctionReturn(0);
197   }
198   CHKERRQ(DMGetLocalSection(dm, &section));
199   CHKERRQ(DMGetGlobalSection(dm, &globalSection));
200   CHKERRQ(PetscSectionGetConstrainedStorageSize(globalSection, &n));
201   CHKERRQ(PetscCalloc1(Nf, &func));
202   m    = (dim*(dim+1))/2;
203   CHKERRQ(VecCreate(comm, &mode[0]));
204   CHKERRQ(VecSetType(mode[0], dm->vectype));
205   CHKERRQ(VecSetSizes(mode[0], n, PETSC_DETERMINE));
206   CHKERRQ(VecSetUp(mode[0]));
207   CHKERRQ(VecGetSize(mode[0], &n));
208   mmin = PetscMin(m, n);
209   func[field] = DMPlexProjectRigidBody_Private;
210   for (i = 1; i < m; ++i) CHKERRQ(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     CHKERRQ(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     CHKERRQ(VecNormalize(mode[i], NULL));
224     CHKERRQ(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       CHKERRQ(VecAXPY(mode[j], dots[j], mode[i]));
228     }
229   }
230   CHKERRQ(MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp));
231   for (i = 0; i < m; ++i) CHKERRQ(VecDestroy(&mode[i]));
232   CHKERRQ(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   CHKERRQ(PetscObjectGetComm((PetscObject)dm,&comm));
267   CHKERRQ(DMGetDimension(dm, &dim));
268   CHKERRQ(DMGetCoordinateDim(dm, &dimEmbed));
269   CHKERRQ(DMGetLocalSection(dm, &section));
270   CHKERRQ(DMGetGlobalSection(dm, &globalSection));
271   CHKERRQ(PetscSectionGetConstrainedStorageSize(globalSection, &n));
272   m    = nb * (dim*(dim+1))/2;
273   CHKERRQ(PetscMalloc2(m, &mode, m, &dots));
274   CHKERRQ(VecCreate(comm, &mode[0]));
275   CHKERRQ(VecSetSizes(mode[0], n, PETSC_DETERMINE));
276   CHKERRQ(VecSetUp(mode[0]));
277   for (i = 1; i < m; ++i) CHKERRQ(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       CHKERRQ(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     CHKERRQ(VecNormalize(mode[i], NULL));
295     CHKERRQ(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       CHKERRQ(VecAXPY(mode[j], dots[j], mode[i]));
299     }
300   }
301   CHKERRQ(MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp));
302   for (i = 0; i< m; ++i) CHKERRQ(VecDestroy(&mode[i]));
303   CHKERRQ(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   CHKERRQ(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     CHKERRQ(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     CHKERRQ(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   CHKERRQ(PetscFree2(rc->R, rc->RT));
411   CHKERRQ(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       CHKERRQ(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       CHKERRQ(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   CHKERRQ(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   CHKERRQ((*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   CHKERRQ(DMGetLocalSection(tdm, &ts));
475   CHKERRQ(PetscSectionGetFieldDof(ts, p, f, &dof));
476   CHKERRQ(VecGetArrayRead(tv, &ta));
477   CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMGetLocalSection(dm, &s));
501   CHKERRQ(DMGetLocalSection(tdm, &ts));
502   CHKERRQ(PetscSectionGetFieldDof(s, pf, f, &fpdof));
503   CHKERRQ(PetscSectionGetFieldDof(s, pg, g, &gpdof));
504   CHKERRQ(PetscSectionGetFieldDof(ts, pf, f, &fdof));
505   CHKERRQ(PetscSectionGetFieldDof(ts, pg, g, &gdof));
506   CHKERRQ(VecGetArrayRead(tv, &ta));
507   CHKERRQ(DMPlexPointLocalFieldRead(tdm, pf, f, ta, &tvaf));
508   CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMGetLocalSection(dm, &s));
543   CHKERRQ(PetscSectionGetNumFields(s, &Nf));
544   CHKERRQ(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       CHKERRQ(PetscSectionGetFieldDof(s, points[cp], f, &dof));
548       if (!dof) continue;
549       if (fieldActive[f]) CHKERRQ(DMPlexBasisTransformField_Internal(dm, tdm, tv, points[cp], f, l2g, &a[d]));
550       d += dof;
551     }
552   }
553   CHKERRQ(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   CHKERRQ(DMGetLocalSection(dm, &s));
568   CHKERRQ(PetscSectionGetNumFields(s, &Nf));
569   CHKERRQ(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       CHKERRQ(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           CHKERRQ(PetscSectionGetFieldDof(s, points[cpg], g, &gdof));
576           CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
600   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
601   CHKERRQ(DMGetLocalSection(tdm, &ts));
602   CHKERRQ(DMGetLocalSection(dm, &s));
603   CHKERRQ(PetscSectionGetChart(s, &pStart, &pEnd));
604   CHKERRQ(PetscSectionGetNumFields(s, &Nf));
605   CHKERRQ(VecGetArray(lv, &a));
606   CHKERRQ(VecGetArrayRead(tv, &ta));
607   for (p = pStart; p < pEnd; ++p) {
608     for (f = 0; f < Nf; ++f) {
609       CHKERRQ(DMPlexPointLocalFieldRef(dm, p, f, a, &va));
610       CHKERRQ(DMPlexBasisTransformField_Internal(dm, tdm, tv, p, f, l2g, va));
611     }
612   }
613   CHKERRQ(VecRestoreArray(lv, &a));
614   CHKERRQ(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   CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMGetCoordinateDim(dm, &cdim));
695   CHKERRQ(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   CHKERRQ((*dm->transformSetUp)(dm, dm->transformCtx));
705   CHKERRQ(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   CHKERRQ(DMGetNumFields(dm, &numFields));
739   CHKERRQ(PetscCalloc2(numFields,&funcs,numFields,&ctxs));
740   funcs[field] = func;
741   ctxs[field]  = ctx;
742   CHKERRQ(DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX));
743   CHKERRQ(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   CHKERRQ(DMGetNumFields(dm, &numFields));
787   CHKERRQ(PetscCalloc2(numFields,&funcs,numFields,&ctxs));
788   funcs[field] = func;
789   ctxs[field]  = ctx;
790   CHKERRQ(DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX));
791   CHKERRQ(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   CHKERRQ(DMGetNumFields(dm, &numFields));
837   CHKERRQ(PetscCalloc2(numFields,&funcs,numFields,&ctxs));
838   funcs[field] = func;
839   ctxs[field]  = ctx;
840   CHKERRQ(DMProjectBdFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX));
841   CHKERRQ(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   CHKERRQ(DMGetPointSF(dm, &sf));
886   CHKERRQ(PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL));
887   nleaves = PetscMax(0, nleaves);
888   CHKERRQ(DMGetDimension(dm, &dim));
889   CHKERRQ(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
890   CHKERRQ(DMGetDS(dm, &prob));
891   CHKERRQ(VecGetDM(faceGeometry, &dmFace));
892   CHKERRQ(VecGetArrayRead(faceGeometry, &facegeom));
893   if (cellGeometry) {
894     CHKERRQ(VecGetDM(cellGeometry, &dmCell));
895     CHKERRQ(VecGetArrayRead(cellGeometry, &cellgeom));
896   }
897   if (Grad) {
898     PetscFV fv;
899 
900     CHKERRQ(PetscDSGetDiscretization(prob, field, (PetscObject *) &fv));
901     CHKERRQ(VecGetDM(Grad, &dmGrad));
902     CHKERRQ(VecGetArrayRead(Grad, &grad));
903     CHKERRQ(PetscFVGetNumComponents(fv, &pdim));
904     CHKERRQ(DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx));
905   }
906   CHKERRQ(VecGetArray(locX, &x));
907   for (i = 0; i < numids; ++i) {
908     IS              faceIS;
909     const PetscInt *faces;
910     PetscInt        numFaces, f;
911 
912     CHKERRQ(DMLabelGetStratumIS(label, ids[i], &faceIS));
913     if (!faceIS) continue; /* No points with that id on this process */
914     CHKERRQ(ISGetLocalSize(faceIS, &numFaces));
915     CHKERRQ(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       CHKERRQ(PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc));
922       if (loc >= 0) continue;
923       CHKERRQ(DMPlexPointLocalRead(dmFace, face, facegeom, &fg));
924       CHKERRQ(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         CHKERRQ(DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg));
933         CHKERRQ(DMPlexPointLocalRead(dm, cells[0], x, &cx));
934         CHKERRQ(DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad));
935         CHKERRQ(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         CHKERRQ((*func)(time, fg->centroid, fg->normal, fx, xG, ctx));
939       } else {
940         PetscScalar *xI;
941         PetscScalar *xG;
942 
943         CHKERRQ(DMPlexPointLocalRead(dm, cells[0], x, &xI));
944         CHKERRQ(DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG));
945         ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);
946         if (ierru) {
947           CHKERRQ(ISRestoreIndices(faceIS, &faces));
948           CHKERRQ(ISDestroy(&faceIS));
949           goto cleanup;
950         }
951       }
952     }
953     CHKERRQ(ISRestoreIndices(faceIS, &faces));
954     CHKERRQ(ISDestroy(&faceIS));
955   }
956   cleanup:
957   CHKERRQ(VecRestoreArray(locX, &x));
958   if (Grad) {
959     CHKERRQ(DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx));
960     CHKERRQ(VecRestoreArrayRead(Grad, &grad));
961   }
962   if (cellGeometry) CHKERRQ(VecRestoreArrayRead(cellGeometry, &cellgeom));
963   CHKERRQ(VecRestoreArrayRead(faceGeometry, &facegeom));
964   CHKERRQ(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   CHKERRQ(DMGetDS(dm, &prob));
983   CHKERRQ(PetscDSGetNumBoundary(prob, &numBd));
984   CHKERRQ(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     CHKERRQ(PetscDSGetBoundary(prob, b, &wf, &type, &name, &label, &numids, &ids, &field, &Nc, &comps, &bvfunc, NULL, &ctx));
1000     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1001     CHKERRQ(DMGetField(dm, field, NULL, &obj));
1002     CHKERRQ(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           CHKERRQ(DMPlexLabelAddCells(dm,label));
1012           CHKERRQ(DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, func, ctx, locX));
1013           CHKERRQ(DMPlexLabelClearCells(dm,label));
1014         }
1015         break;
1016       case DM_BC_ESSENTIAL_FIELD:
1017         {
1018           PetscPointFunc func = (PetscPointFunc) bvfunc;
1019 
1020           CHKERRQ(DMPlexLabelAddCells(dm,label));
1021           CHKERRQ(DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, func, ctx, locX));
1022           CHKERRQ(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         CHKERRQ(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   CHKERRQ(DMGetDS(dm, &prob));
1048   CHKERRQ(PetscDSGetNumBoundary(prob, &numBd));
1049   CHKERRQ(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     CHKERRQ(PetscDSGetBoundary(prob, b, &wf, &type, &name, &label, &numids, &ids, &field, &Nc, &comps, NULL, &bvfunc, &ctx));
1065     if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1066     CHKERRQ(DMGetField(dm, field, NULL, &obj));
1067     CHKERRQ(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           CHKERRQ(DMPlexLabelAddCells(dm,label));
1077           CHKERRQ(DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, func_t, ctx, locX));
1078           CHKERRQ(DMPlexLabelClearCells(dm,label));
1079         }
1080         break;
1081       case DM_BC_ESSENTIAL_FIELD:
1082         {
1083           PetscPointFunc func_t = (PetscPointFunc) bvfunc;
1084 
1085           CHKERRQ(DMPlexLabelAddCells(dm,label));
1086           CHKERRQ(DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, func_t, ctx, locX));
1087           CHKERRQ(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   CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMGetLocalVector(dm, &localX));
1165   CHKERRQ(DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL));
1166   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1167   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1168   CHKERRQ(DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff));
1169   CHKERRQ(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   CHKERRQ(DMGetDimension(dm, &dim));
1210   CHKERRQ(DMGetCoordinateDim(dm, &coordDim));
1211   fegeom.dimEmbed = coordDim;
1212   CHKERRQ(DMGetLocalSection(dm, &section));
1213   CHKERRQ(PetscSectionGetNumFields(section, &numFields));
1214   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
1215   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
1216   CHKERRQ(DMHasBasisTransform(dm, &transform));
1217   for (field = 0; field < numFields; ++field) {
1218     PetscObject  obj;
1219     PetscClassId id;
1220     PetscInt     Nc;
1221 
1222     CHKERRQ(DMGetField(dm, field, NULL, &obj));
1223     CHKERRQ(PetscObjectGetClassId(obj, &id));
1224     if (id == PETSCFE_CLASSID) {
1225       PetscFE fe = (PetscFE) obj;
1226 
1227       CHKERRQ(PetscFEGetQuadrature(fe, &quad));
1228       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
1229     } else if (id == PETSCFV_CLASSID) {
1230       PetscFV fv = (PetscFV) obj;
1231 
1232       CHKERRQ(PetscFVGetQuadrature(fv, &quad));
1233       CHKERRQ(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   CHKERRQ(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   CHKERRQ(PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ));
1240   CHKERRQ(DMPlexGetVTKCellHeight(dm, &cellHeight));
1241   CHKERRQ(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     CHKERRQ(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1248     CHKERRQ(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       CHKERRQ(DMGetField(dm, field, NULL, &obj));
1257       CHKERRQ(PetscObjectGetClassId(obj, &id));
1258       if (id == PETSCFE_CLASSID)      {CHKERRQ(PetscFEGetNumComponents((PetscFE) obj, &Nc));CHKERRQ(PetscFEGetDimension((PetscFE) obj, &Nb));}
1259       else if (id == PETSCFV_CLASSID) {CHKERRQ(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         CHKERRQ(PetscSNPrintf(title, 1023, "Solution for Field %D", field));
1264         CHKERRQ(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           CHKERRQ(DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx));
1277         } else {
1278           gcoords = &coords[coordDim*q];
1279         }
1280         CHKERRQ(PetscArrayzero(funcVal,Nc));
1281         ierr = (*funcs[field])(coordDim, time, gcoords, Nc, funcVal, ctx);
1282         if (ierr) {
1283           CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1284           CHKERRQ(DMRestoreLocalVector(dm, &localX));
1285           CHKERRQ(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1286           CHKERRQ(ierr);
1287         }
1288         if (transform) CHKERRQ(DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx));
1289         if (id == PETSCFE_CLASSID)      CHKERRQ(PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant));
1290         else if (id == PETSCFV_CLASSID) CHKERRQ(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) CHKERRQ(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     CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1302     if (debug) CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "  elem %" PetscInt_FMT " diff %g\n", c, (double)elemDiff));
1303     localDiff += elemDiff;
1304   }
1305   CHKERRQ(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1306   CHKERRMPI(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   CHKERRQ(DMGetDimension(dm, &dim));
1329   CHKERRQ(DMGetCoordinateDim(dm, &coordDim));
1330   fegeom.dimEmbed = coordDim;
1331   CHKERRQ(DMGetLocalSection(dm, &section));
1332   CHKERRQ(PetscSectionGetNumFields(section, &numFields));
1333   CHKERRQ(DMGetLocalVector(dm, &localX));
1334   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1335   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1336   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
1337   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
1338   CHKERRQ(DMHasBasisTransform(dm, &transform));
1339   for (field = 0; field < numFields; ++field) {
1340     PetscFE  fe;
1341     PetscInt Nc;
1342 
1343     CHKERRQ(DMGetField(dm, field, NULL, (PetscObject *) &fe));
1344     CHKERRQ(PetscFEGetQuadrature(fe, &quad));
1345     CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
1346     numComponents += Nc;
1347   }
1348   CHKERRQ(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   /* CHKERRQ(DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX)); */
1351   CHKERRQ(PetscMalloc6(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ,numComponents*coordDim,&interpolant,Nq,&fegeom.detJ));
1352   CHKERRQ(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     CHKERRQ(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1359     CHKERRQ(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       CHKERRQ(DMGetField(dm, field, NULL, (PetscObject *) &fe));
1367       CHKERRQ(PetscFEGetDimension(fe, &Nb));
1368       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
1369       if (debug) {
1370         char title[1024];
1371         CHKERRQ(PetscSNPrintf(title, 1023, "Solution for Field %" PetscInt_FMT, field));
1372         CHKERRQ(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           CHKERRQ(DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx));
1385         } else {
1386           gcoords = &coords[coordDim*q];
1387         }
1388         CHKERRQ(PetscArrayzero(funcVal,Nc));
1389         ierr = (*funcs[field])(coordDim, time, gcoords, n, Nc, funcVal, ctx);
1390         if (ierr) {
1391           CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1392           CHKERRQ(DMRestoreLocalVector(dm, &localX));
1393           CHKERRQ(PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ));
1394           CHKERRQ(ierr);
1395         }
1396         if (transform) CHKERRQ(DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx));
1397         CHKERRQ(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) CHKERRQ(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     CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1417     if (debug) CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "  elem %D diff %g\n", c, (double)elemDiff));
1418     localDiff += elemDiff;
1419   }
1420   CHKERRQ(PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ));
1421   CHKERRQ(DMRestoreLocalVector(dm, &localX));
1422   CHKERRMPI(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   CHKERRQ(DMGetDimension(dm, &dim));
1441   CHKERRQ(DMGetCoordinateDim(dm, &dE));
1442   CHKERRQ(DMGetLocalSection(dm, &section));
1443   CHKERRQ(DMGetLocalVector(dm, &localX));
1444   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
1445   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
1446   CHKERRQ(DMHasBasisTransform(dm, &transform));
1447   CHKERRQ(DMGetNumFields(dm, &Nf));
1448   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
1449   CHKERRQ(DMLabelGetNumValues(depthLabel, &depth));
1450 
1451   CHKERRQ(VecSet(localX, 0.0));
1452   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1453   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1454   CHKERRQ(DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX));
1455   CHKERRQ(DMGetNumDS(dm, &Nds));
1456   CHKERRQ(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     CHKERRQ(DMGetRegionNumDS(dm, s, &label, &fieldIS, &ds));
1471     CHKERRQ(ISGetIndices(fieldIS, &fields));
1472     CHKERRQ(PetscDSIsCohesive(ds, &isCohesive));
1473     CHKERRQ(PetscDSGetNumFields(ds, &dsNf));
1474     CHKERRQ(PetscDSGetTotalComponents(ds, &totNc));
1475     CHKERRQ(PetscDSGetQuadrature(ds, &quad));
1476     CHKERRQ(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     CHKERRQ(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       CHKERRQ(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1481     } else {
1482       CHKERRQ(DMLabelGetStratumIS(label, 1, &pointIS));
1483       CHKERRQ(ISGetLocalSize(pointIS, &cEnd));
1484       CHKERRQ(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       CHKERRQ(DMLabelGetValue(depthLabel, cell, &dep));
1493       if (dep != depth-1) continue;
1494       if (isCohesive) {
1495         CHKERRQ(DMPlexGetCone(dm, cell, &cone));
1496         CHKERRQ(DMPlexComputeCellGeometryFEM(dm, cone[0], quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1497       } else {
1498         CHKERRQ(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1499       }
1500       CHKERRQ(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         CHKERRQ(PetscDSGetCohesive(ds, f, &cohesive));
1510         if (isCohesive && !cohesive) continue;
1511         CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
1512         CHKERRQ(PetscObjectGetClassId(obj, &id));
1513         if (id == PETSCFE_CLASSID)      {CHKERRQ(PetscFEGetNumComponents((PetscFE) obj, &Nc));CHKERRQ(PetscFEGetDimension((PetscFE) obj, &Nb));}
1514         else if (id == PETSCFV_CLASSID) {CHKERRQ(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           CHKERRQ(PetscSNPrintf(title, 1023, "Solution for Field %D", fields[f]));
1519           CHKERRQ(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             CHKERRQ(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             CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x));
1539             CHKERRQ(DMRestoreLocalVector(dm, &localX));
1540             CHKERRQ(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1541             CHKERRQ(ierr);
1542           }
1543           if (transform) CHKERRQ(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)      CHKERRQ(PetscFEInterpolate_Static((PetscFE) obj, &x[fOff], &qgeom, q, interpolant));
1546           else if (id == PETSCFV_CLASSID) CHKERRQ(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) CHKERRQ(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) CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "  cell %D field %D cum diff %g\n", cell, fields[f], (double)localDiff[fields[f]]));
1558       }
1559       CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x));
1560     }
1561     if (label) {
1562       CHKERRQ(ISRestoreIndices(pointIS, &points));
1563       CHKERRQ(ISDestroy(&pointIS));
1564     }
1565     CHKERRQ(ISRestoreIndices(fieldIS, &fields));
1566     CHKERRQ(PetscFree6(funcVal, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ));
1567   }
1568   CHKERRQ(DMRestoreLocalVector(dm, &localX));
1569   CHKERRMPI(MPIU_Allreduce(localDiff, diff, Nf, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm)));
1570   CHKERRQ(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   CHKERRQ(VecSet(D, 0.0));
1607   CHKERRQ(DMGetDimension(dm, &dim));
1608   CHKERRQ(DMGetCoordinateDim(dm, &coordDim));
1609   CHKERRQ(DMGetLocalSection(dm, &section));
1610   CHKERRQ(PetscSectionGetNumFields(section, &numFields));
1611   CHKERRQ(DMGetLocalVector(dm, &localX));
1612   CHKERRQ(DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX));
1613   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX));
1614   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX));
1615   for (field = 0; field < numFields; ++field) {
1616     PetscObject  obj;
1617     PetscClassId id;
1618     PetscInt     Nc;
1619 
1620     CHKERRQ(DMGetField(dm, field, NULL, &obj));
1621     CHKERRQ(PetscObjectGetClassId(obj, &id));
1622     if (id == PETSCFE_CLASSID) {
1623       PetscFE fe = (PetscFE) obj;
1624 
1625       CHKERRQ(PetscFEGetQuadrature(fe, &quad));
1626       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
1627     } else if (id == PETSCFV_CLASSID) {
1628       PetscFV fv = (PetscFV) obj;
1629 
1630       CHKERRQ(PetscFVGetQuadrature(fv, &quad));
1631       CHKERRQ(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   CHKERRQ(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   CHKERRQ(PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ));
1638   CHKERRQ(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     CHKERRQ(DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1645     CHKERRQ(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       CHKERRQ(DMGetField(dm, field, NULL, &obj));
1654       CHKERRQ(PetscObjectGetClassId(obj, &id));
1655       if (id == PETSCFE_CLASSID)      {CHKERRQ(PetscFEGetNumComponents((PetscFE) obj, &Nc));CHKERRQ(PetscFEGetDimension((PetscFE) obj, &Nb));}
1656       else if (id == PETSCFV_CLASSID) {CHKERRQ(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           CHKERRQ((*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             CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1672             CHKERRQ(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1673             CHKERRQ(DMRestoreLocalVector(dm, &localX));
1674           }
1675 #endif
1676           if (id == PETSCFE_CLASSID)      CHKERRQ(PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant));
1677           else if (id == PETSCFV_CLASSID) CHKERRQ(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     CHKERRQ(DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x));
1689     CHKERRQ(VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES));
1690   }
1691   CHKERRQ(PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ));
1692   CHKERRQ(DMRestoreLocalVector(dm, &localX));
1693   CHKERRQ(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   CHKERRQ(PetscCitationsRegister(ClementCitation, &Clementcite));
1729   CHKERRQ(VecGetDM(locC, &dmc));
1730   CHKERRQ(VecSet(locC, 0.0));
1731   CHKERRQ(DMGetDimension(dm, &dim));
1732   CHKERRQ(DMGetCoordinateDim(dm, &cdim));
1733   fegeom.dimEmbed = cdim;
1734   CHKERRQ(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     CHKERRQ(DMGetField(dm, f, NULL, &obj));
1742     CHKERRQ(PetscObjectGetClassId(obj, &id));
1743     if (id == PETSCFE_CLASSID) {
1744       PetscFE fe = (PetscFE) obj;
1745 
1746       CHKERRQ(PetscFEGetQuadrature(fe, &quad));
1747       CHKERRQ(PetscFEGetNumComponents(fe, &fNc));
1748     } else if (id == PETSCFV_CLASSID) {
1749       PetscFV fv = (PetscFV) obj;
1750 
1751       CHKERRQ(PetscFVGetQuadrature(fv, &quad));
1752       CHKERRQ(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   CHKERRQ(PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights));
1757   PetscCheck(qNc == 1,PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D > 1", qNc);
1758   CHKERRQ(PetscMalloc6(Nc*2, &valsum, Nc, &interpolant, cdim*Nq, &coords, Nq, &fegeom.detJ, cdim*cdim*Nq, &fegeom.J, cdim*cdim*Nq, &fegeom.invJ));
1759   CHKERRQ(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1760   CHKERRQ(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     CHKERRQ(PetscArrayzero(valsum, Nc));
1767     CHKERRQ(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       CHKERRQ(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1777       CHKERRQ(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         CHKERRQ(PetscArrayzero(val, Nc));
1784         CHKERRQ(DMGetField(dm, f, NULL, &obj));
1785         CHKERRQ(PetscObjectGetClassId(obj, &id));
1786         if (id == PETSCFE_CLASSID)      {CHKERRQ(PetscFEGetNumComponents((PetscFE) obj, &fNc));CHKERRQ(PetscFEGetDimension((PetscFE) obj, &Nb));}
1787         else if (id == PETSCFV_CLASSID) {CHKERRQ(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) CHKERRQ(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       CHKERRQ(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         CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "Vertex %" PetscInt_FMT " Cell %" PetscInt_FMT " value: [", v, cell));
1810         for (fc = 0; fc < Nc; ++fc) {
1811           if (fc) CHKERRQ(PetscPrintf(PETSC_COMM_SELF, ", "));
1812           CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "%g", (double) PetscRealPart(val[fc])));
1813         }
1814         CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "]\n"));
1815       }
1816     }
1817     for (fc = 0; fc < Nc; ++fc) valsum[fc] /= volsum;
1818     CHKERRQ(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1819     CHKERRQ(DMPlexVecSetClosure(dmc, NULL, locC, v, valsum, INSERT_VALUES));
1820   }
1821   CHKERRQ(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   CHKERRQ(PetscCitationsRegister(ClementCitation, &Clementcite));
1858   CHKERRQ(VecGetDM(locC, &dmC));
1859   CHKERRQ(VecSet(locC, 0.0));
1860   CHKERRQ(DMGetDimension(dm, &dim));
1861   CHKERRQ(DMGetCoordinateDim(dm, &coordDim));
1862   fegeom.dimEmbed = coordDim;
1863   CHKERRQ(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     CHKERRQ(DMGetField(dm, field, NULL, &obj));
1871     CHKERRQ(PetscObjectGetClassId(obj, &id));
1872     if (id == PETSCFE_CLASSID) {
1873       PetscFE fe = (PetscFE) obj;
1874 
1875       CHKERRQ(PetscFEGetQuadrature(fe, &quad));
1876       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
1877     } else if (id == PETSCFV_CLASSID) {
1878       PetscFV fv = (PetscFV) obj;
1879 
1880       CHKERRQ(PetscFVGetQuadrature(fv, &quad));
1881       CHKERRQ(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   CHKERRQ(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   CHKERRQ(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   CHKERRQ(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1889   CHKERRQ(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     CHKERRQ(PetscArrayzero(gradsum, coordDim*numComponents));
1896     CHKERRQ(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       CHKERRQ(DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ));
1905       CHKERRQ(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         CHKERRQ(PetscArrayzero(grad, coordDim*numComponents));
1912         CHKERRQ(DMGetField(dm, field, NULL, &obj));
1913         CHKERRQ(PetscObjectGetClassId(obj, &id));
1914         if (id == PETSCFE_CLASSID)      {CHKERRQ(PetscFEGetNumComponents((PetscFE) obj, &Nc));CHKERRQ(PetscFEGetDimension((PetscFE) obj, &Nb));}
1915         else if (id == PETSCFV_CLASSID) {CHKERRQ(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)      CHKERRQ(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       CHKERRQ(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         CHKERRQ(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) CHKERRQ(PetscPrintf(PETSC_COMM_SELF, ", "));
1949             CHKERRQ(PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d])));
1950           }
1951         }
1952         CHKERRQ(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     CHKERRQ(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1959     CHKERRQ(DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES));
1960   }
1961   CHKERRQ(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   CHKERRQ(DMGetDS(dm, &prob));
1991   CHKERRQ(DMGetDimension(dm, &dim));
1992   CHKERRQ(DMGetLocalSection(dm, &section));
1993   CHKERRQ(DMGetNumFields(dm, &Nf));
1994   /* Determine which discretizations we have */
1995   for (f = 0; f < Nf; ++f) {
1996     PetscObject  obj;
1997     PetscClassId id;
1998 
1999     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
2000     CHKERRQ(PetscObjectGetClassId(obj, &id));
2001     if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
2002   }
2003   /* Get local solution with boundary values */
2004   CHKERRQ(DMGetLocalVector(dm, &locX));
2005   CHKERRQ(DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL));
2006   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX));
2007   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX));
2008   /* Read DS information */
2009   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
2010   CHKERRQ(PetscDSGetComponentOffsets(prob, &uOff));
2011   CHKERRQ(PetscDSGetComponentDerivativeOffsets(prob, &uOff_x));
2012   CHKERRQ(ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS));
2013   CHKERRQ(PetscDSGetConstants(prob, &numConstants, &constants));
2014   /* Read Auxiliary DS information */
2015   CHKERRQ(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
2016   if (locA) {
2017     CHKERRQ(VecGetDM(locA, &dmAux));
2018     CHKERRQ(DMGetDS(dmAux, &probAux));
2019     CHKERRQ(PetscDSGetNumFields(probAux, &NfAux));
2020     CHKERRQ(DMGetLocalSection(dmAux, &sectionAux));
2021     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
2022     CHKERRQ(PetscDSGetComponentOffsets(probAux, &aOff));
2023   }
2024   /* Allocate data  arrays */
2025   CHKERRQ(PetscCalloc1(numCells*totDim, &u));
2026   if (dmAux) CHKERRQ(PetscMalloc1(numCells*totDimAux, &a));
2027   /* Read out geometry */
2028   CHKERRQ(DMGetCoordinateField(dm,&coordField));
2029   CHKERRQ(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
2030   if (maxDegree <= 1) {
2031     CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
2032     if (affineQuad) {
2033       CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
2047       CHKERRQ(PetscObjectGetClassId(obj, &id));
2048       if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
2049     }
2050     CHKERRQ(PetscFVGetComputeGradients(fv, &compGrad));
2051     CHKERRQ(PetscFVSetComputeGradients(fv, PETSC_TRUE));
2052     CHKERRQ(DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM));
2053     CHKERRQ(DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad));
2054     CHKERRQ(PetscFVSetComputeGradients(fv, compGrad));
2055     CHKERRQ(VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
2056     /* Reconstruct and limit cell gradients */
2057     CHKERRQ(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
2058     CHKERRQ(DMGetGlobalVector(dmGrad, &grad));
2059     CHKERRQ(DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad));
2060     /* Communicate gradient values */
2061     CHKERRQ(DMGetLocalVector(dmGrad, &locGrad));
2062     CHKERRQ(DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad));
2063     CHKERRQ(DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad));
2064     CHKERRQ(DMRestoreGlobalVector(dmGrad, &grad));
2065     /* Handle non-essential (e.g. outflow) boundary values */
2066     CHKERRQ(DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad));
2067     CHKERRQ(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     CHKERRQ(DMPlexVecGetClosure(dm, section, locX, c, NULL, &x));
2075     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
2076     CHKERRQ(DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x));
2077     if (dmAux) {
2078       CHKERRQ(DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x));
2079       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
2080       CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
2090     CHKERRQ(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       CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
2098       CHKERRQ(PetscFEGetQuadrature(fe, &q));
2099       CHKERRQ(PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL));
2100       CHKERRQ(PetscFEGetDimension(fe, &Nb));
2101       blockSize = Nb*Nq;
2102       batchSize = numBlocks * blockSize;
2103       CHKERRQ(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         CHKERRQ(DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM));
2110       }
2111       CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
2112       CHKERRQ(PetscFEIntegrate(prob, f, Ne, chunkGeom, u, probAux, a, cintegral));
2113       CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom));
2114       CHKERRQ(PetscFEIntegrate(prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]));
2115       CHKERRQ(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom));
2116       if (!affineQuad) {
2117         CHKERRQ(PetscFEGeomDestroy(&cgeomFEM));
2118       }
2119     } else if (id == PETSCFV_CLASSID) {
2120       PetscInt       foff;
2121       PetscPointFunc obj_func;
2122       PetscScalar    lint;
2123 
2124       CHKERRQ(PetscDSGetObjective(prob, f, &obj_func));
2125       CHKERRQ(PetscDSGetFieldOffset(prob, f, &foff));
2126       if (obj_func) {
2127         for (c = 0; c < numCells; ++c) {
2128           PetscScalar *u_x;
2129 
2130           CHKERRQ(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     CHKERRQ(VecRestoreArrayRead(locGrad, &lgrad));
2140     CHKERRQ(VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
2141     CHKERRQ(DMRestoreLocalVector(dmGrad, &locGrad));
2142     CHKERRQ(VecDestroy(&faceGeometryFVM));
2143     CHKERRQ(VecDestroy(&cellGeometryFVM));
2144     CHKERRQ(DMDestroy(&dmGrad));
2145   }
2146   if (dmAux) CHKERRQ(PetscFree(a));
2147   CHKERRQ(PetscFree(u));
2148   /* Cleanup */
2149   if (affineQuad) {
2150     CHKERRQ(PetscFEGeomDestroy(&cgeomFEM));
2151   }
2152   CHKERRQ(PetscQuadratureDestroy(&affineQuad));
2153   CHKERRQ(ISDestroy(&cellIS));
2154   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2184   CHKERRQ(DMGetNumFields(dm, &Nf));
2185   CHKERRQ(DMPlexGetVTKCellHeight(dm, &cellHeight));
2186   CHKERRQ(DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd));
2187   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2188   CHKERRQ(PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral));
2189   CHKERRQ(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) CHKERRQ(DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]));
2195     for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
2196   }
2197   CHKERRMPI(MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm)));
2198   if (mesh->printFEM) {
2199     CHKERRQ(PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:"));
2200     for (f = 0; f < Nf; ++f) CHKERRQ(PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f])));
2201     CHKERRQ(PetscPrintf(PetscObjectComm((PetscObject) dm), "\n"));
2202   }
2203   CHKERRQ(PetscFree2(lintegral, cintegral));
2204   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2236   CHKERRQ(DMGetNumFields(dm, &Nf));
2237   CHKERRQ(DMPlexGetVTKCellHeight(dm, &cellHeight));
2238   CHKERRQ(DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd));
2239   /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2240   CHKERRQ(PetscCalloc1((cEnd-cStart)*Nf, &cintegral));
2241   CHKERRQ(DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user));
2242   /* Put values in F*/
2243   CHKERRQ(VecGetDM(F, &dmF));
2244   CHKERRQ(DMGetLocalSection(dmF, &sectionF));
2245   CHKERRQ(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) CHKERRQ(DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]));
2251     CHKERRQ(PetscSectionGetDof(sectionF, cell, &dof));
2252     CHKERRQ(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   CHKERRQ(VecRestoreArray(F, &af));
2257   CHKERRQ(PetscFree(cintegral));
2258   CHKERRQ(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   CHKERRQ(DMGetCoordinateField(dm, &coordField));
2283   CHKERRQ(DMConvert(dm, DMPLEX, &plex));
2284   CHKERRQ(DMGetDS(dm, &prob));
2285   CHKERRQ(DMGetLocalSection(dm, &section));
2286   CHKERRQ(PetscSectionGetNumFields(section, &Nf));
2287   /* Determine which discretizations we have */
2288   for (f = 0; f < Nf; ++f) {
2289     PetscObject  obj;
2290     PetscClassId id;
2291 
2292     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
2293     CHKERRQ(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   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
2298   CHKERRQ(PetscDSGetComponentOffsets(prob, &uOff));
2299   CHKERRQ(PetscDSGetComponentDerivativeOffsets(prob, &uOff_x));
2300   CHKERRQ(PetscDSGetConstants(prob, &numConstants, &constants));
2301   /* Read Auxiliary DS information */
2302   CHKERRQ(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
2303   if (locA) {
2304     DM dmAux;
2305 
2306     CHKERRQ(VecGetDM(locA, &dmAux));
2307     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
2308     CHKERRQ(DMConvert(dmAux, DMPLEX, &plexA));
2309     CHKERRQ(DMGetDS(dmAux, &probAux));
2310     CHKERRQ(PetscDSGetNumFields(probAux, &NfAux));
2311     CHKERRQ(DMGetLocalSection(dmAux, &sectionAux));
2312     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
2313     CHKERRQ(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     CHKERRQ(ISGetLocalSize(pointIS, &numFaces));
2325     CHKERRQ(ISGetIndices(pointIS, &points));
2326     CHKERRQ(PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a));
2327     CHKERRQ(DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree));
2328     for (field = 0; field < Nf; ++field) {
2329       PetscFE fe;
2330 
2331       CHKERRQ(PetscDSGetDiscretization(prob, field, (PetscObject *) &fe));
2332       if (maxDegree <= 1) CHKERRQ(DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom));
2333       if (!qGeom) {
2334         CHKERRQ(PetscFEGetFaceQuadrature(fe, &qGeom));
2335         CHKERRQ(PetscObjectReference((PetscObject) qGeom));
2336       }
2337       CHKERRQ(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
2338       CHKERRQ(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         CHKERRQ(DMPlexGetSupport(dm, point, &support));
2345         CHKERRQ(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
2346         for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
2347         CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
2348         if (locA) {
2349           PetscInt subp;
2350           CHKERRQ(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
2351           CHKERRQ(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
2352           for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
2353           CHKERRQ(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         CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
2363         CHKERRQ(PetscFEGetQuadrature(fe, &q));
2364         CHKERRQ(PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL));
2365         CHKERRQ(PetscFEGetDimension(fe, &Nb));
2366         blockSize = Nb*Nq;
2367         batchSize = numBlocks * blockSize;
2368         chunkSize = numBatches*batchSize;
2369         CHKERRQ(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         CHKERRQ(PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom));
2377         CHKERRQ(PetscFEIntegrateBd(prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral));
2378         CHKERRQ(PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom));
2379       }
2380       CHKERRQ(PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom));
2381       CHKERRQ(PetscFEIntegrateBd(prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]));
2382       CHKERRQ(PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom));
2383       /* Cleanup data arrays */
2384       CHKERRQ(DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom));
2385       CHKERRQ(PetscQuadratureDestroy(&qGeom));
2386       CHKERRQ(PetscFree2(u, a));
2387       CHKERRQ(ISRestoreIndices(pointIS, &points));
2388     }
2389   }
2390   if (plex)  CHKERRQ(DMDestroy(&plex));
2391   if (plexA) CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0));
2434   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
2435   CHKERRQ(DMGetDimension(dm, &dim));
2436   CHKERRQ(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
2437   CHKERRQ(DMGetLocalSection(dm, &section));
2438   CHKERRQ(PetscSectionGetNumFields(section, &Nf));
2439   /* Get local solution with boundary values */
2440   CHKERRQ(DMGetLocalVector(dm, &locX));
2441   CHKERRQ(DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL));
2442   CHKERRQ(DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX));
2443   CHKERRQ(DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX));
2444   /* Loop over label values */
2445   CHKERRQ(PetscArrayzero(integral, Nf));
2446   for (v = 0; v < numVals; ++v) {
2447     IS           pointIS;
2448     PetscInt     numFaces, face;
2449     PetscScalar *fintegral;
2450 
2451     CHKERRQ(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       CHKERRQ(ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS));
2458       CHKERRQ(ISDestroy(&pointIS));
2459       pointIS = isectIS;
2460     }
2461     CHKERRQ(ISGetLocalSize(pointIS, &numFaces));
2462     CHKERRQ(PetscCalloc1(numFaces*Nf, &fintegral));
2463     CHKERRQ(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     CHKERRQ(PetscFree(fintegral));
2467     CHKERRQ(ISDestroy(&pointIS));
2468   }
2469   CHKERRQ(DMRestoreLocalVector(dm, &locX));
2470   CHKERRQ(ISDestroy(&facetIS));
2471   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2505   CHKERRQ(DMGetDimension(dmf, &dim));
2506   CHKERRQ(DMGetLocalSection(dmf, &fsection));
2507   CHKERRQ(DMGetGlobalSection(dmf, &fglobalSection));
2508   CHKERRQ(DMGetLocalSection(dmc, &csection));
2509   CHKERRQ(DMGetGlobalSection(dmc, &cglobalSection));
2510   CHKERRQ(PetscSectionGetNumFields(fsection, &Nf));
2511   CHKERRQ(DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd));
2512   CHKERRQ(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     CHKERRQ(DMGetField(dmf, f, NULL, &obj));
2519     CHKERRQ(PetscObjectGetClassId(obj, &id));
2520     if (id == PETSCFE_CLASSID) {
2521       PetscFE fe = (PetscFE) obj;
2522 
2523       if (isRefined) {
2524         CHKERRQ(PetscFERefine(fe, &feRef[f]));
2525       } else {
2526         CHKERRQ(PetscObjectReference((PetscObject) fe));
2527         feRef[f] = fe;
2528       }
2529       CHKERRQ(PetscFEGetDimension(feRef[f], &rNb));
2530       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
2531     } else if (id == PETSCFV_CLASSID) {
2532       PetscFV        fv = (PetscFV) obj;
2533       PetscDualSpace Q;
2534 
2535       if (isRefined) {
2536         CHKERRQ(PetscFVRefine(fv, &fvRef[f]));
2537       } else {
2538         CHKERRQ(PetscObjectReference((PetscObject) fv));
2539         fvRef[f] = fv;
2540       }
2541       CHKERRQ(PetscFVGetDualSpace(fvRef[f], &Q));
2542       CHKERRQ(PetscDualSpaceGetDimension(Q, &rNb));
2543       CHKERRQ(PetscFVGetDualSpace(fv, &Q));
2544       CHKERRQ(PetscFVGetNumComponents(fv, &Nc));
2545     }
2546     CHKERRQ(DMGetField(dmc, f, NULL, &objc));
2547     CHKERRQ(PetscObjectGetClassId(objc, &idc));
2548     if (idc == PETSCFE_CLASSID) {
2549       PetscFE fe = (PetscFE) objc;
2550 
2551       CHKERRQ(PetscFEGetDimension(fe, &cNb));
2552     } else if (id == PETSCFV_CLASSID) {
2553       PetscFV        fv = (PetscFV) obj;
2554       PetscDualSpace Q;
2555 
2556       CHKERRQ(PetscFVGetDualSpace(fv, &Q));
2557       CHKERRQ(PetscDualSpaceGetDimension(Q, &cNb));
2558     }
2559     rTotDim += rNb;
2560     cTotDim += cNb;
2561   }
2562   CHKERRQ(PetscMalloc1(rTotDim*cTotDim,&elemMat));
2563   CHKERRQ(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       CHKERRQ(PetscFEGetDualSpace(feRef[fieldI], &Qref));
2574       CHKERRQ(PetscFEGetNumComponents(feRef[fieldI], &Nc));
2575     } else {
2576       CHKERRQ(PetscFVGetDualSpace(fvRef[fieldI], &Qref));
2577       CHKERRQ(PetscFVGetNumComponents(fvRef[fieldI], &Nc));
2578     }
2579     CHKERRQ(PetscDualSpaceGetDimension(Qref, &fpdim));
2580     for (i = 0; i < fpdim; ++i) {
2581       CHKERRQ(PetscDualSpaceGetFunctional(Qref, i, &f));
2582       CHKERRQ(PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL));
2583       npoints += Np;
2584     }
2585     CHKERRQ(PetscMalloc1(npoints*dim,&points));
2586     for (i = 0, k = 0; i < fpdim; ++i) {
2587       CHKERRQ(PetscDualSpaceGetFunctional(Qref, i, &f));
2588       CHKERRQ(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       CHKERRQ(DMGetField(dmc, fieldJ, NULL, &obj));
2598       CHKERRQ(PetscObjectGetClassId(obj, &id));
2599       if (id == PETSCFE_CLASSID) {
2600         PetscFE           fe = (PetscFE) obj;
2601         PetscTabulation T  = NULL;
2602 
2603         /* Evaluate basis at points */
2604         CHKERRQ(PetscFEGetNumComponents(fe, &NcJ));
2605         CHKERRQ(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           CHKERRQ(PetscFECreateTabulation(fe, 1, npoints, points, 0, &T));
2610           for (i = 0, k = 0; i < fpdim; ++i) {
2611             CHKERRQ(PetscDualSpaceGetFunctional(Qref, i, &f));
2612             CHKERRQ(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           CHKERRQ(PetscTabulationDestroy(&T));
2629         }
2630       } else if (id == PETSCFV_CLASSID) {
2631         PetscFV        fv = (PetscFV) obj;
2632 
2633         /* Evaluate constant function at points */
2634         CHKERRQ(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             CHKERRQ(PetscDualSpaceGetFunctional(Qref, i, &f));
2641             CHKERRQ(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     CHKERRQ(PetscFree(points));
2655   }
2656   if (mesh->printFEM > 1) CHKERRQ(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     CHKERRQ(MatGetLocalSize(In, &locRows, &locCols));
2665     CHKERRQ(MatCreate(PetscObjectComm((PetscObject) In), &preallocator));
2666     CHKERRQ(MatSetType(preallocator, MATPREALLOCATOR));
2667     CHKERRQ(MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE));
2668     CHKERRQ(MatSetUp(preallocator));
2669     CHKERRQ(PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices));
2670     for (cell = cStart; cell < cEnd; ++cell) {
2671       if (isRefined) {
2672         CHKERRQ(DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices));
2673         CHKERRQ(MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES));
2674       } else {
2675         CHKERRQ(DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, preallocator, cell, vals, INSERT_VALUES));
2676       }
2677     }
2678     CHKERRQ(PetscFree3(vals,cellCIndices,cellFIndices));
2679     CHKERRQ(MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY));
2680     CHKERRQ(MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY));
2681     CHKERRQ(MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In));
2682     CHKERRQ(MatDestroy(&preallocator));
2683   }
2684   /* Fill matrix */
2685   CHKERRQ(MatZeroEntries(In));
2686   for (c = cStart; c < cEnd; ++c) {
2687     if (isRefined) {
2688       CHKERRQ(DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES));
2689     } else {
2690       CHKERRQ(DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES));
2691     }
2692   }
2693   for (f = 0; f < Nf; ++f) CHKERRQ(PetscFEDestroy(&feRef[f]));
2694   CHKERRQ(PetscFree2(feRef,fvRef));
2695   CHKERRQ(PetscFree(elemMat));
2696   CHKERRQ(MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY));
2697   CHKERRQ(MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY));
2698   if (mesh->printFEM > 1) {
2699     CHKERRQ(PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name));
2700     CHKERRQ(MatChop(In, 1.0e-10));
2701     CHKERRQ(MatView(In, NULL));
2702   }
2703   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0));
2744   CHKERRQ(DMGetCoordinateDim(dmc, &dim));
2745   CHKERRQ(DMGetDS(dmc, &prob));
2746   CHKERRQ(PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL));
2747   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
2748   CHKERRQ(PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ));
2749   CHKERRQ(PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc));
2750   CHKERRQ(DMGetLocalSection(dmf, &fsection));
2751   CHKERRQ(DMGetGlobalSection(dmf, &globalFSection));
2752   CHKERRQ(DMGetLocalSection(dmc, &csection));
2753   CHKERRQ(DMGetGlobalSection(dmc, &globalCSection));
2754   CHKERRQ(DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd));
2755   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
2756   CHKERRQ(PetscMalloc1(totDim, &elemMat));
2757 
2758   CHKERRQ(MatGetLocalSize(In, &locRows, NULL));
2759   CHKERRQ(PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout));
2760   CHKERRQ(PetscLayoutSetLocalSize(rLayout, locRows));
2761   CHKERRQ(PetscLayoutSetBlockSize(rLayout, 1));
2762   CHKERRQ(PetscLayoutSetUp(rLayout));
2763   CHKERRQ(PetscLayoutGetRange(rLayout, &rStart, &rEnd));
2764   CHKERRQ(PetscLayoutDestroy(&rLayout));
2765   CHKERRQ(PetscCalloc2(locRows,&dnz,locRows,&onz));
2766   CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, field, &obj));
2776     CHKERRQ(PetscObjectGetClassId(obj, &id));
2777     if (id == PETSCFE_CLASSID) {
2778       PetscFE fe = (PetscFE) obj;
2779 
2780       CHKERRQ(PetscFEGetDualSpace(fe, &Q));
2781       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
2782     } else if (id == PETSCFV_CLASSID) {
2783       PetscFV fv = (PetscFV) obj;
2784 
2785       CHKERRQ(PetscFVGetDualSpace(fv, &Q));
2786       Nc   = 1;
2787     }
2788     CHKERRQ(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       CHKERRQ(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2795       CHKERRQ(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         CHKERRQ(PetscDualSpaceGetFunctional(Q, i, &f));
2806         CHKERRQ(PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL));
2807         CHKERRQ(VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec));
2808         CHKERRQ(VecSetBlockSize(pointVec, dim));
2809         CHKERRQ(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         CHKERRQ(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         CHKERRQ(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
2821         CHKERRQ(PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view"));
2822         /* Update preallocation info */
2823         CHKERRQ(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               CHKERRQ(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                 CHKERRQ(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               CHKERRQ(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2844             }
2845           }
2846         }
2847         CHKERRQ(PetscSFDestroy(&coarseCellSF));
2848         CHKERRQ(VecDestroy(&pointVec));
2849       }
2850       CHKERRQ(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2851     }
2852   }
2853   CHKERRQ(PetscHSetIJDestroy(&ht));
2854   CHKERRQ(MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL));
2855   CHKERRQ(MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
2856   CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, field, &obj));
2867     CHKERRQ(PetscObjectGetClassId(obj, &id));
2868     if (id == PETSCFE_CLASSID) {
2869       PetscFE fe = (PetscFE) obj;
2870 
2871       CHKERRQ(PetscFEGetDualSpace(fe, &Q));
2872       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
2873       CHKERRQ(PetscFECreateTabulation(fe, 1, 1, x, 0, &T));
2874     } else if (id == PETSCFV_CLASSID) {
2875       PetscFV fv = (PetscFV) obj;
2876 
2877       CHKERRQ(PetscFVGetDualSpace(fv, &Q));
2878       Nc   = 1;
2879     } else SETERRQ(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %D",field);
2880     CHKERRQ(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       CHKERRQ(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2887       CHKERRQ(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         CHKERRQ(PetscDualSpaceGetFunctional(Q, i, &f));
2898         CHKERRQ(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         CHKERRQ(VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec));
2901         CHKERRQ(VecSetBlockSize(pointVec, dim));
2902         CHKERRQ(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         CHKERRQ(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         CHKERRQ(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
2914         /* Update preallocation info */
2915         CHKERRQ(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
2916         PetscCheck(numCoarseCells == Np,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2917         CHKERRQ(VecGetArray(pointVec, &pV));
2918         for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2919           PetscReal pVReal[3];
2920           const PetscReal xi0[3] = {-1., -1., -1.};
2921 
2922           CHKERRQ(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2923           /* Transform points from real space to coarse reference space */
2924           CHKERRQ(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             CHKERRQ(PetscFEGetDimension(fe, &cpdim));
2933             CHKERRQ(PetscFEComputeTabulation(fe, 1, x, 0, T));
2934             CHKERRQ(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) CHKERRQ(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           CHKERRQ(MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES));
2949           CHKERRQ(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
2950         }
2951         CHKERRQ(VecRestoreArray(pointVec, &pV));
2952         CHKERRQ(PetscSFDestroy(&coarseCellSF));
2953         CHKERRQ(VecDestroy(&pointVec));
2954       }
2955       CHKERRQ(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
2956     }
2957     if (id == PETSCFE_CLASSID) CHKERRQ(PetscTabulationDestroy(&T));
2958   }
2959   CHKERRQ(PetscFree3(v0,J,invJ));
2960   CHKERRQ(PetscFree3(v0c,Jc,invJc));
2961   CHKERRQ(PetscFree(elemMat));
2962   CHKERRQ(MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY));
2963   CHKERRQ(MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY));
2964   CHKERRQ(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   CHKERRQ(DMGetCoordinateDim(dmc, &dim));
3000   CHKERRQ(DMGetDS(dmc, &prob));
3001   CHKERRQ(PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL));
3002   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
3003   CHKERRQ(PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ));
3004   CHKERRQ(PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc));
3005   CHKERRQ(DMGetLocalSection(dmf, &fsection));
3006   CHKERRQ(DMGetGlobalSection(dmf, &globalFSection));
3007   CHKERRQ(DMGetLocalSection(dmc, &csection));
3008   CHKERRQ(DMGetGlobalSection(dmc, &globalCSection));
3009   CHKERRQ(DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd));
3010   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
3011   CHKERRQ(PetscMalloc1(totDim, &elemMat));
3012 
3013   CHKERRQ(MatGetLocalSize(mass, &locRows, NULL));
3014   CHKERRQ(PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout));
3015   CHKERRQ(PetscLayoutSetLocalSize(rLayout, locRows));
3016   CHKERRQ(PetscLayoutSetBlockSize(rLayout, 1));
3017   CHKERRQ(PetscLayoutSetUp(rLayout));
3018   CHKERRQ(PetscLayoutGetRange(rLayout, &rStart, &rEnd));
3019   CHKERRQ(PetscLayoutDestroy(&rLayout));
3020   CHKERRQ(PetscCalloc2(locRows,&dnz,locRows,&onz));
3021   CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, field, &obj));
3030     CHKERRQ(PetscObjectGetClassId(obj, &id));
3031     if (id == PETSCFE_CLASSID) CHKERRQ(PetscFEGetQuadrature((PetscFE) obj, &quad));
3032     else                       CHKERRQ(PetscFVGetQuadrature((PetscFV) obj, &quad));
3033     CHKERRQ(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       CHKERRQ(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3045       CHKERRQ(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
3046       /* Get points from the quadrature */
3047       CHKERRQ(VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec));
3048       CHKERRQ(VecSetBlockSize(pointVec, dim));
3049       CHKERRQ(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       CHKERRQ(VecRestoreArray(pointVec, &pV));
3058       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3059       CHKERRQ(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
3060       CHKERRQ(PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view"));
3061       /* Update preallocation info */
3062       CHKERRQ(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               CHKERRQ(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                 CHKERRQ(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               CHKERRQ(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3084             }
3085           }
3086         }
3087       }
3088       CHKERRQ(PetscSFDestroy(&coarseCellSF));
3089       CHKERRQ(VecDestroy(&pointVec));
3090       CHKERRQ(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3091     }
3092   }
3093   CHKERRQ(PetscHSetIJDestroy(&ht));
3094   CHKERRQ(MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL));
3095   CHKERRQ(MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
3096   CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, field, &obj));
3106     CHKERRQ(PetscObjectGetClassId(obj, &id));
3107     if (id == PETSCFE_CLASSID) {
3108       CHKERRQ(PetscFEGetQuadrature((PetscFE) obj, &quad));
3109       CHKERRQ(PetscFEGetCellTabulation((PetscFE) obj, 1, &Tfine));
3110       CHKERRQ(PetscFECreateTabulation((PetscFE) obj, 1, 1, x, 0, &T));
3111     } else {
3112       CHKERRQ(PetscFVGetQuadrature((PetscFV) obj, &quad));
3113     }
3114     CHKERRQ(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       CHKERRQ(DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3126       CHKERRQ(DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ));
3127       /* Get points from the quadrature */
3128       CHKERRQ(VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec));
3129       CHKERRQ(VecSetBlockSize(pointVec, dim));
3130       CHKERRQ(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       CHKERRQ(VecRestoreArray(pointVec, &pV));
3139       /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3140       CHKERRQ(DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF));
3141       /* Update matrix */
3142       CHKERRQ(PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells));
3143       PetscCheck(numCoarseCells == Nq,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
3144       CHKERRQ(VecGetArray(pointVec, &pV));
3145       for (ccell = 0; ccell < numCoarseCells; ++ccell) {
3146         PetscReal pVReal[3];
3147         const PetscReal xi0[3] = {-1., -1., -1.};
3148 
3149         CHKERRQ(DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3150         /* Transform points from real space to coarse reference space */
3151         CHKERRQ(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           CHKERRQ(PetscFEGetDimension(fe, &cpdim));
3160           CHKERRQ(PetscFEComputeTabulation(fe, 1, x, 0, T));
3161           /* Get elemMat entries by multiplying by weight */
3162           for (i = 0; i < numFIndices; ++i) {
3163             CHKERRQ(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) CHKERRQ(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             CHKERRQ(MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES));
3171           }
3172         } else {
3173           cpdim = 1;
3174           for (i = 0; i < numFIndices; ++i) {
3175             CHKERRQ(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) CHKERRQ(DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat));
3181             CHKERRQ(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             CHKERRQ(MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES));
3184           }
3185         }
3186         CHKERRQ(DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL));
3187       }
3188       CHKERRQ(VecRestoreArray(pointVec, &pV));
3189       CHKERRQ(PetscSFDestroy(&coarseCellSF));
3190       CHKERRQ(VecDestroy(&pointVec));
3191       CHKERRQ(DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL));
3192     }
3193     if (id == PETSCFE_CLASSID) CHKERRQ(PetscTabulationDestroy(&T));
3194   }
3195   CHKERRQ(PetscFree3(v0,J,invJ));
3196   CHKERRQ(PetscFree3(v0c,Jc,invJc));
3197   CHKERRQ(PetscFree(elemMat));
3198   CHKERRQ(MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY));
3199   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0));
3232   CHKERRQ(DMGetDimension(dmf, &dim));
3233   CHKERRQ(DMGetLocalSection(dmf, &fsection));
3234   CHKERRQ(DMGetGlobalSection(dmf, &fglobalSection));
3235   CHKERRQ(DMGetLocalSection(dmc, &csection));
3236   CHKERRQ(DMGetGlobalSection(dmc, &cglobalSection));
3237   CHKERRQ(PetscSectionGetNumFields(fsection, &Nf));
3238   CHKERRQ(DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd));
3239   CHKERRQ(DMGetDS(dmc, &prob));
3240   CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
3247     CHKERRQ(PetscObjectGetClassId(obj, &id));
3248     if (id == PETSCFE_CLASSID) {
3249       PetscFE    fe = (PetscFE) obj;
3250       PetscSpace sp;
3251       PetscInt   maxDegree;
3252 
3253       CHKERRQ(PetscFERefine(fe, &feRef[f]));
3254       CHKERRQ(PetscFEGetDimension(feRef[f], &fNb));
3255       CHKERRQ(PetscFEGetNumComponents(fe, &Nc));
3256       CHKERRQ(PetscFEGetBasisSpace(fe, &sp));
3257       CHKERRQ(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       CHKERRQ(PetscFVRefine(fv, &fvRef[f]));
3264       CHKERRQ(PetscFVGetDualSpace(fvRef[f], &Q));
3265       CHKERRQ(PetscDualSpaceGetDimension(Q, &fNb));
3266       CHKERRQ(PetscFVGetNumComponents(fv, &Nc));
3267       needAvg[f] = PETSC_TRUE;
3268     }
3269     fTotDim += fNb;
3270   }
3271   CHKERRQ(PetscDSGetTotalDimension(prob, &cTotDim));
3272   CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(prob, field, (PetscObject *) &feC));
3281       CHKERRQ(PetscFEGetNumComponents(feC, &NcC));
3282       CHKERRQ(PetscFEGetNumComponents(feRef[field], &NcF));
3283       CHKERRQ(PetscFEGetDualSpace(feRef[field], &QF));
3284       CHKERRQ(PetscDualSpaceGetOrder(QF, &order));
3285       CHKERRQ(PetscDualSpaceGetDimension(QF, &fpdim));
3286       CHKERRQ(PetscFEGetDualSpace(feC, &QC));
3287       CHKERRQ(PetscDualSpaceGetDimension(QC, &cpdim));
3288     } else {
3289       CHKERRQ(PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC));
3290       CHKERRQ(PetscFVGetNumComponents(fvC, &NcC));
3291       CHKERRQ(PetscFVGetNumComponents(fvRef[field], &NcF));
3292       CHKERRQ(PetscFVGetDualSpace(fvRef[field], &QF));
3293       CHKERRQ(PetscDualSpaceGetDimension(QF, &fpdim));
3294       CHKERRQ(PetscFVGetDualSpace(fvC, &QC));
3295       CHKERRQ(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       CHKERRQ(PetscDualSpaceGetFunctional(QC, c, &cfunc));
3305       CHKERRQ(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         CHKERRQ(PetscDualSpaceGetFunctional(QF, f, &ffunc));
3315         CHKERRQ(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) {CHKERRQ(PetscFEDestroy(&feRef[f]));CHKERRQ(PetscFVDestroy(&fvRef[f]));}
3337   CHKERRQ(PetscFree3(feRef,fvRef,needAvg));
3338 
3339   CHKERRQ(DMGetGlobalVector(dmf, &fv));
3340   CHKERRQ(DMGetGlobalVector(dmc, &cv));
3341   CHKERRQ(VecGetOwnershipRange(cv, &startC, &endC));
3342   CHKERRQ(PetscSectionGetConstrainedStorageSize(cglobalSection, &m));
3343   CHKERRQ(PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices));
3344   CHKERRQ(PetscMalloc1(m,&cindices));
3345   CHKERRQ(PetscMalloc1(m,&findices));
3346   for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
3347   for (c = cStart; c < cEnd; ++c) {
3348     CHKERRQ(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   CHKERRQ(PetscFree(cmap));
3357   CHKERRQ(PetscFree2(cellCIndices,cellFIndices));
3358 
3359   CHKERRQ(ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis));
3360   CHKERRQ(ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis));
3361   CHKERRQ(VecScatterCreate(cv, cis, fv, fis, sc));
3362   CHKERRQ(ISDestroy(&cis));
3363   CHKERRQ(ISDestroy(&fis));
3364   CHKERRQ(DMRestoreGlobalVector(dmf, &fv));
3365   CHKERRQ(DMRestoreGlobalVector(dmc, &cv));
3366   CHKERRQ(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   CHKERRQ(DMPlexConvertPlex(dm, &plex, PETSC_FALSE));
3407   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
3408   CHKERRQ(DMGetLocalSection(dm, &section));
3409   CHKERRQ(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
3410   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
3411   if (locA) {
3412     DM      dmAux;
3413     PetscDS probAux;
3414 
3415     CHKERRQ(VecGetDM(locA, &dmAux));
3416     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
3417     CHKERRQ(DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE));
3418     CHKERRQ(DMGetLocalSection(dmAux, &sectionAux));
3419     CHKERRQ(DMGetDS(dmAux, &probAux));
3420     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
3421   }
3422   numCells = cEnd - cStart;
3423   CHKERRQ(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u));
3424   if (locX_t) CHKERRQ(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t)); else {*u_t = NULL;}
3425   if (locA)   CHKERRQ(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     CHKERRQ(DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x));
3433     for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i];
3434     CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x));
3435     if (locX_t) {
3436       CHKERRQ(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       CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t));
3439     }
3440     if (locA) {
3441       PetscInt subcell;
3442       CHKERRQ(DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell));
3443       CHKERRQ(DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x));
3444       for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i];
3445       CHKERRQ(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x));
3446     }
3447   }
3448   CHKERRQ(DMDestroy(&plex));
3449   if (locA) CHKERRQ(DMDestroy(&plexA));
3450   CHKERRQ(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   CHKERRQ(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u));
3477   if (locX_t) CHKERRQ(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t));
3478   if (locA)   CHKERRQ(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   CHKERRQ(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     CHKERRQ(DMPlexConvertPlex(dmAux[s], &plexA[s], PETSC_FALSE));
3506     CHKERRQ(DMGetEnclosureRelation(dmAux[s], dm, &encAux[s]));
3507     CHKERRQ(DMGetLocalSection(dmAux[s], &sectionAux[s]));
3508     CHKERRQ(PetscDSGetTotalDimension(dsAux[s], &totDimAux[s]));
3509     CHKERRQ(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     CHKERRQ(DMPlexGetCone(dm, cell, &cone));
3517     CHKERRQ(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       CHKERRQ(DMPlexGetSupport(dm, cone[s], &support));
3527       CHKERRQ(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       CHKERRQ(DMGetEnclosurePoint(plexA[s], dm, encAux[s], scell, &subface));
3534       CHKERRQ(DMPlexVecGetClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x));
3535       for (i = 0; i < Na; ++i) al[cind*tdA+i] = x[i];
3536       CHKERRQ(DMPlexVecRestoreClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x));
3537     }
3538   }
3539   for (s = 0; s < 2; ++s) CHKERRQ(DMDestroy(&plexA[s]));
3540   CHKERRQ(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   CHKERRQ(DMRestoreWorkArray(dmAux[0], 0, MPIU_SCALAR, &a[0]));
3549   CHKERRQ(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   CHKERRQ(DMGetDimension(dm, &dim));
3595   CHKERRQ(DMGetDS(dm, &prob));
3596   CHKERRQ(DMGetLocalSection(dm, &section));
3597   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
3598   CHKERRQ(PetscDSGetTotalComponents(prob, &Nc));
3599   CHKERRQ(PetscMalloc1(Nf, &isFE));
3600   for (f = 0; f < Nf; ++f) {
3601     PetscObject  obj;
3602     PetscClassId id;
3603 
3604     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
3605     CHKERRQ(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   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
3611   CHKERRQ(VecGetArrayRead(locX, &x));
3612   CHKERRQ(VecGetDM(faceGeometry, &dmFace));
3613   CHKERRQ(VecGetArrayRead(faceGeometry, &facegeom));
3614   CHKERRQ(VecGetDM(cellGeometry, &dmCell));
3615   CHKERRQ(VecGetArrayRead(cellGeometry, &cellgeom));
3616   if (locGrad) {
3617     CHKERRQ(VecGetDM(locGrad, &dmGrad));
3618     CHKERRQ(VecGetArrayRead(locGrad, &lgrad));
3619   }
3620   CHKERRQ(DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL));
3621   CHKERRQ(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     CHKERRQ(DMLabelGetValue(ghostLabel, face, &ghost));
3632     CHKERRQ(DMPlexGetSupportSize(dm, face, &nsupp));
3633     CHKERRQ(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
3634     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3635     CHKERRQ(DMPlexPointLocalRead(dmFace, face, facegeom, &fg));
3636     CHKERRQ(DMPlexGetSupport(dm, face, &cells));
3637     CHKERRQ(DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL));
3638     CHKERRQ(DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR));
3639     for (f = 0; f < Nf; ++f) {
3640       PetscInt off;
3641 
3642       CHKERRQ(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         CHKERRQ(PetscSectionGetFieldComponents(section, f, &comp));
3649         CHKERRQ(DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL));
3650         CHKERRQ(DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR));
3651         CHKERRQ(DMPlexGetCone(dm, cells[0], &cone));
3652         CHKERRQ(DMPlexGetConeSize(dm, cells[0], &coneSizeL));
3653         for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break;
3654         CHKERRQ(DMPlexGetCone(dm, cells[1], &cone));
3655         CHKERRQ(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           CHKERRQ(PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]));
3662           if (rdof == ldof && faceLocR < coneSizeR) CHKERRQ(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           CHKERRQ(PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]));
3667           CHKERRQ(PetscSectionGetFieldComponents(section, f, &comp));
3668           for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d];
3669         }
3670         CHKERRQ(DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL));
3671         CHKERRQ(DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR));
3672       } else {
3673         PetscFV  fv;
3674         PetscInt numComp, c;
3675 
3676         CHKERRQ(PetscDSGetDiscretization(prob, f, (PetscObject *) &fv));
3677         CHKERRQ(PetscFVGetNumComponents(fv, &numComp));
3678         CHKERRQ(DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL));
3679         CHKERRQ(DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR));
3680         if (dmGrad) {
3681           PetscReal dxL[3], dxR[3];
3682 
3683           CHKERRQ(DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL));
3684           CHKERRQ(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   CHKERRQ(VecRestoreArrayRead(locX, &x));
3703   CHKERRQ(VecRestoreArrayRead(faceGeometry, &facegeom));
3704   CHKERRQ(VecRestoreArrayRead(cellGeometry, &cellgeom));
3705   if (locGrad) {
3706     CHKERRQ(VecRestoreArrayRead(locGrad, &lgrad));
3707   }
3708   CHKERRQ(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   CHKERRQ(DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL));
3738   CHKERRQ(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   CHKERRQ(DMGetDimension(dm, &dim));
3775   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
3776   CHKERRQ(VecGetDM(faceGeometry, &dmFace));
3777   CHKERRQ(VecGetArrayRead(faceGeometry, &facegeom));
3778   CHKERRQ(VecGetDM(cellGeometry, &dmCell));
3779   CHKERRQ(VecGetArrayRead(cellGeometry, &cellgeom));
3780   CHKERRQ(PetscMalloc1(numFaces, fgeom));
3781   CHKERRQ(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     CHKERRQ(DMLabelGetValue(ghostLabel, face, &ghost));
3791     CHKERRQ(DMPlexGetSupportSize(dm, face, &nsupp));
3792     CHKERRQ(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
3793     if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3794     CHKERRQ(DMPlexPointLocalRead(dmFace, face, facegeom, &fg));
3795     CHKERRQ(DMPlexGetSupport(dm, face, &cells));
3796     CHKERRQ(DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL));
3797     CHKERRQ(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   CHKERRQ(VecRestoreArrayRead(faceGeometry, &facegeom));
3808   CHKERRQ(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   CHKERRQ(PetscFree(*fgeom));
3835   CHKERRQ(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   CHKERRQ(PetscObjectGetId((PetscObject)quad,&id));
3847   CHKERRQ(PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id));
3848   CHKERRQ(PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container));
3849   if (container) {
3850     CHKERRQ(PetscContainerGetPointer(container, (void **) geom));
3851   } else {
3852     CHKERRQ(DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom));
3853     CHKERRQ(PetscContainerCreate(PETSC_COMM_SELF,&container));
3854     CHKERRQ(PetscContainerSetPointer(container, (void *) *geom));
3855     CHKERRQ(PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom));
3856     CHKERRQ(PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container));
3857     CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0));
3893   /* FEM+FVM */
3894   /* 1: Get sizes from dm and dmAux */
3895   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
3896   CHKERRQ(DMGetDS(dm, &prob));
3897   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
3898   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
3899   CHKERRQ(DMGetAuxiliaryVec(dm, NULL, 0, 0, &locA));
3900   if (locA) {
3901     CHKERRQ(VecGetDM(locA, &dmAux));
3902     CHKERRQ(DMGetDS(dmAux, &probAux));
3903     CHKERRQ(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     CHKERRQ(PetscDSGetImplicit(prob, f, &fimp));
3912     if (isImplicit != fimp) continue;
3913     CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
3914     CHKERRQ(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     CHKERRQ(DMGetCoordinateField(dm, &coordField));
3920     CHKERRQ(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
3921     if (maxDegree <= 1) {
3922       CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
3923       if (affineQuad) {
3924         CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
3925       }
3926     } else {
3927       CHKERRQ(PetscCalloc2(Nf,&quads,Nf,&geoms));
3928       for (f = 0; f < Nf; ++f) {
3929         PetscObject  obj;
3930         PetscClassId id;
3931         PetscBool    fimp;
3932 
3933         CHKERRQ(PetscDSGetImplicit(prob, f, &fimp));
3934         if (isImplicit != fimp) continue;
3935         CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
3936         CHKERRQ(PetscObjectGetClassId(obj, &id));
3937         if (id == PETSCFE_CLASSID) {
3938           PetscFE fe = (PetscFE) obj;
3939 
3940           CHKERRQ(PetscFEGetQuadrature(fe, &quads[f]));
3941           CHKERRQ(PetscObjectReference((PetscObject)quads[f]));
3942           CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
3943         }
3944       }
3945     }
3946   }
3947   /* Loop over chunks */
3948   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
3949   CHKERRQ(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
3950   if (useFEM) CHKERRQ(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       CHKERRQ(ISGetPointSubrange(chunkIS, cS, cE, cells));
3968       CHKERRQ(DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
3969       CHKERRQ(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
3970       CHKERRQ(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       CHKERRQ(PetscDSGetImplicit(prob, f, &fimp));
3982       if (isImplicit != fimp) continue;
3983       CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
3984       CHKERRQ(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         CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
3993         CHKERRQ(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
3994         CHKERRQ(PetscFEGetDimension(fe, &Nb));
3995         blockSize = Nb;
3996         batchSize = numBlocks * blockSize;
3997         CHKERRQ(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         CHKERRQ(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
4005         CHKERRQ(PetscFEIntegrateResidual(prob, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec));
4006         CHKERRQ(PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom));
4007         CHKERRQ(PetscFEIntegrateResidual(prob, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]));
4008         CHKERRQ(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         CHKERRQ(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) CHKERRQ(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
4026         if (ghostLabel) {
4027           PetscInt ghostVal;
4028 
4029           CHKERRQ(DMLabelGetValue(ghostLabel,cell,&ghostVal));
4030           if (ghostVal > 0) continue;
4031         }
4032         CHKERRQ(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       CHKERRQ(VecGetArray(locF, &fa));
4040       CHKERRQ(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         CHKERRQ(PetscDSGetDiscretization(prob, f, &obj));
4048         CHKERRQ(PetscObjectGetClassId(obj, &id));
4049         if (id != PETSCFV_CLASSID) continue;
4050         fv   = (PetscFV) obj;
4051         CHKERRQ(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             CHKERRQ(DMLabelGetValue(ghostLabel, cell, &ghostVal));
4060             if (ghostVal > 0) continue;
4061           }
4062           CHKERRQ(DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t));
4063           CHKERRQ(DMPlexPointLocalFieldRef(dm, cell, f, fa, &r));
4064           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4065         }
4066       }
4067       CHKERRQ(VecRestoreArray(locX_t, &x_t));
4068       CHKERRQ(VecRestoreArray(locF, &fa));
4069     }
4070     if (useFEM) {
4071       CHKERRQ(DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4072       CHKERRQ(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4073     }
4074   }
4075   if (useFEM) CHKERRQ(ISDestroy(&chunkIS));
4076   CHKERRQ(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
4077   /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */
4078   if (useFEM) {
4079     if (maxDegree <= 1) {
4080       CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4081       CHKERRQ(PetscQuadratureDestroy(&affineQuad));
4082     } else {
4083       for (f = 0; f < Nf; ++f) {
4084         CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4085         CHKERRQ(PetscQuadratureDestroy(&quads[f]));
4086       }
4087       CHKERRQ(PetscFree2(quads,geoms));
4088     }
4089   }
4090   CHKERRQ(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   CHKERRQ(ISGetLocalSize(cellIS, &numCells));
4121   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4122   CHKERRQ(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
4123   CHKERRQ(DMGetDS(dm, &prob));
4124   CHKERRQ(DMGetAuxiliaryVec(dm, NULL, 0, 0, &A));
4125   if (A) {
4126     CHKERRQ(VecGetDM(A, &dmAux));
4127     CHKERRQ(DMGetLocalSection(dmAux, &sectionAux));
4128     CHKERRQ(DMGetDS(dmAux, &probAux));
4129   }
4130   /* Get flags */
4131   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
4132   CHKERRQ(DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE));
4133   for (fieldI = 0; fieldI < Nf; ++fieldI) {
4134     PetscObject  disc;
4135     PetscClassId id;
4136     CHKERRQ(PetscDSGetDiscretization(prob, fieldI, &disc));
4137     CHKERRQ(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   CHKERRQ(PetscDSHasJacobian(prob, &hasJac));
4142   CHKERRQ(PetscDSHasJacobianPreconditioner(prob, &hasPrec));
4143   CHKERRQ(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) CHKERRQ(MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE)); /* No allocated space for FV stuff, so ignore the zero entries */
4147   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
4148   if (probAux) CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe));
4156     CHKERRQ(PetscFEGetQuadrature(fe, &q));
4157     CHKERRQ(PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL));
4158     CHKERRQ(PetscFEGetDimension(fe, &Nb));
4159     CHKERRQ(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     CHKERRQ(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   CHKERRQ(DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work));
4172   CHKERRQ(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   CHKERRQ(DMGetCoordinateField(dm, &coordField));
4183   CHKERRQ(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
4184   if (maxDegree <= 1) CHKERRQ(DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom));
4185   if (!qGeom) {
4186     PetscFE fe;
4187 
4188     CHKERRQ(PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe));
4189     CHKERRQ(PetscFEGetQuadrature(fe, &qGeom));
4190     CHKERRQ(PetscObjectReference((PetscObject) qGeom));
4191   }
4192   CHKERRQ(DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM));
4193   /* Compute volume integrals */
4194   if (assembleJac) CHKERRQ(MatZeroEntries(J));
4195   CHKERRQ(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         CHKERRQ(DMPlexVecGetClosure(dm, section, X, cell, NULL, &x));
4211         for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
4212         CHKERRQ(DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x));
4213       }
4214       if (X_t) {
4215         CHKERRQ(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         CHKERRQ(DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t));
4218       }
4219       if (dmAux) {
4220         CHKERRQ(DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x));
4221         for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
4222         CHKERRQ(DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x));
4223       }
4224     }
4225     for (fieldI = 0; fieldI < Nf; ++fieldI) {
4226       PetscFE fe;
4227       CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
4228       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
4229         key.field = fieldI*Nf + fieldJ;
4230         if (hasJac)  CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN,     key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat));
4231         if (hasPrec) CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP));
4232         if (hasDyn)  CHKERRQ(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         CHKERRQ(PetscDSGetFieldOffset(prob, fieldI, &foff));
4240         CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv));
4241         CHKERRQ(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)  CHKERRQ(DMPrintCellMatrix(cell, name,  totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]));
4258         if (hasPrec) CHKERRQ(DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]));
4259       }
4260       if (assembleJac) CHKERRQ(DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES));
4261       CHKERRQ(DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES));
4262     }
4263   }
4264   /* Cleanup */
4265   CHKERRQ(DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM));
4266   CHKERRQ(PetscQuadratureDestroy(&qGeom));
4267   if (hasFV) CHKERRQ(MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
4268   CHKERRQ(DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE));
4269   CHKERRQ(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   /* CHKERRQ(DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx)); */
4272   /* Assemble matrix */
4273   if (assembleJac) {CHKERRQ(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));CHKERRQ(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));}
4274   CHKERRQ(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));CHKERRQ(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
4275   CHKERRQ(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   CHKERRQ(PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex));
4287   if (isPlex) {
4288     *plex = dm;
4289     CHKERRQ(PetscObjectReference((PetscObject) dm));
4290   } else {
4291     CHKERRQ(PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex));
4292     if (!*plex) {
4293       CHKERRQ(DMConvert(dm,DMPLEX,plex));
4294       CHKERRQ(PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex));
4295       if (copy) {
4296         CHKERRQ(DMCopyAuxiliaryVec(dm, *plex));
4297       }
4298     } else {
4299       CHKERRQ(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   CHKERRQ(DMConvertPlex_Internal(dm,&plex,PETSC_TRUE));
4329   CHKERRQ(DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL));
4330   if (minRadius) CHKERRQ(DMPlexGetMinRadius(plex, minRadius));
4331   CHKERRQ(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   CHKERRQ(PetscFVGetComputeGradients(fv, &computeGradients));
4361   if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
4362   CHKERRQ(DMConvertPlex_Internal(dm,&plex,PETSC_TRUE));
4363   CHKERRQ(DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad));
4364   CHKERRQ(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   CHKERRQ(DMConvert(dm, DMPLEX, &plex));
4381   CHKERRQ(DMGetLocalSection(dm, &section));
4382   CHKERRQ(DMGetDS(dm, &prob));
4383   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
4384   CHKERRQ(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &locA));
4385   if (locA) {
4386     DM dmAux;
4387 
4388     CHKERRQ(VecGetDM(locA, &dmAux));
4389     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
4390     CHKERRQ(DMConvert(dmAux, DMPLEX, &plexA));
4391     CHKERRQ(DMGetDS(plexA, &probAux));
4392     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
4393     CHKERRQ(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     CHKERRQ(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       CHKERRQ(ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS));
4410       CHKERRQ(ISDestroy(&pointIS));
4411       pointIS = isectIS;
4412     }
4413     CHKERRQ(ISGetLocalSize(pointIS,&numFaces));
4414     CHKERRQ(ISGetIndices(pointIS,&points));
4415     CHKERRQ(PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a));
4416     CHKERRQ(DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree));
4417     if (maxDegree <= 1) {
4418       CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom));
4419     }
4420     if (!qGeom) {
4421       PetscFE fe;
4422 
4423       CHKERRQ(PetscDSGetDiscretization(prob, key.field, (PetscObject *) &fe));
4424       CHKERRQ(PetscFEGetFaceQuadrature(fe, &qGeom));
4425       CHKERRQ(PetscObjectReference((PetscObject)qGeom));
4426     }
4427     CHKERRQ(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
4428     CHKERRQ(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       CHKERRQ(DMPlexGetSupport(dm, point, &support));
4435       CHKERRQ(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
4436       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
4437       CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
4438       if (locX_t) {
4439         CHKERRQ(DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x));
4440         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
4441         CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x));
4442       }
4443       if (locA) {
4444         PetscInt subp;
4445 
4446         CHKERRQ(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
4447         CHKERRQ(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
4448         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
4449         CHKERRQ(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x));
4450       }
4451     }
4452     CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(prob, key.field, (PetscObject *) &fe));
4463       CHKERRQ(PetscFEGetDimension(fe, &Nb));
4464       CHKERRQ(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       CHKERRQ(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       CHKERRQ(PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom));
4474       CHKERRQ(PetscFEIntegrateBdResidual(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec));
4475       CHKERRQ(PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom));
4476       CHKERRQ(PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom));
4477       CHKERRQ(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       CHKERRQ(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) CHKERRQ(DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]));
4484       CHKERRQ(DMPlexGetSupport(plex, point, &support));
4485       CHKERRQ(DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES));
4486     }
4487     CHKERRQ(DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
4488     CHKERRQ(PetscQuadratureDestroy(&qGeom));
4489     CHKERRQ(ISRestoreIndices(pointIS, &points));
4490     CHKERRQ(ISDestroy(&pointIS));
4491     CHKERRQ(PetscFree4(u, u_t, elemVec, a));
4492   }
4493   end:
4494   CHKERRQ(DMDestroy(&plex));
4495   CHKERRQ(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   CHKERRQ(DMGetDimension(dm, &dim));
4508   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
4509   CHKERRQ(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
4510   CHKERRQ(DMGetCoordinateField(dm, &coordField));
4511   CHKERRQ(DMPlexComputeBdResidual_Single_Internal(dm, t, wf, key, locX, locX_t, locF, coordField, facetIS));
4512   CHKERRQ(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   CHKERRQ(DMGetDS(dm, &prob));
4527   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
4528   CHKERRQ(DMGetDimension(dm, &dim));
4529   CHKERRQ(DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS));
4530   CHKERRQ(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     CHKERRQ(PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &field, NULL, NULL, NULL, NULL, NULL));
4542     CHKERRQ(PetscDSGetDiscretization(prob, field, &obj));
4543     CHKERRQ(PetscObjectGetClassId(obj, &id));
4544     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
4545     if (!facetIS) {
4546       DMLabel  depthLabel;
4547       PetscInt dim;
4548 
4549       CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
4550       CHKERRQ(DMGetDimension(dm, &dim));
4551       CHKERRQ(DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS));
4552     }
4553     CHKERRQ(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       CHKERRQ(DMPlexComputeBdResidual_Single_Internal(dm, t, wf, key, locX, locX_t, locF, coordField, facetIS));
4560     }
4561   }
4562   CHKERRQ(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   CHKERRQ(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   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4599   CHKERRQ(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
4600   /* 1: Get sizes from dm and dmAux */
4601   CHKERRQ(DMGetLocalSection(dm, &section));
4602   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
4603   CHKERRQ(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &ds));
4604   CHKERRQ(PetscDSGetNumFields(ds, &Nf));
4605   CHKERRQ(PetscDSGetTotalDimension(ds, &totDim));
4606   CHKERRQ(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &locA));
4607   if (locA) {
4608     PetscInt subcell;
4609     CHKERRQ(VecGetDM(locA, &dmAux));
4610     CHKERRQ(DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell));
4611     CHKERRQ(DMGetCellDS(dmAux, subcell, &dsAux));
4612     CHKERRQ(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     CHKERRQ(PetscDSGetImplicit(ds, f, &fimp));
4621     if (isImplicit != fimp) continue;
4622     CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
4623     CHKERRQ(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     CHKERRQ(DMGetCoordinateField(dm, &coordField));
4629     CHKERRQ(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
4630     if (maxDegree <= 1) {
4631       CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad));
4632       if (affineQuad) {
4633         CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4634       }
4635     } else {
4636       CHKERRQ(PetscCalloc2(Nf,&quads,Nf,&geoms));
4637       for (f = 0; f < Nf; ++f) {
4638         PetscObject  obj;
4639         PetscClassId id;
4640         PetscBool    fimp;
4641 
4642         CHKERRQ(PetscDSGetImplicit(ds, f, &fimp));
4643         if (isImplicit != fimp) continue;
4644         CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
4645         CHKERRQ(PetscObjectGetClassId(obj, &id));
4646         if (id == PETSCFE_CLASSID) {
4647           PetscFE fe = (PetscFE) obj;
4648 
4649           CHKERRQ(PetscFEGetQuadrature(fe, &quads[f]));
4650           CHKERRQ(PetscObjectReference((PetscObject)quads[f]));
4651           CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4652         }
4653       }
4654     }
4655   }
4656   if (useFVM) {
4657     CHKERRQ(DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL));
4658     CHKERRQ(VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM));
4659     CHKERRQ(VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM));
4660     /* Reconstruct and limit cell gradients */
4661     CHKERRQ(DMPlexGetGradientDM(dm, fvm, &dmGrad));
4662     if (dmGrad) {
4663       CHKERRQ(DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd));
4664       CHKERRQ(DMGetGlobalVector(dmGrad, &grad));
4665       CHKERRQ(DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad));
4666       /* Communicate gradient values */
4667       CHKERRQ(DMGetLocalVector(dmGrad, &locGrad));
4668       CHKERRQ(DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad));
4669       CHKERRQ(DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad));
4670       CHKERRQ(DMRestoreGlobalVector(dmGrad, &grad));
4671     }
4672     /* Handle non-essential (e.g. outflow) boundary values */
4673     CHKERRQ(DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad));
4674   }
4675   /* Loop over chunks */
4676   if (useFEM) CHKERRQ(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       CHKERRQ(ISGetPointSubrange(chunkIS, cS, cE, cells));
4692       CHKERRQ(DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4693       CHKERRQ(DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4694       CHKERRQ(PetscArrayzero(elemVec, numCells*totDim));
4695     }
4696     if (useFVM) {
4697       CHKERRQ(DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR));
4698       CHKERRQ(DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol));
4699       CHKERRQ(DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL));
4700       CHKERRQ(DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR));
4701       CHKERRQ(PetscArrayzero(fluxL, numFaces*totDim));
4702       CHKERRQ(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       CHKERRQ(PetscDSGetImplicit(ds, f, &fimp));
4714       if (isImplicit != fimp) continue;
4715       CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
4716       CHKERRQ(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         CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
4725         CHKERRQ(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
4726         CHKERRQ(PetscFEGetDimension(fe, &Nb));
4727         blockSize = Nb;
4728         batchSize = numBlocks * blockSize;
4729         CHKERRQ(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         CHKERRQ(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
4737         CHKERRQ(PetscFEIntegrateResidual(ds, key, Ne, chunkGeom, u, u_t, dsAux, a, t, elemVec));
4738         CHKERRQ(PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom));
4739         CHKERRQ(PetscFEIntegrateResidual(ds, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]));
4740         CHKERRQ(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         CHKERRQ(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) CHKERRQ(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
4758         if (ghostLabel) {
4759           PetscInt ghostVal;
4760 
4761           CHKERRQ(DMLabelGetValue(ghostLabel,cell,&ghostVal));
4762           if (ghostVal > 0) continue;
4763         }
4764         CHKERRQ(DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES));
4765       }
4766     }
4767     if (useFVM) {
4768       PetscScalar *fa;
4769       PetscInt     iface;
4770 
4771       CHKERRQ(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         CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
4779         CHKERRQ(PetscDSGetFieldOffset(ds, f, &foff));
4780         CHKERRQ(PetscObjectGetClassId(obj, &id));
4781         if (id != PETSCFV_CLASSID) continue;
4782         fv   = (PetscFV) obj;
4783         CHKERRQ(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           CHKERRQ(DMLabelGetValue(ghostLabel, face, &ghost));
4791           CHKERRQ(DMPlexGetSupportSize(dm, face, &nsupp));
4792           CHKERRQ(DMPlexGetTreeChildren(dm, face, &nchild, NULL));
4793           if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
4794           CHKERRQ(DMPlexGetSupport(dm, face, &scells));
4795           CHKERRQ(DMLabelGetValue(ghostLabel,scells[0],&ghost));
4796           if (ghost <= 0) CHKERRQ(DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL));
4797           CHKERRQ(DMLabelGetValue(ghostLabel,scells[1],&ghost));
4798           if (ghost <= 0) CHKERRQ(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       CHKERRQ(VecRestoreArray(locF, &fa));
4807     }
4808     /* Handle time derivative */
4809     if (locX_t) {
4810       PetscScalar *x_t, *fa;
4811 
4812       CHKERRQ(VecGetArray(locF, &fa));
4813       CHKERRQ(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         CHKERRQ(PetscDSGetDiscretization(ds, f, &obj));
4821         CHKERRQ(PetscObjectGetClassId(obj, &id));
4822         if (id != PETSCFV_CLASSID) continue;
4823         fv   = (PetscFV) obj;
4824         CHKERRQ(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             CHKERRQ(DMLabelGetValue(ghostLabel, cell, &ghostVal));
4833             if (ghostVal > 0) continue;
4834           }
4835           CHKERRQ(DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t));
4836           CHKERRQ(DMPlexPointLocalFieldRef(dm, cell, f, fa, &r));
4837           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4838         }
4839       }
4840       CHKERRQ(VecRestoreArray(locX_t, &x_t));
4841       CHKERRQ(VecRestoreArray(locF, &fa));
4842     }
4843     if (useFEM) {
4844       CHKERRQ(DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a));
4845       CHKERRQ(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
4846     }
4847     if (useFVM) {
4848       CHKERRQ(DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR));
4849       CHKERRQ(DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol));
4850       CHKERRQ(DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL));
4851       CHKERRQ(DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR));
4852       if (dmGrad) CHKERRQ(DMRestoreLocalVector(dmGrad, &locGrad));
4853     }
4854   }
4855   if (useFEM) CHKERRQ(ISDestroy(&chunkIS));
4856   CHKERRQ(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
4857 
4858   if (useFEM) {
4859     CHKERRQ(DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user));
4860 
4861     if (maxDegree <= 1) {
4862       CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
4863       CHKERRQ(PetscQuadratureDestroy(&affineQuad));
4864     } else {
4865       for (f = 0; f < Nf; ++f) {
4866         CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
4867         CHKERRQ(PetscQuadratureDestroy(&quads[f]));
4868       }
4869       CHKERRQ(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     CHKERRQ(VecDuplicate(locF,&locFbc));
4914     CHKERRQ(VecCopy(locF,locFbc));
4915     CHKERRQ(PetscSectionGetChart(section,&pStart,&pEnd));
4916     CHKERRQ(PetscSectionGetMaxDof(section,&maxDof));
4917     CHKERRQ(PetscCalloc1(maxDof,&zeroes));
4918     for (p = pStart; p < pEnd; p++) {
4919       CHKERRQ(VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES));
4920     }
4921     CHKERRQ(PetscFree(zeroes));
4922     CHKERRQ(DMPrintLocalVec(dm, name, mesh->printTol, locFbc));
4923     CHKERRQ(VecDestroy(&locFbc));
4924   }
4925   CHKERRQ(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     CHKERRQ(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   CHKERRQ(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   CHKERRQ(ISGetLocalSize(cellIS, &numCells));
4971   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
4972   /* 1: Get sizes from dm and dmAux */
4973   CHKERRQ(DMGetSection(dm, &section));
4974   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
4975   CHKERRQ(DMGetCellDS(dm, cStart, &ds));
4976   CHKERRQ(PetscDSGetNumFields(ds, &Nf));
4977   CHKERRQ(PetscDSGetTotalDimension(ds, &totDim));
4978   CHKERRQ(DMGetAuxiliaryVec(dm, key[2].label, key[2].value, key[2].part, &locA[2]));
4979   if (locA[2]) {
4980     CHKERRQ(VecGetDM(locA[2], &dmAux[2]));
4981     CHKERRQ(DMGetCellDS(dmAux[2], cStart, &dsAux[2]));
4982     CHKERRQ(PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]));
4983     {
4984       const PetscInt *cone;
4985       PetscInt        c;
4986 
4987       CHKERRQ(DMPlexGetCone(dm, cStart, &cone));
4988       for (c = 0; c < 2; ++c) {
4989         const PetscInt *support;
4990         PetscInt ssize, s;
4991 
4992         CHKERRQ(DMPlexGetSupport(dm, cone[c], &support));
4993         CHKERRQ(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         CHKERRQ(DMGetAuxiliaryVec(dm, key[c].label, key[c].value, key[c].part, &locA[c]));
4999         if (locA[c]) CHKERRQ(VecGetDM(locA[c], &dmAux[c]));
5000         else         {dmAux[c] = dmAux[2];}
5001         CHKERRQ(DMGetCellDS(dmAux[c], support[s], &dsAux[c]));
5002         CHKERRQ(PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]));
5003       }
5004     }
5005   }
5006   /* 2: Setup geometric data */
5007   CHKERRQ(DMGetCoordinateField(dm, &coordField));
5008   CHKERRQ(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
5009   if (maxDegree > 1) {
5010     CHKERRQ(PetscCalloc2(Nf, &quads, Nf, &geoms));
5011     for (f = 0; f < Nf; ++f) {
5012       PetscFE fe;
5013 
5014       CHKERRQ(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5015       if (fe) {
5016         CHKERRQ(PetscFEGetQuadrature(fe, &quads[f]));
5017         CHKERRQ(PetscObjectReference((PetscObject) quads[f]));
5018       }
5019     }
5020   }
5021   /* Loop over chunks */
5022   cellChunkSize = numCells;
5023   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5024   CHKERRQ(PetscCalloc1(2*cellChunkSize, &faces));
5025   CHKERRQ(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   CHKERRQ(DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5029   CHKERRQ(DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a));
5030   CHKERRQ(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     CHKERRQ(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       CHKERRQ(DMPlexGetCone(dm, cell, &cone));
5040       faces[(c-cS)*2+0] = cone[0];
5041       faces[(c-cS)*2+1] = cone[1];
5042     }
5043     CHKERRQ(ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER));
5044     /* Get geometric data */
5045     if (maxDegree <= 1) {
5046       if (!affineQuad) CHKERRQ(DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad));
5047       if (affineQuad)  CHKERRQ(DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom));
5048     } else {
5049       for (f = 0; f < Nf; ++f) {
5050         if (quads[f]) CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5063       if (!fe) continue;
5064       CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5065       CHKERRQ(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
5066       CHKERRQ(PetscFEGetDimension(fe, &Nb));
5067       blockSize = Nb;
5068       batchSize = numBlocks * blockSize;
5069       CHKERRQ(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       CHKERRQ(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
5075       CHKERRQ(PetscFEGeomGetChunk(geom,offset,numCells,&remGeom));
5076       CHKERRQ(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       CHKERRQ(PetscFEIntegrateHybridResidual(ds, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, elemVec));
5082       CHKERRQ(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       CHKERRQ(PetscFEIntegrateHybridResidual(ds, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, elemVec));
5084       CHKERRQ(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       CHKERRQ(PetscFEIntegrateHybridResidual(ds, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, elemVec));
5086       CHKERRQ(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       CHKERRQ(PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom));
5088       CHKERRQ(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) CHKERRQ(DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]));
5096       if (ghostLabel) {
5097         PetscInt ghostVal;
5098 
5099         CHKERRQ(DMLabelGetValue(ghostLabel,cell,&ghostVal));
5100         if (ghostVal > 0) continue;
5101       }
5102       CHKERRQ(DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES));
5103     }
5104   }
5105   CHKERRQ(DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5106   CHKERRQ(DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a));
5107   CHKERRQ(DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec));
5108   CHKERRQ(PetscFree(faces));
5109   CHKERRQ(ISDestroy(&chunkIS));
5110   CHKERRQ(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5111   if (maxDegree <= 1) {
5112     CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
5113     CHKERRQ(PetscQuadratureDestroy(&affineQuad));
5114   } else {
5115     for (f = 0; f < Nf; ++f) {
5116       if (geoms) CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]));
5117       if (quads) CHKERRQ(PetscQuadratureDestroy(&quads[f]));
5118     }
5119     CHKERRQ(PetscFree2(quads,geoms));
5120   }
5121   CHKERRQ(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   CHKERRQ(DMConvert(dm, DMPLEX, &plex));
5141   CHKERRQ(DMHasBasisTransform(dm, &transform));
5142   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
5143   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
5144   CHKERRQ(DMGetLocalSection(dm, &section));
5145   CHKERRQ(DMGetDS(dm, &prob));
5146   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
5147   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
5148   CHKERRQ(DMGetAuxiliaryVec(dm, label, values[0], 0, &locA));
5149   if (locA) {
5150     DM dmAux;
5151 
5152     CHKERRQ(VecGetDM(locA, &dmAux));
5153     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
5154     CHKERRQ(DMConvert(dmAux, DMPLEX, &plexA));
5155     CHKERRQ(DMGetDS(plexA, &probAux));
5156     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
5157     CHKERRQ(DMGetLocalSection(plexA, &sectionAux));
5158   }
5159 
5160   CHKERRQ(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     CHKERRQ(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       CHKERRQ(ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS));
5180       CHKERRQ(ISDestroy(&pointIS));
5181       pointIS = isectIS;
5182     }
5183     CHKERRQ(ISGetLocalSize(pointIS, &numFaces));
5184     CHKERRQ(ISGetIndices(pointIS, &points));
5185     CHKERRQ(PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a));
5186     CHKERRQ(DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree));
5187     if (maxDegree <= 1) {
5188       CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom));
5189     }
5190     if (!qGeom) {
5191       PetscFE fe;
5192 
5193       CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5194       CHKERRQ(PetscFEGetFaceQuadrature(fe, &qGeom));
5195       CHKERRQ(PetscObjectReference((PetscObject)qGeom));
5196     }
5197     CHKERRQ(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5198     CHKERRQ(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       CHKERRQ(DMPlexGetSupport(dm, point, &support));
5205       CHKERRQ(DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x));
5206       for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
5207       CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x));
5208       if (locX_t) {
5209         CHKERRQ(DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x));
5210         for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
5211         CHKERRQ(DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x));
5212       }
5213       if (locA) {
5214         PetscInt subp;
5215         CHKERRQ(DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp));
5216         CHKERRQ(DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x));
5217         for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
5218         CHKERRQ(DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x));
5219       }
5220     }
5221     CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5232       CHKERRQ(PetscFEGetDimension(fe, &Nb));
5233       CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5234       blockSize = Nb;
5235       batchSize = numBlocks * blockSize;
5236       CHKERRQ(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       CHKERRQ(PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom));
5242       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5243         key.field = fieldI*Nf+fieldJ;
5244         CHKERRQ(PetscFEIntegrateBdJacobian(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5245       }
5246       CHKERRQ(PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom));
5247       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5248         key.field = fieldI*Nf+fieldJ;
5249         CHKERRQ(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       CHKERRQ(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       CHKERRQ(DMPlexGetSupport(plex, point, &support));
5258       if (transform) CHKERRQ(DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]));
5259       if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]));
5260       CHKERRQ(DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES));
5261     }
5262     CHKERRQ(DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom));
5263     CHKERRQ(PetscQuadratureDestroy(&qGeom));
5264     CHKERRQ(ISRestoreIndices(pointIS, &points));
5265     CHKERRQ(ISDestroy(&pointIS));
5266     CHKERRQ(PetscFree4(u, u_t, elemMat, a));
5267   }
5268   if (plex)  CHKERRQ(DMDestroy(&plex));
5269   if (plexA) CHKERRQ(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   CHKERRQ(DMGetDimension(dm, &dim));
5282   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
5283   CHKERRQ(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
5284   CHKERRQ(DMGetCoordinateField(dm, &coordField));
5285   CHKERRQ(DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS));
5286   CHKERRQ(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   CHKERRQ(DMGetDS(dm, &prob));
5300   CHKERRQ(DMPlexGetDepthLabel(dm, &depthLabel));
5301   CHKERRQ(DMGetDimension(dm, &dim));
5302   CHKERRQ(DMLabelGetStratumIS(depthLabel, dim-1, &facetIS));
5303   CHKERRQ(PetscDSGetNumBoundary(prob, &numBd));
5304   CHKERRQ(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     CHKERRQ(PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &fieldI, NULL, NULL, NULL, NULL, NULL));
5315     CHKERRQ(PetscDSGetDiscretization(prob, fieldI, &obj));
5316     CHKERRQ(PetscObjectGetClassId(obj, &id));
5317     if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
5318     CHKERRQ(DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS));
5319   }
5320   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5342   CHKERRQ(ISGetLocalSize(cellIS, &numCells));
5343   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5344   CHKERRQ(DMHasBasisTransform(dm, &transform));
5345   CHKERRQ(DMGetBasisTransformDM_Internal(dm, &tdm));
5346   CHKERRQ(DMGetBasisTransformVec_Internal(dm, &tv));
5347   CHKERRQ(DMGetLocalSection(dm, &section));
5348   CHKERRQ(DMGetGlobalSection(dm, &globalSection));
5349   CHKERRQ(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
5350   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
5351   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
5352   CHKERRQ(PetscDSHasJacobian(prob, &hasJac));
5353   CHKERRQ(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   CHKERRQ(PetscDSHasDynamicJacobian(prob, &hasDyn));
5358   hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5359   CHKERRQ(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &A));
5360   if (A) {
5361     CHKERRQ(VecGetDM(A, &dmAux));
5362     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
5363     CHKERRQ(DMConvert(dmAux, DMPLEX, &plex));
5364     CHKERRQ(DMGetLocalSection(plex, &sectionAux));
5365     CHKERRQ(DMGetDS(dmAux, &probAux));
5366     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
5367   }
5368   CHKERRQ(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) CHKERRQ(PetscMalloc1(numCells*totDimAux, &a));
5370   CHKERRQ(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     CHKERRQ(DMPlexVecGetClosure(dm, section, X, cell, NULL, &x));
5378     for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5379     CHKERRQ(DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x));
5380     if (X_t) {
5381       CHKERRQ(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       CHKERRQ(DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t));
5384     }
5385     if (dmAux) {
5386       PetscInt subcell;
5387       CHKERRQ(DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell));
5388       CHKERRQ(DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x));
5389       for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5390       CHKERRQ(DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x));
5391     }
5392   }
5393   if (hasJac)  CHKERRQ(PetscArrayzero(elemMat,  numCells*totDim*totDim));
5394   if (hasPrec) CHKERRQ(PetscArrayzero(elemMatP, numCells*totDim*totDim));
5395   if (hasDyn)  CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5409     CHKERRQ(PetscObjectGetClassId((PetscObject) fe, &id));
5410     if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;}
5411     CHKERRQ(PetscFEGetDimension(fe, &Nb));
5412     CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5413     CHKERRQ(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
5414     if (maxDegree <= 1) {
5415       CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom));
5416     }
5417     if (!qGeom) {
5418       CHKERRQ(PetscFEGetQuadrature(fe,&qGeom));
5419       CHKERRQ(PetscObjectReference((PetscObject)qGeom));
5420     }
5421     CHKERRQ(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5422     CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5423     blockSize = Nb;
5424     batchSize = numBlocks * blockSize;
5425     CHKERRQ(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     CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
5431     CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom));
5432     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5433       key.field = fieldI*Nf+fieldJ;
5434       if (hasJac) {
5435         CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5436         CHKERRQ(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         CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP));
5440         CHKERRQ(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         CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD));
5444         CHKERRQ(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     CHKERRQ(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom));
5448     CHKERRQ(PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom));
5449     CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5450     CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv));
5461       CHKERRQ(PetscDSGetFieldOffset(prob, fieldI, &offsetI));
5462       CHKERRQ(PetscObjectGetClassId((PetscObject) fv, &id));
5463       if (id != PETSCFV_CLASSID) continue;
5464       /* Put in the identity */
5465       CHKERRQ(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     CHKERRQ(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) CHKERRQ(DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]));
5490     if (hasPrec) {
5491       if (hasJac) {
5492         if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5493         CHKERRQ(DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5494       }
5495       if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]));
5496       CHKERRQ(DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES));
5497     } else {
5498       if (hasJac) {
5499         if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5500         CHKERRQ(DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5501       }
5502     }
5503   }
5504   CHKERRQ(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5505   if (hasFV) CHKERRQ(MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
5506   CHKERRQ(PetscFree5(u,u_t,elemMat,elemMatP,elemMatD));
5507   if (dmAux) {
5508     CHKERRQ(PetscFree(a));
5509     CHKERRQ(DMDestroy(&plex));
5510   }
5511   /* Compute boundary integrals */
5512   CHKERRQ(DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user));
5513   /* Assemble matrix */
5514   if (hasJac && hasPrec) {
5515     CHKERRQ(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));
5516     CHKERRQ(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));
5517   }
5518   CHKERRQ(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));
5519   CHKERRQ(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
5520   CHKERRQ(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     CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5558   CHKERRQ(ISGetLocalSize(cellIS, &numCells));
5559   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5560   CHKERRQ(DMConvert(dm, DMPLEX, &plex));
5561   CHKERRQ(DMGetSection(dm, &section));
5562   CHKERRQ(DMGetGlobalSection(dm, &globalSection));
5563   CHKERRQ(DMGetLabel(dm, "ghost", &ghostLabel));
5564   CHKERRQ(DMGetCellDS(dm, cStart, &ds));
5565   CHKERRQ(PetscDSGetNumFields(ds, &Nf));
5566   CHKERRQ(PetscDSGetTotalDimension(ds, &totDim));
5567   CHKERRQ(PetscDSHasBdJacobian(ds, &hasBdJac));
5568   CHKERRQ(PetscDSHasBdJacobianPreconditioner(ds, &hasBdPrec));
5569   CHKERRQ(DMGetAuxiliaryVec(dm, key[2].label, key[2].value, key[2].part, &locA[2]));
5570   if (locA[2]) {
5571     CHKERRQ(VecGetDM(locA[2], &dmAux[2]));
5572     CHKERRQ(DMConvert(dmAux[2], DMPLEX, &plexA));
5573     CHKERRQ(DMGetSection(dmAux[2], &sectionAux[2]));
5574     CHKERRQ(DMGetCellDS(dmAux[2], cStart, &dsAux[2]));
5575     CHKERRQ(PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]));
5576     {
5577       const PetscInt *cone;
5578       PetscInt        c;
5579 
5580       CHKERRQ(DMPlexGetCone(dm, cStart, &cone));
5581       for (c = 0; c < 2; ++c) {
5582         const PetscInt *support;
5583         PetscInt ssize, s;
5584 
5585         CHKERRQ(DMPlexGetSupport(dm, cone[c], &support));
5586         CHKERRQ(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         CHKERRQ(DMGetAuxiliaryVec(dm, key[c].label, key[c].value, key[c].part, &locA[c]));
5592         if (locA[c]) CHKERRQ(VecGetDM(locA[c], &dmAux[c]));
5593         else         {dmAux[c] = dmAux[2];}
5594         CHKERRQ(DMGetCellDS(dmAux[c], support[s], &dsAux[c]));
5595         CHKERRQ(PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]));
5596       }
5597     }
5598   }
5599   CHKERRQ(DMGetCoordinateField(dm, &coordField));
5600   CHKERRQ(DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree));
5601   if (maxDegree > 1) {
5602     PetscInt f;
5603     CHKERRQ(PetscCalloc2(Nf, &quads, Nf, &geoms));
5604     for (f = 0; f < Nf; ++f) {
5605       PetscFE fe;
5606 
5607       CHKERRQ(PetscDSGetDiscretization(ds, f, (PetscObject *) &fe));
5608       if (fe) {
5609         CHKERRQ(PetscFEGetQuadrature(fe, &quads[f]));
5610         CHKERRQ(PetscObjectReference((PetscObject) quads[f]));
5611       }
5612     }
5613   }
5614   cellChunkSize = numCells;
5615   numChunks     = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5616   CHKERRQ(PetscCalloc1(2*cellChunkSize, &faces));
5617   CHKERRQ(ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS));
5618   CHKERRQ(DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5619   CHKERRQ(DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a));
5620   CHKERRQ(DMGetWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat));
5621   CHKERRQ(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)  CHKERRQ(PetscMemzero(elemMat,  numCells*totDim*totDim * sizeof(PetscScalar)));
5626     if (hasBdPrec) CHKERRQ(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       CHKERRQ(DMPlexGetCone(plex, cell, &cone));
5632       faces[(c-cS)*2+0] = cone[0];
5633       faces[(c-cS)*2+1] = cone[1];
5634     }
5635     CHKERRQ(ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER));
5636     if (maxDegree <= 1) {
5637       if (!affineQuad) CHKERRQ(DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad));
5638       if (affineQuad)  CHKERRQ(DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom));
5639     } else {
5640       PetscInt f;
5641       for (f = 0; f < Nf; ++f) {
5642         if (quads[f]) CHKERRQ(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       CHKERRQ(PetscDSGetDiscretization(ds, fieldI, (PetscObject *) &feI));
5655       if (!feI) continue;
5656       CHKERRQ(PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches));
5657       CHKERRQ(PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL));
5658       CHKERRQ(PetscFEGetDimension(feI, &Nb));
5659       blockSize = Nb;
5660       batchSize = numBlocks * blockSize;
5661       CHKERRQ(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       CHKERRQ(PetscFEGeomGetChunk(geom,0,offset,&chunkGeom));
5667       CHKERRQ(PetscFEGeomGetChunk(geom,offset,numCells,&remGeom));
5668       CHKERRQ(PetscDSGetCohesive(ds, fieldI, &isCohesiveField));
5669       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5670         PetscFE feJ;
5671 
5672         CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMat));
5679           CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMat));
5681           CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[0], 0, Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMatP));
5685           CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[1], 1, Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMatP));
5687           CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMat));
5691           CHKERRQ(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           CHKERRQ(PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[2], 2, Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMatP));
5695           CHKERRQ(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       CHKERRQ(PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom));
5699       CHKERRQ(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) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5709           CHKERRQ(DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5710         }
5711         if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]));
5712         CHKERRQ(DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES));
5713       } else if (hasBdJac) {
5714         if (mesh->printFEM > 1) CHKERRQ(DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5715         CHKERRQ(DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES));
5716       }
5717     }
5718   }
5719   CHKERRQ(DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]));
5720   CHKERRQ(DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a));
5721   CHKERRQ(DMRestoreWorkArray(dm, hasBdJac  ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat));
5722   CHKERRQ(DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP));
5723   CHKERRQ(PetscFree(faces));
5724   CHKERRQ(ISDestroy(&chunkIS));
5725   CHKERRQ(ISRestorePointRange(cellIS, &cStart, &cEnd, &cells));
5726   if (maxDegree <= 1) {
5727     CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom));
5728     CHKERRQ(PetscQuadratureDestroy(&affineQuad));
5729   } else {
5730     PetscInt f;
5731     for (f = 0; f < Nf; ++f) {
5732       if (geoms) CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]));
5733       if (quads) CHKERRQ(PetscQuadratureDestroy(&quads[f]));
5734     }
5735     CHKERRQ(PetscFree2(quads,geoms));
5736   }
5737   if (dmAux[2]) CHKERRQ(DMDestroy(&plexA));
5738   CHKERRQ(DMDestroy(&plex));
5739   /* Assemble matrix */
5740   if (hasBdJac && hasBdPrec) {
5741     CHKERRQ(MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY));
5742     CHKERRQ(MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY));
5743   }
5744   CHKERRQ(MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY));
5745   CHKERRQ(MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY));
5746   CHKERRQ(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   CHKERRQ(PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0));
5790   CHKERRQ(DMConvert(dm, DMPLEX, &plex));
5791   if (!cellIS) {
5792     PetscInt depth;
5793 
5794     CHKERRQ(DMPlexGetDepth(plex, &depth));
5795     CHKERRQ(DMGetStratumIS(plex, "dim", depth, &cellIS));
5796     if (!cellIS) CHKERRQ(DMGetStratumIS(plex, "depth", depth, &cellIS));
5797   } else {
5798     CHKERRQ(PetscObjectReference((PetscObject) cellIS));
5799   }
5800   CHKERRQ(ISGetLocalSize(cellIS, &numCells));
5801   CHKERRQ(ISGetPointRange(cellIS, &cStart, &cEnd, &cells));
5802   CHKERRQ(DMGetLocalSection(dm, &section));
5803   CHKERRQ(DMGetGlobalSection(dm, &globalSection));
5804   CHKERRQ(DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob));
5805   CHKERRQ(PetscDSGetNumFields(prob, &Nf));
5806   CHKERRQ(PetscDSGetTotalDimension(prob, &totDim));
5807   CHKERRQ(PetscDSHasDynamicJacobian(prob, &hasDyn));
5808   hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5809   CHKERRQ(DMGetAuxiliaryVec(dm, key.label, key.value, key.part, &A));
5810   if (A) {
5811     CHKERRQ(VecGetDM(A, &dmAux));
5812     CHKERRQ(DMGetEnclosureRelation(dmAux, dm, &encAux));
5813     CHKERRQ(DMConvert(dmAux, DMPLEX, &plexAux));
5814     CHKERRQ(DMGetLocalSection(plexAux, &sectionAux));
5815     CHKERRQ(DMGetDS(dmAux, &probAux));
5816     CHKERRQ(PetscDSGetTotalDimension(probAux, &totDimAux));
5817   }
5818   CHKERRQ(VecSet(Z, 0.0));
5819   CHKERRQ(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) CHKERRQ(PetscMalloc1(numCells*totDimAux, &a));
5821   CHKERRQ(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     CHKERRQ(DMPlexVecGetClosure(plex, section, X, cell, NULL, &x));
5829     for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5830     CHKERRQ(DMPlexVecRestoreClosure(plex, section, X, cell, NULL, &x));
5831     if (X_t) {
5832       CHKERRQ(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       CHKERRQ(DMPlexVecRestoreClosure(plex, section, X_t, cell, NULL, &x_t));
5835     }
5836     if (dmAux) {
5837       PetscInt subcell;
5838       CHKERRQ(DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell));
5839       CHKERRQ(DMPlexVecGetClosure(plexAux, sectionAux, A, subcell, NULL, &x));
5840       for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5841       CHKERRQ(DMPlexVecRestoreClosure(plexAux, sectionAux, A, subcell, NULL, &x));
5842     }
5843     CHKERRQ(DMPlexVecGetClosure(plex, section, Y, cell, NULL, &x));
5844     for (i = 0; i < totDim; ++i) y[cind*totDim+i] = x[i];
5845     CHKERRQ(DMPlexVecRestoreClosure(plex, section, Y, cell, NULL, &x));
5846   }
5847   CHKERRQ(PetscArrayzero(elemMat, numCells*totDim*totDim));
5848   if (hasDyn)  CHKERRQ(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     CHKERRQ(PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe));
5861     CHKERRQ(PetscFEGetQuadrature(fe, &quad));
5862     CHKERRQ(PetscFEGetDimension(fe, &Nb));
5863     CHKERRQ(PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches));
5864     CHKERRQ(DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree));
5865     if (maxDegree <= 1) CHKERRQ(DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom));
5866     if (!qGeom) {
5867       CHKERRQ(PetscFEGetQuadrature(fe,&qGeom));
5868       CHKERRQ(PetscObjectReference((PetscObject)qGeom));
5869     }
5870     CHKERRQ(PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL));
5871     CHKERRQ(DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5872     blockSize = Nb;
5873     batchSize = numBlocks * blockSize;
5874     CHKERRQ(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     CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom));
5880     CHKERRQ(PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom));
5881     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5882       key.field = fieldI*Nf + fieldJ;
5883       CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat));
5884       CHKERRQ(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         CHKERRQ(PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD));
5887         CHKERRQ(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     CHKERRQ(PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom));
5891     CHKERRQ(PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom));
5892     CHKERRQ(DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM));
5893     CHKERRQ(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       CHKERRQ(DMPrintCellMatrix(c, name, totDim, totDim, &elemMat[cind*totDim*totDim]));
5907       CHKERRQ(DMPrintCellVector(c, "Y",  totDim, &y[cind*totDim]));
5908       CHKERRQ(DMPrintCellVector(c, "Z",  totDim, z));
5909     }
5910     CHKERRQ(DMPlexVecSetClosure(dm, section, Z, cell, z, ADD_VALUES));
5911   }
5912   CHKERRQ(PetscFree6(u,u_t,elemMat,elemMatD,y,z));
5913   if (mesh->printFEM) {
5914     CHKERRQ(PetscPrintf(PetscObjectComm((PetscObject)Z), "Z:\n"));
5915     CHKERRQ(VecView(Z, NULL));
5916   }
5917   CHKERRQ(PetscFree(a));
5918   CHKERRQ(ISDestroy(&cellIS));
5919   CHKERRQ(DMDestroy(&plexAux));
5920   CHKERRQ(DMDestroy(&plex));
5921   CHKERRQ(PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0));
5922   PetscFunctionReturn(0);
5923 }
5924