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