xref: /petsc/src/dm/impls/plex/plex.c (revision d06005cbea37256e14b0a9210dc34c4ed1410bfe)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petsc/private/isimpl.h>
3 #include <petsc/private/vecimpl.h>
4 #include <petsc/private/glvisvecimpl.h>
5 #include <petscsf.h>
6 #include <petscds.h>
7 #include <petscdraw.h>
8 #include <petscdmfield.h>
9 
10 /* Logging support */
11 PetscLogEvent DMPLEX_Interpolate, DMPLEX_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeOverlap, DMPLEX_DistributeField, DMPLEX_DistributeData, DMPLEX_Migrate, DMPLEX_InterpolateSF, DMPLEX_GlobalToNaturalBegin, DMPLEX_GlobalToNaturalEnd, DMPLEX_NaturalToGlobalBegin, DMPLEX_NaturalToGlobalEnd, DMPLEX_Stratify, DMPLEX_Symmetrize, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM, DMPLEX_InterpolatorFEM, DMPLEX_InjectorFEM, DMPLEX_IntegralFEM, DMPLEX_CreateGmsh, DMPLEX_RebalanceSharedPoints, DMPLEX_PartSelf, DMPLEX_PartLabelInvert, DMPLEX_PartLabelCreateSF, DMPLEX_PartStratSF, DMPLEX_CreatePointSF,DMPLEX_LocatePoints;
12 
13 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
14 
15 /*@
16   DMPlexGetSimplexOrBoxCells - Get the range of cells which are neither prisms nor ghost FV cells
17 
18   Input Parameter:
19 + dm     - The DMPlex object
20 - height - The cell height in the Plex, 0 is the default
21 
22   Output Parameters:
23 + cStart - The first "normal" cell
24 - cEnd   - The upper bound on "normal"" cells
25 
26   Note: This just gives the first range of cells found. If the mesh has several cell types, it will only give the first.
27 
28   Level: developer
29 
30 .seealso DMPlexConstructGhostCells(), DMPlexSetGhostCellStratum()
31 @*/
32 PetscErrorCode DMPlexGetSimplexOrBoxCells(DM dm, PetscInt height, PetscInt *cStart, PetscInt *cEnd)
33 {
34   DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
35   PetscInt       cS, cE, c;
36   PetscErrorCode ierr;
37 
38   PetscFunctionBegin;
39   ierr = DMPlexGetHeightStratum(dm, PetscMax(height, 0), &cS, &cE);CHKERRQ(ierr);
40   for (c = cS; c < cE; ++c) {
41     DMPolytopeType cct;
42 
43     ierr = DMPlexGetCellType(dm, c, &cct);CHKERRQ(ierr);
44     if ((PetscInt) cct < 0) break;
45     switch (cct) {
46       case DM_POLYTOPE_POINT:
47       case DM_POLYTOPE_SEGMENT:
48       case DM_POLYTOPE_TRIANGLE:
49       case DM_POLYTOPE_QUADRILATERAL:
50       case DM_POLYTOPE_TETRAHEDRON:
51       case DM_POLYTOPE_HEXAHEDRON:
52         ct = cct;
53         break;
54       default: break;
55     }
56     if (ct != DM_POLYTOPE_UNKNOWN) break;
57   }
58   if (ct != DM_POLYTOPE_UNKNOWN) {
59     DMLabel ctLabel;
60 
61     ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
62     ierr = DMLabelGetStratumBounds(ctLabel, ct, &cS, &cE);CHKERRQ(ierr);
63   }
64   if (cStart) *cStart = cS;
65   if (cEnd)   *cEnd   = cE;
66   PetscFunctionReturn(0);
67 }
68 
69 PetscErrorCode DMPlexGetFieldType_Internal(DM dm, PetscSection section, PetscInt field, PetscInt *sStart, PetscInt *sEnd, PetscViewerVTKFieldType *ft)
70 {
71   PetscInt       cdim, pStart, pEnd, vStart, vEnd, cStart, cEnd;
72   PetscInt       vcdof[2] = {0,0}, globalvcdof[2];
73   PetscErrorCode ierr;
74 
75   PetscFunctionBegin;
76   *ft  = PETSC_VTK_INVALID;
77   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
78   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
79   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
80   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
81   if (field >= 0) {
82     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, vStart, field, &vcdof[0]);CHKERRQ(ierr);}
83     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, cStart, field, &vcdof[1]);CHKERRQ(ierr);}
84   } else {
85     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vcdof[0]);CHKERRQ(ierr);}
86     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &vcdof[1]);CHKERRQ(ierr);}
87   }
88   ierr = MPI_Allreduce(vcdof, globalvcdof, 2, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
89   if (globalvcdof[0]) {
90     *sStart = vStart;
91     *sEnd   = vEnd;
92     if (globalvcdof[0] == cdim) *ft = PETSC_VTK_POINT_VECTOR_FIELD;
93     else                        *ft = PETSC_VTK_POINT_FIELD;
94   } else if (globalvcdof[1]) {
95     *sStart = cStart;
96     *sEnd   = cEnd;
97     if (globalvcdof[1] == cdim) *ft = PETSC_VTK_CELL_VECTOR_FIELD;
98     else                        *ft = PETSC_VTK_CELL_FIELD;
99   } else {
100     if (field >= 0) {
101       const char *fieldname;
102 
103       ierr = PetscSectionGetFieldName(section, field, &fieldname);CHKERRQ(ierr);
104       ierr = PetscInfo2((PetscObject) dm, "Could not classify VTK output type of section field %D \"%s\"\n", field, fieldname);CHKERRQ(ierr);
105     } else {
106       ierr = PetscInfo((PetscObject) dm, "Could not classify VTK output typp of section\"%s\"\n");CHKERRQ(ierr);
107     }
108   }
109   PetscFunctionReturn(0);
110 }
111 
112 static PetscErrorCode VecView_Plex_Local_Draw(Vec v, PetscViewer viewer)
113 {
114   DM                 dm;
115   PetscSection       s;
116   PetscDraw          draw, popup;
117   DM                 cdm;
118   PetscSection       coordSection;
119   Vec                coordinates;
120   const PetscScalar *coords, *array;
121   PetscReal          bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
122   PetscReal          vbound[2], time;
123   PetscBool          isnull, flg;
124   PetscInt           dim, Nf, f, Nc, comp, vStart, vEnd, cStart, cEnd, c, N, level, step, w = 0;
125   const char        *name;
126   char               title[PETSC_MAX_PATH_LEN];
127   PetscErrorCode     ierr;
128 
129   PetscFunctionBegin;
130   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
131   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
132   if (isnull) PetscFunctionReturn(0);
133 
134   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
135   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
136   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D. Use PETSCVIEWERGLVIS", dim);
137   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
138   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
139   ierr = DMGetCoarsenLevel(dm, &level);CHKERRQ(ierr);
140   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
141   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
142   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
143   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
144   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
145 
146   ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
147   ierr = DMGetOutputSequenceNumber(dm, &step, &time);CHKERRQ(ierr);
148 
149   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
150   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
151   for (c = 0; c < N; c += dim) {
152     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
153     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
154   }
155   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
156   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
157 
158   /* Could implement something like DMDASelectFields() */
159   for (f = 0; f < Nf; ++f) {
160     DM   fdm = dm;
161     Vec  fv  = v;
162     IS   fis;
163     char prefix[PETSC_MAX_PATH_LEN];
164     const char *fname;
165 
166     ierr = PetscSectionGetFieldComponents(s, f, &Nc);CHKERRQ(ierr);
167     ierr = PetscSectionGetFieldName(s, f, &fname);CHKERRQ(ierr);
168 
169     if (v->hdr.prefix) {ierr = PetscStrncpy(prefix, v->hdr.prefix,sizeof(prefix));CHKERRQ(ierr);}
170     else               {prefix[0] = '\0';}
171     if (Nf > 1) {
172       ierr = DMCreateSubDM(dm, 1, &f, &fis, &fdm);CHKERRQ(ierr);
173       ierr = VecGetSubVector(v, fis, &fv);CHKERRQ(ierr);
174       ierr = PetscStrlcat(prefix, fname,sizeof(prefix));CHKERRQ(ierr);
175       ierr = PetscStrlcat(prefix, "_",sizeof(prefix));CHKERRQ(ierr);
176     }
177     for (comp = 0; comp < Nc; ++comp, ++w) {
178       PetscInt nmax = 2;
179 
180       ierr = PetscViewerDrawGetDraw(viewer, w, &draw);CHKERRQ(ierr);
181       if (Nc > 1) {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s_%D Step: %D Time: %.4g", name, fname, comp, step, time);CHKERRQ(ierr);}
182       else        {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s Step: %D Time: %.4g", name, fname, step, time);CHKERRQ(ierr);}
183       ierr = PetscDrawSetTitle(draw, title);CHKERRQ(ierr);
184 
185       /* TODO Get max and min only for this component */
186       ierr = PetscOptionsGetRealArray(NULL, prefix, "-vec_view_bounds", vbound, &nmax, &flg);CHKERRQ(ierr);
187       if (!flg) {
188         ierr = VecMin(fv, NULL, &vbound[0]);CHKERRQ(ierr);
189         ierr = VecMax(fv, NULL, &vbound[1]);CHKERRQ(ierr);
190         if (vbound[1] <= vbound[0]) vbound[1] = vbound[0] + 1.0;
191       }
192       ierr = PetscDrawGetPopup(draw, &popup);CHKERRQ(ierr);
193       ierr = PetscDrawScalePopup(popup, vbound[0], vbound[1]);CHKERRQ(ierr);
194       ierr = PetscDrawSetCoordinates(draw, bound[0], bound[1], bound[2], bound[3]);CHKERRQ(ierr);
195 
196       ierr = VecGetArrayRead(fv, &array);CHKERRQ(ierr);
197       for (c = cStart; c < cEnd; ++c) {
198         PetscScalar *coords = NULL, *a = NULL;
199         PetscInt     numCoords, color[4] = {-1,-1,-1,-1};
200 
201         ierr = DMPlexPointLocalRead(fdm, c, array, &a);CHKERRQ(ierr);
202         if (a) {
203           color[0] = PetscDrawRealToColor(PetscRealPart(a[comp]), vbound[0], vbound[1]);
204           color[1] = color[2] = color[3] = color[0];
205         } else {
206           PetscScalar *vals = NULL;
207           PetscInt     numVals, va;
208 
209           ierr = DMPlexVecGetClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
210           if (numVals % Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of components %D does not divide the number of values in the closure %D", Nc, numVals);
211           switch (numVals/Nc) {
212           case 3: /* P1 Triangle */
213           case 4: /* P1 Quadrangle */
214             for (va = 0; va < numVals/Nc; ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp]), vbound[0], vbound[1]);
215             break;
216           case 6: /* P2 Triangle */
217           case 8: /* P2 Quadrangle */
218             for (va = 0; va < numVals/(Nc*2); ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp + numVals/(Nc*2)]), vbound[0], vbound[1]);
219             break;
220           default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of values for cell closure %D cannot be handled", numVals/Nc);
221           }
222           ierr = DMPlexVecRestoreClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
223         }
224         ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
225         switch (numCoords) {
226         case 6:
227           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), color[0], color[1], color[2]);CHKERRQ(ierr);
228           break;
229         case 8:
230           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), color[0], color[1], color[2]);CHKERRQ(ierr);
231           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), color[2], color[3], color[0]);CHKERRQ(ierr);
232           break;
233         default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells with %D coordinates", numCoords);
234         }
235         ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
236       }
237       ierr = VecRestoreArrayRead(fv, &array);CHKERRQ(ierr);
238       ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
239       ierr = PetscDrawPause(draw);CHKERRQ(ierr);
240       ierr = PetscDrawSave(draw);CHKERRQ(ierr);
241     }
242     if (Nf > 1) {
243       ierr = VecRestoreSubVector(v, fis, &fv);CHKERRQ(ierr);
244       ierr = ISDestroy(&fis);CHKERRQ(ierr);
245       ierr = DMDestroy(&fdm);CHKERRQ(ierr);
246     }
247   }
248   PetscFunctionReturn(0);
249 }
250 
251 static PetscErrorCode VecView_Plex_Local_VTK(Vec v, PetscViewer viewer)
252 {
253   DM                      dm;
254   Vec                     locv;
255   const char              *name;
256   PetscSection            section;
257   PetscInt                pStart, pEnd;
258   PetscInt                numFields;
259   PetscViewerVTKFieldType ft;
260   PetscErrorCode          ierr;
261 
262   PetscFunctionBegin;
263   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
264   ierr = DMCreateLocalVector(dm, &locv);CHKERRQ(ierr); /* VTK viewer requires exclusive ownership of the vector */
265   ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
266   ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
267   ierr = VecCopy(v, locv);CHKERRQ(ierr);
268   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
269   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
270   if (!numFields) {
271     ierr = DMPlexGetFieldType_Internal(dm, section, PETSC_DETERMINE, &pStart, &pEnd, &ft);CHKERRQ(ierr);
272     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, PETSC_DEFAULT, ft, PETSC_TRUE,(PetscObject) locv);CHKERRQ(ierr);
273   } else {
274     PetscInt f;
275 
276     for (f = 0; f < numFields; f++) {
277       ierr = DMPlexGetFieldType_Internal(dm, section, f, &pStart, &pEnd, &ft);CHKERRQ(ierr);
278       if (ft == PETSC_VTK_INVALID) continue;
279       ierr = PetscObjectReference((PetscObject)locv);CHKERRQ(ierr);
280       ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, f, ft, PETSC_TRUE,(PetscObject) locv);CHKERRQ(ierr);
281     }
282     ierr = VecDestroy(&locv);CHKERRQ(ierr);
283   }
284   PetscFunctionReturn(0);
285 }
286 
287 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
288 {
289   DM             dm;
290   PetscBool      isvtk, ishdf5, isdraw, isglvis;
291   PetscErrorCode ierr;
292 
293   PetscFunctionBegin;
294   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
295   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
296   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
297   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
298   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,  &isdraw);CHKERRQ(ierr);
299   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS, &isglvis);CHKERRQ(ierr);
300   if (isvtk || ishdf5 || isdraw || isglvis) {
301     PetscInt    i,numFields;
302     PetscObject fe;
303     PetscBool   fem = PETSC_FALSE;
304     Vec         locv = v;
305     const char  *name;
306     PetscInt    step;
307     PetscReal   time;
308 
309     ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
310     for (i=0; i<numFields; i++) {
311       ierr = DMGetField(dm, i, NULL, &fe);CHKERRQ(ierr);
312       if (fe->classid == PETSCFE_CLASSID) { fem = PETSC_TRUE; break; }
313     }
314     if (fem) {
315       PetscObject isZero;
316 
317       ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
318       ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
319       ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
320       ierr = PetscObjectQuery((PetscObject) v, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
321       ierr = PetscObjectCompose((PetscObject) locv, "__Vec_bc_zero__", isZero);CHKERRQ(ierr);
322       ierr = VecCopy(v, locv);CHKERRQ(ierr);
323       ierr = DMGetOutputSequenceNumber(dm, NULL, &time);CHKERRQ(ierr);
324       ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locv, time, NULL, NULL, NULL);CHKERRQ(ierr);
325     }
326     if (isvtk) {
327       ierr = VecView_Plex_Local_VTK(locv, viewer);CHKERRQ(ierr);
328     } else if (ishdf5) {
329 #if defined(PETSC_HAVE_HDF5)
330       ierr = VecView_Plex_Local_HDF5_Internal(locv, viewer);CHKERRQ(ierr);
331 #else
332       SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
333 #endif
334     } else if (isdraw) {
335       ierr = VecView_Plex_Local_Draw(locv, viewer);CHKERRQ(ierr);
336     } else if (isglvis) {
337       ierr = DMGetOutputSequenceNumber(dm, &step, NULL);CHKERRQ(ierr);
338       ierr = PetscViewerGLVisSetSnapId(viewer, step);CHKERRQ(ierr);
339       ierr = VecView_GLVis(locv, viewer);CHKERRQ(ierr);
340     }
341     if (fem) {
342       ierr = PetscObjectCompose((PetscObject) locv, "__Vec_bc_zero__", NULL);CHKERRQ(ierr);
343       ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
344     }
345   } else {
346     PetscBool isseq;
347 
348     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
349     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
350     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
351   }
352   PetscFunctionReturn(0);
353 }
354 
355 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
356 {
357   DM             dm;
358   PetscBool      isvtk, ishdf5, isdraw, isglvis;
359   PetscErrorCode ierr;
360 
361   PetscFunctionBegin;
362   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
363   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
364   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
365   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
366   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,  &isdraw);CHKERRQ(ierr);
367   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS, &isglvis);CHKERRQ(ierr);
368   if (isvtk || isdraw || isglvis) {
369     Vec         locv;
370     PetscObject isZero;
371     const char *name;
372 
373     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
374     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
375     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
376     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
377     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
378     ierr = PetscObjectQuery((PetscObject) v, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
379     ierr = PetscObjectCompose((PetscObject) locv, "__Vec_bc_zero__", isZero);CHKERRQ(ierr);
380     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
381     ierr = PetscObjectCompose((PetscObject) locv, "__Vec_bc_zero__", NULL);CHKERRQ(ierr);
382     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
383   } else if (ishdf5) {
384 #if defined(PETSC_HAVE_HDF5)
385     ierr = VecView_Plex_HDF5_Internal(v, viewer);CHKERRQ(ierr);
386 #else
387     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
388 #endif
389   } else {
390     PetscBool isseq;
391 
392     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
393     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
394     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
395   }
396   PetscFunctionReturn(0);
397 }
398 
399 PetscErrorCode VecView_Plex_Native(Vec originalv, PetscViewer viewer)
400 {
401   DM                dm;
402   MPI_Comm          comm;
403   PetscViewerFormat format;
404   Vec               v;
405   PetscBool         isvtk, ishdf5;
406   PetscErrorCode    ierr;
407 
408   PetscFunctionBegin;
409   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
410   ierr = PetscObjectGetComm((PetscObject) originalv, &comm);CHKERRQ(ierr);
411   if (!dm) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
412   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
413   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
414   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
415   if (format == PETSC_VIEWER_NATIVE) {
416     /* Natural ordering is the common case for DMDA, NATIVE means plain vector, for PLEX is the opposite */
417     /* this need a better fix */
418     if (dm->useNatural) {
419       if (dm->sfNatural) {
420         const char *vecname;
421         PetscInt    n, nroots;
422 
423         ierr = VecGetLocalSize(originalv, &n);CHKERRQ(ierr);
424         ierr = PetscSFGetGraph(dm->sfNatural, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
425         if (n == nroots) {
426           ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
427           ierr = DMPlexGlobalToNaturalBegin(dm, originalv, v);CHKERRQ(ierr);
428           ierr = DMPlexGlobalToNaturalEnd(dm, originalv, v);CHKERRQ(ierr);
429           ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
430           ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
431         } else SETERRQ(comm, PETSC_ERR_ARG_WRONG, "DM global to natural SF only handles global vectors");
432       } else SETERRQ(comm, PETSC_ERR_ARG_WRONGSTATE, "DM global to natural SF was not created");
433     } else v = originalv;
434   } else v = originalv;
435 
436   if (ishdf5) {
437 #if defined(PETSC_HAVE_HDF5)
438     ierr = VecView_Plex_HDF5_Native_Internal(v, viewer);CHKERRQ(ierr);
439 #else
440     SETERRQ(comm, PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
441 #endif
442   } else if (isvtk) {
443     SETERRQ(comm, PETSC_ERR_SUP, "VTK format does not support viewing in natural order. Please switch to HDF5.");
444   } else {
445     PetscBool isseq;
446 
447     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
448     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
449     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
450   }
451   if (v != originalv) {ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);}
452   PetscFunctionReturn(0);
453 }
454 
455 PetscErrorCode VecLoad_Plex_Local(Vec v, PetscViewer viewer)
456 {
457   DM             dm;
458   PetscBool      ishdf5;
459   PetscErrorCode ierr;
460 
461   PetscFunctionBegin;
462   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
463   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
464   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
465   if (ishdf5) {
466     DM          dmBC;
467     Vec         gv;
468     const char *name;
469 
470     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
471     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
472     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
473     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
474     ierr = VecLoad_Default(gv, viewer);CHKERRQ(ierr);
475     ierr = DMGlobalToLocalBegin(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
476     ierr = DMGlobalToLocalEnd(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
477     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
478   } else {
479     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
480   }
481   PetscFunctionReturn(0);
482 }
483 
484 PetscErrorCode VecLoad_Plex(Vec v, PetscViewer viewer)
485 {
486   DM             dm;
487   PetscBool      ishdf5;
488   PetscErrorCode ierr;
489 
490   PetscFunctionBegin;
491   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
492   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
493   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
494   if (ishdf5) {
495 #if defined(PETSC_HAVE_HDF5)
496     ierr = VecLoad_Plex_HDF5_Internal(v, viewer);CHKERRQ(ierr);
497 #else
498     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
499 #endif
500   } else {
501     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
502   }
503   PetscFunctionReturn(0);
504 }
505 
506 PetscErrorCode VecLoad_Plex_Native(Vec originalv, PetscViewer viewer)
507 {
508   DM                dm;
509   PetscViewerFormat format;
510   PetscBool         ishdf5;
511   PetscErrorCode    ierr;
512 
513   PetscFunctionBegin;
514   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
515   if (!dm) SETERRQ(PetscObjectComm((PetscObject) originalv), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
516   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
517   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
518   if (format == PETSC_VIEWER_NATIVE) {
519     if (dm->useNatural) {
520       if (dm->sfNatural) {
521         if (ishdf5) {
522 #if defined(PETSC_HAVE_HDF5)
523           Vec         v;
524           const char *vecname;
525 
526           ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
527           ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
528           ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
529           ierr = VecLoad_Plex_HDF5_Native_Internal(v, viewer);CHKERRQ(ierr);
530           ierr = DMPlexNaturalToGlobalBegin(dm, v, originalv);CHKERRQ(ierr);
531           ierr = DMPlexNaturalToGlobalEnd(dm, v, originalv);CHKERRQ(ierr);
532           ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
533 #else
534           SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
535 #endif
536         } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Reading in natural order is not supported for anything but HDF5.");
537       }
538     } else {
539       ierr = VecLoad_Default(originalv, viewer);CHKERRQ(ierr);
540     }
541   }
542   PetscFunctionReturn(0);
543 }
544 
545 PETSC_UNUSED static PetscErrorCode DMPlexView_Ascii_Geometry(DM dm, PetscViewer viewer)
546 {
547   PetscSection       coordSection;
548   Vec                coordinates;
549   DMLabel            depthLabel, celltypeLabel;
550   const char        *name[4];
551   const PetscScalar *a;
552   PetscInt           dim, pStart, pEnd, cStart, cEnd, c;
553   PetscErrorCode     ierr;
554 
555   PetscFunctionBegin;
556   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
557   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
558   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
559   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
560   ierr = DMPlexGetCellTypeLabel(dm, &celltypeLabel);CHKERRQ(ierr);
561   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
562   ierr = PetscSectionGetChart(coordSection, &pStart, &pEnd);CHKERRQ(ierr);
563   ierr = VecGetArrayRead(coordinates, &a);CHKERRQ(ierr);
564   name[0]     = "vertex";
565   name[1]     = "edge";
566   name[dim-1] = "face";
567   name[dim]   = "cell";
568   for (c = cStart; c < cEnd; ++c) {
569     PetscInt *closure = NULL;
570     PetscInt  closureSize, cl, ct;
571 
572     ierr = DMLabelGetValue(celltypeLabel, c, &ct);CHKERRQ(ierr);
573     ierr = PetscViewerASCIIPrintf(viewer, "Geometry for cell %D polytope type %s:\n", c, DMPolytopeTypes[ct]);CHKERRQ(ierr);
574     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
575     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
576     for (cl = 0; cl < closureSize*2; cl += 2) {
577       PetscInt point = closure[cl], depth, dof, off, d, p;
578 
579       if ((point < pStart) || (point >= pEnd)) continue;
580       ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
581       if (!dof) continue;
582       ierr = DMLabelGetValue(depthLabel, point, &depth);CHKERRQ(ierr);
583       ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
584       ierr = PetscViewerASCIIPrintf(viewer, "%s %D coords:", name[depth], point);CHKERRQ(ierr);
585       for (p = 0; p < dof/dim; ++p) {
586         ierr = PetscViewerASCIIPrintf(viewer, " (");CHKERRQ(ierr);
587         for (d = 0; d < dim; ++d) {
588           if (d > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
589           ierr = PetscViewerASCIIPrintf(viewer, "%g", (double) PetscRealPart(a[off+p*dim+d]));CHKERRQ(ierr);
590         }
591         ierr = PetscViewerASCIIPrintf(viewer, ")");CHKERRQ(ierr);
592       }
593       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
594     }
595     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
596     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
597   }
598   ierr = VecRestoreArrayRead(coordinates, &a);CHKERRQ(ierr);
599   PetscFunctionReturn(0);
600 }
601 
602 static PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
603 {
604   DM_Plex          *mesh = (DM_Plex*) dm->data;
605   DM                cdm;
606   DMLabel           markers, celltypes;
607   PetscSection      coordSection;
608   Vec               coordinates;
609   PetscViewerFormat format;
610   PetscErrorCode    ierr;
611 
612   PetscFunctionBegin;
613   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
614   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
615   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
616   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
617   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
618     const char *name;
619     PetscInt    dim, cellHeight, maxConeSize, maxSupportSize;
620     PetscInt    pStart, pEnd, p;
621     PetscMPIInt rank, size;
622 
623     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRMPI(ierr);
624     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRMPI(ierr);
625     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
626     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
627     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
628     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
629     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
630     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimension%s:\n", name, dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
631     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimension%s:\n", dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
632     if (cellHeight) {ierr = PetscViewerASCIIPrintf(viewer, "  Cells are at height %D\n", cellHeight);CHKERRQ(ierr);}
633     ierr = PetscViewerASCIIPrintf(viewer, "Supports:\n", name);CHKERRQ(ierr);
634     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
635     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d] Max support size: %D\n", rank, maxSupportSize);CHKERRQ(ierr);
636     for (p = pStart; p < pEnd; ++p) {
637       PetscInt dof, off, s;
638 
639       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
640       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
641       for (s = off; s < off+dof; ++s) {
642         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
643       }
644     }
645     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
646     ierr = PetscViewerASCIIPrintf(viewer, "Cones:\n", name);CHKERRQ(ierr);
647     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d] Max cone size: %D\n", rank, maxConeSize);CHKERRQ(ierr);
648     for (p = pStart; p < pEnd; ++p) {
649       PetscInt dof, off, c;
650 
651       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
652       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
653       for (c = off; c < off+dof; ++c) {
654         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
655       }
656     }
657     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
658     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
659     if (coordSection && coordinates) {
660       ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);
661     }
662     ierr = DMGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
663     if (markers) {ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);}
664     ierr = DMPlexGetCellTypeLabel(dm, &celltypes);CHKERRQ(ierr);
665     if (celltypes) {ierr = DMLabelView(celltypes, viewer);CHKERRQ(ierr);}
666     if (size > 1) {
667       PetscSF sf;
668 
669       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
670       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
671     }
672     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
673   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
674     const char  *name, *color;
675     const char  *defcolors[3]  = {"gray", "orange", "green"};
676     const char  *deflcolors[4] = {"blue", "cyan", "red", "magenta"};
677     char         lname[PETSC_MAX_PATH_LEN];
678     PetscReal    scale         = 2.0;
679     PetscReal    tikzscale     = 1.0;
680     PetscBool    useNumbers    = PETSC_TRUE, useLabels, useColors;
681     double       tcoords[3];
682     PetscScalar *coords;
683     PetscInt     numLabels, l, numColors, numLColors, dim, depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
684     PetscMPIInt  rank, size;
685     char         **names, **colors, **lcolors;
686     PetscBool    plotEdges, flg, lflg;
687     PetscBT      wp = NULL;
688     PetscInt     pEnd, pStart;
689 
690     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
691     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
692     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
693     numLabels  = PetscMax(numLabels, 10);
694     numColors  = 10;
695     numLColors = 10;
696     ierr = PetscCalloc3(numLabels, &names, numColors, &colors, numLColors, &lcolors);CHKERRQ(ierr);
697     ierr = PetscOptionsGetReal(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_scale", &scale, NULL);CHKERRQ(ierr);
698     ierr = PetscOptionsGetReal(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_tikzscale", &tikzscale, NULL);CHKERRQ(ierr);
699     ierr = PetscOptionsGetBool(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_numbers", &useNumbers, NULL);CHKERRQ(ierr);
700     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_labels", names, &numLabels, &useLabels);CHKERRQ(ierr);
701     if (!useLabels) numLabels = 0;
702     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_colors", colors, &numColors, &useColors);CHKERRQ(ierr);
703     if (!useColors) {
704       numColors = 3;
705       for (c = 0; c < numColors; ++c) {ierr = PetscStrallocpy(defcolors[c], &colors[c]);CHKERRQ(ierr);}
706     }
707     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_lcolors", lcolors, &numLColors, &useColors);CHKERRQ(ierr);
708     if (!useColors) {
709       numLColors = 4;
710       for (c = 0; c < numLColors; ++c) {ierr = PetscStrallocpy(deflcolors[c], &lcolors[c]);CHKERRQ(ierr);}
711     }
712     ierr = PetscOptionsGetString(((PetscObject) viewer)->options, ((PetscObject) viewer)->prefix, "-dm_plex_view_label_filter", lname, sizeof(lname), &lflg);CHKERRQ(ierr);
713     plotEdges = (PetscBool)(depth > 1 && useNumbers && dim < 3);
714     ierr = PetscOptionsGetBool(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_edges", &plotEdges, &flg);CHKERRQ(ierr);
715     if (flg && plotEdges && depth < dim) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Mesh must be interpolated");
716     if (depth < dim) plotEdges = PETSC_FALSE;
717 
718     /* filter points with labelvalue != labeldefaultvalue */
719     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
720     if (lflg) {
721       DMLabel lbl;
722 
723       ierr = DMGetLabel(dm, lname, &lbl);CHKERRQ(ierr);
724       if (lbl) {
725         PetscInt val, defval;
726 
727         ierr = DMLabelGetDefaultValue(lbl, &defval);CHKERRQ(ierr);
728         ierr = PetscBTCreate(pEnd-pStart, &wp);CHKERRQ(ierr);
729         for (c = pStart;  c < pEnd; c++) {
730           PetscInt *closure = NULL;
731           PetscInt  closureSize;
732 
733           ierr = DMLabelGetValue(lbl, c, &val);CHKERRQ(ierr);
734           if (val == defval) continue;
735 
736           ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
737           for (p = 0; p < closureSize*2; p += 2) {
738             ierr = PetscBTSet(wp, closure[p] - pStart);CHKERRQ(ierr);
739           }
740           ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
741         }
742       }
743     }
744 
745     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRMPI(ierr);
746     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRMPI(ierr);
747     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
748     ierr = PetscViewerASCIIPrintf(viewer, "\
749 \\documentclass[tikz]{standalone}\n\n\
750 \\usepackage{pgflibraryshapes}\n\
751 \\usetikzlibrary{backgrounds}\n\
752 \\usetikzlibrary{arrows}\n\
753 \\begin{document}\n");CHKERRQ(ierr);
754     if (size > 1) {
755       ierr = PetscViewerASCIIPrintf(viewer, "%s for process ", name);CHKERRQ(ierr);
756       for (p = 0; p < size; ++p) {
757         if (p > 0 && p == size-1) {
758           ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
759         } else if (p > 0) {
760           ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
761         }
762         ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
763       }
764       ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n");CHKERRQ(ierr);
765     }
766     ierr = PetscViewerASCIIPrintf(viewer, "\\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n", (double) tikzscale);CHKERRQ(ierr);
767 
768     /* Plot vertices */
769     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
770     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
771     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
772     for (v = vStart; v < vEnd; ++v) {
773       PetscInt  off, dof, d;
774       PetscBool isLabeled = PETSC_FALSE;
775 
776       if (wp && !PetscBTLookup(wp,v - pStart)) continue;
777       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
778       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
779       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
780       if (PetscUnlikely(dof > 3)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"coordSection vertex %D has dof %D > 3",v,dof);
781       for (d = 0; d < dof; ++d) {
782         tcoords[d] = (double) (scale*PetscRealPart(coords[off+d]));
783         tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
784       }
785       /* Rotate coordinates since PGF makes z point out of the page instead of up */
786       if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
787       for (d = 0; d < dof; ++d) {
788         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
789         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double) tcoords[d]);CHKERRQ(ierr);
790       }
791       color = colors[rank%numColors];
792       for (l = 0; l < numLabels; ++l) {
793         PetscInt val;
794         ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
795         if (val >= 0) {color = lcolors[l%numLColors]; isLabeled = PETSC_TRUE; break;}
796       }
797       if (useNumbers) {
798         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D};\n", v, rank, color, v);CHKERRQ(ierr);
799       } else {
800         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [fill,inner sep=%dpt,shape=circle,color=%s] {};\n", v, rank, !isLabeled ? 1 : 2, color);CHKERRQ(ierr);
801       }
802     }
803     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
804     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
805     /* Plot cells */
806     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
807     ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
808     if (dim == 3 || !useNumbers) {
809       for (e = eStart; e < eEnd; ++e) {
810         const PetscInt *cone;
811 
812         if (wp && !PetscBTLookup(wp,e - pStart)) continue;
813         color = colors[rank%numColors];
814         for (l = 0; l < numLabels; ++l) {
815           PetscInt val;
816           ierr = DMGetLabelValue(dm, names[l], e, &val);CHKERRQ(ierr);
817           if (val >= 0) {color = lcolors[l%numLColors]; break;}
818         }
819         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
820         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] (%D_%d) -- (%D_%d);\n", color, cone[0], rank, cone[1], rank);CHKERRQ(ierr);
821       }
822     } else {
823       for (c = cStart; c < cEnd; ++c) {
824         PetscInt *closure = NULL;
825         PetscInt  closureSize, firstPoint = -1;
826 
827         if (wp && !PetscBTLookup(wp,c - pStart)) continue;
828         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
829         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
830         for (p = 0; p < closureSize*2; p += 2) {
831           const PetscInt point = closure[p];
832 
833           if ((point < vStart) || (point >= vEnd)) continue;
834           if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
835           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%d)", point, rank);CHKERRQ(ierr);
836           if (firstPoint < 0) firstPoint = point;
837         }
838         /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
839         ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%d);\n", firstPoint, rank);CHKERRQ(ierr);
840         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
841       }
842     }
843     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
844     for (c = cStart; c < cEnd; ++c) {
845       double    ccoords[3] = {0.0, 0.0, 0.0};
846       PetscBool isLabeled  = PETSC_FALSE;
847       PetscInt *closure    = NULL;
848       PetscInt  closureSize, dof, d, n = 0;
849 
850       if (wp && !PetscBTLookup(wp,c - pStart)) continue;
851       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
852       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
853       for (p = 0; p < closureSize*2; p += 2) {
854         const PetscInt point = closure[p];
855         PetscInt       off;
856 
857         if ((point < vStart) || (point >= vEnd)) continue;
858         ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
859         ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
860         for (d = 0; d < dof; ++d) {
861           tcoords[d] = (double) (scale*PetscRealPart(coords[off+d]));
862           tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
863         }
864         /* Rotate coordinates since PGF makes z point out of the page instead of up */
865         if (dof == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
866         for (d = 0; d < dof; ++d) {ccoords[d] += tcoords[d];}
867         ++n;
868       }
869       for (d = 0; d < dof; ++d) {ccoords[d] /= n;}
870       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
871       for (d = 0; d < dof; ++d) {
872         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
873         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double) ccoords[d]);CHKERRQ(ierr);
874       }
875       color = colors[rank%numColors];
876       for (l = 0; l < numLabels; ++l) {
877         PetscInt val;
878         ierr = DMGetLabelValue(dm, names[l], c, &val);CHKERRQ(ierr);
879         if (val >= 0) {color = lcolors[l%numLColors]; isLabeled = PETSC_TRUE; break;}
880       }
881       if (useNumbers) {
882         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D};\n", c, rank, color, c);CHKERRQ(ierr);
883       } else {
884         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [fill,inner sep=%dpt,shape=circle,color=%s] {};\n", c, rank, !isLabeled ? 1 : 2, color);CHKERRQ(ierr);
885       }
886     }
887     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
888     /* Plot edges */
889     if (plotEdges) {
890       ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
891       ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
892       for (e = eStart; e < eEnd; ++e) {
893         const PetscInt *cone;
894         PetscInt        coneSize, offA, offB, dof, d;
895 
896         if (wp && !PetscBTLookup(wp,e - pStart)) continue;
897         ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
898         if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %D cone should have two vertices, not %D", e, coneSize);
899         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
900         ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
901         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
902         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
903         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
904         for (d = 0; d < dof; ++d) {
905           tcoords[d] = (double) (0.5*scale*PetscRealPart(coords[offA+d]+coords[offB+d]));
906           tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
907         }
908         /* Rotate coordinates since PGF makes z point out of the page instead of up */
909         if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
910         for (d = 0; d < dof; ++d) {
911           if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
912           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)tcoords[d]);CHKERRQ(ierr);
913         }
914         color = colors[rank%numColors];
915         for (l = 0; l < numLabels; ++l) {
916           PetscInt val;
917           ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
918           if (val >= 0) {color = lcolors[l%numLColors]; break;}
919         }
920         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D} --\n", e, rank, color, e);CHKERRQ(ierr);
921       }
922       ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
923       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
924       ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
925     }
926     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
927     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
928     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n");CHKERRQ(ierr);
929     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
930     for (l = 0; l < numLabels;  ++l) {ierr = PetscFree(names[l]);CHKERRQ(ierr);}
931     for (c = 0; c < numColors;  ++c) {ierr = PetscFree(colors[c]);CHKERRQ(ierr);}
932     for (c = 0; c < numLColors; ++c) {ierr = PetscFree(lcolors[c]);CHKERRQ(ierr);}
933     ierr = PetscFree3(names, colors, lcolors);CHKERRQ(ierr);
934     ierr = PetscBTDestroy(&wp);CHKERRQ(ierr);
935   } else if (format == PETSC_VIEWER_LOAD_BALANCE) {
936     Vec                    cown,acown;
937     VecScatter             sct;
938     ISLocalToGlobalMapping g2l;
939     IS                     gid,acis;
940     MPI_Comm               comm,ncomm = MPI_COMM_NULL;
941     MPI_Group              ggroup,ngroup;
942     PetscScalar            *array,nid;
943     const PetscInt         *idxs;
944     PetscInt               *idxs2,*start,*adjacency,*work;
945     PetscInt64             lm[3],gm[3];
946     PetscInt               i,c,cStart,cEnd,cum,numVertices,ect,ectn,cellHeight;
947     PetscMPIInt            d1,d2,rank;
948 
949     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
950     ierr = MPI_Comm_rank(comm,&rank);CHKERRMPI(ierr);
951 #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
952     ierr = MPI_Comm_split_type(comm,MPI_COMM_TYPE_SHARED,rank,MPI_INFO_NULL,&ncomm);CHKERRMPI(ierr);
953 #endif
954     if (ncomm != MPI_COMM_NULL) {
955       ierr = MPI_Comm_group(comm,&ggroup);CHKERRMPI(ierr);
956       ierr = MPI_Comm_group(ncomm,&ngroup);CHKERRMPI(ierr);
957       d1   = 0;
958       ierr = MPI_Group_translate_ranks(ngroup,1,&d1,ggroup,&d2);CHKERRMPI(ierr);
959       nid  = d2;
960       ierr = MPI_Group_free(&ggroup);CHKERRMPI(ierr);
961       ierr = MPI_Group_free(&ngroup);CHKERRMPI(ierr);
962       ierr = MPI_Comm_free(&ncomm);CHKERRMPI(ierr);
963     } else nid = 0.0;
964 
965     /* Get connectivity */
966     ierr = DMPlexGetVTKCellHeight(dm,&cellHeight);CHKERRQ(ierr);
967     ierr = DMPlexCreatePartitionerGraph(dm,cellHeight,&numVertices,&start,&adjacency,&gid);CHKERRQ(ierr);
968 
969     /* filter overlapped local cells */
970     ierr = DMPlexGetHeightStratum(dm,cellHeight,&cStart,&cEnd);CHKERRQ(ierr);
971     ierr = ISGetIndices(gid,&idxs);CHKERRQ(ierr);
972     ierr = ISGetLocalSize(gid,&cum);CHKERRQ(ierr);
973     ierr = PetscMalloc1(cum,&idxs2);CHKERRQ(ierr);
974     for (c = cStart, cum = 0; c < cEnd; c++) {
975       if (idxs[c-cStart] < 0) continue;
976       idxs2[cum++] = idxs[c-cStart];
977     }
978     ierr = ISRestoreIndices(gid,&idxs);CHKERRQ(ierr);
979     if (numVertices != cum) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected %D != %D",numVertices,cum);
980     ierr = ISDestroy(&gid);CHKERRQ(ierr);
981     ierr = ISCreateGeneral(comm,numVertices,idxs2,PETSC_OWN_POINTER,&gid);CHKERRQ(ierr);
982 
983     /* support for node-aware cell locality */
984     ierr = ISCreateGeneral(comm,start[numVertices],adjacency,PETSC_USE_POINTER,&acis);CHKERRQ(ierr);
985     ierr = VecCreateSeq(PETSC_COMM_SELF,start[numVertices],&acown);CHKERRQ(ierr);
986     ierr = VecCreateMPI(comm,numVertices,PETSC_DECIDE,&cown);CHKERRQ(ierr);
987     ierr = VecGetArray(cown,&array);CHKERRQ(ierr);
988     for (c = 0; c < numVertices; c++) array[c] = nid;
989     ierr = VecRestoreArray(cown,&array);CHKERRQ(ierr);
990     ierr = VecScatterCreate(cown,acis,acown,NULL,&sct);CHKERRQ(ierr);
991     ierr = VecScatterBegin(sct,cown,acown,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
992     ierr = VecScatterEnd(sct,cown,acown,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
993     ierr = ISDestroy(&acis);CHKERRQ(ierr);
994     ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
995     ierr = VecDestroy(&cown);CHKERRQ(ierr);
996 
997     /* compute edgeCut */
998     for (c = 0, cum = 0; c < numVertices; c++) cum = PetscMax(cum,start[c+1]-start[c]);
999     ierr = PetscMalloc1(cum,&work);CHKERRQ(ierr);
1000     ierr = ISLocalToGlobalMappingCreateIS(gid,&g2l);CHKERRQ(ierr);
1001     ierr = ISLocalToGlobalMappingSetType(g2l,ISLOCALTOGLOBALMAPPINGHASH);CHKERRQ(ierr);
1002     ierr = ISDestroy(&gid);CHKERRQ(ierr);
1003     ierr = VecGetArray(acown,&array);CHKERRQ(ierr);
1004     for (c = 0, ect = 0, ectn = 0; c < numVertices; c++) {
1005       PetscInt totl;
1006 
1007       totl = start[c+1]-start[c];
1008       ierr = ISGlobalToLocalMappingApply(g2l,IS_GTOLM_MASK,totl,adjacency+start[c],NULL,work);CHKERRQ(ierr);
1009       for (i = 0; i < totl; i++) {
1010         if (work[i] < 0) {
1011           ect  += 1;
1012           ectn += (array[i + start[c]] != nid) ? 0 : 1;
1013         }
1014       }
1015     }
1016     ierr  = PetscFree(work);CHKERRQ(ierr);
1017     ierr  = VecRestoreArray(acown,&array);CHKERRQ(ierr);
1018     lm[0] = numVertices > 0 ?  numVertices : PETSC_MAX_INT;
1019     lm[1] = -numVertices;
1020     ierr  = MPIU_Allreduce(lm,gm,2,MPIU_INT64,MPI_MIN,comm);CHKERRQ(ierr);
1021     ierr  = PetscViewerASCIIPrintf(viewer,"  Cell balance: %.2f (max %D, min %D",-((double)gm[1])/((double)gm[0]),-(PetscInt)gm[1],(PetscInt)gm[0]);CHKERRQ(ierr);
1022     lm[0] = ect; /* edgeCut */
1023     lm[1] = ectn; /* node-aware edgeCut */
1024     lm[2] = numVertices > 0 ? 0 : 1; /* empty processes */
1025     ierr  = MPIU_Allreduce(lm,gm,3,MPIU_INT64,MPI_SUM,comm);CHKERRQ(ierr);
1026     ierr  = PetscViewerASCIIPrintf(viewer,", empty %D)\n",(PetscInt)gm[2]);CHKERRQ(ierr);
1027 #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
1028     ierr  = PetscViewerASCIIPrintf(viewer,"  Edge Cut: %D (on node %.3f)\n",(PetscInt)(gm[0]/2),gm[0] ? ((double)(gm[1]))/((double)gm[0]) : 1.);CHKERRQ(ierr);
1029 #else
1030     ierr  = PetscViewerASCIIPrintf(viewer,"  Edge Cut: %D (on node %.3f)\n",(PetscInt)(gm[0]/2),0.0);CHKERRQ(ierr);
1031 #endif
1032     ierr  = ISLocalToGlobalMappingDestroy(&g2l);CHKERRQ(ierr);
1033     ierr  = PetscFree(start);CHKERRQ(ierr);
1034     ierr  = PetscFree(adjacency);CHKERRQ(ierr);
1035     ierr  = VecDestroy(&acown);CHKERRQ(ierr);
1036   } else {
1037     const char    *name;
1038     PetscInt      *sizes, *hybsizes, *ghostsizes;
1039     PetscInt       locDepth, depth, cellHeight, dim, d;
1040     PetscInt       pStart, pEnd, p, gcStart, gcEnd, gcNum;
1041     PetscInt       numLabels, l;
1042     DMPolytopeType ct0;
1043     MPI_Comm       comm;
1044     PetscMPIInt    size, rank;
1045 
1046     ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
1047     ierr = MPI_Comm_size(comm, &size);CHKERRMPI(ierr);
1048     ierr = MPI_Comm_rank(comm, &rank);CHKERRMPI(ierr);
1049     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1050     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1051     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
1052     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimension%s:\n", name, dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
1053     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimension%s:\n", dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
1054     if (cellHeight) {ierr = PetscViewerASCIIPrintf(viewer, "  Cells are at height %D\n", cellHeight);CHKERRQ(ierr);}
1055     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
1056     ierr = MPIU_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
1057     ierr = DMPlexGetGhostCellStratum(dm, &gcStart, &gcEnd);CHKERRQ(ierr);
1058     gcNum = gcEnd - gcStart;
1059     ierr = PetscCalloc3(size,&sizes,size,&hybsizes,size,&ghostsizes);CHKERRQ(ierr);
1060     for (d = 0; d <= depth; d++) {
1061       PetscInt Nc[2] = {0, 0}, ict;
1062 
1063       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
1064       ierr = DMPlexGetCellType(dm, pStart, &ct0);CHKERRQ(ierr);
1065       ict  = ct0;
1066       ierr = MPI_Bcast(&ict, 1, MPIU_INT, 0, comm);CHKERRMPI(ierr);
1067       ct0  = (DMPolytopeType) ict;
1068       for (p = pStart; p < pEnd; ++p) {
1069         DMPolytopeType ct;
1070 
1071         ierr = DMPlexGetCellType(dm, p, &ct);CHKERRQ(ierr);
1072         if (ct == ct0) ++Nc[0];
1073         else           ++Nc[1];
1074       }
1075       ierr = MPI_Gather(&Nc[0], 1, MPIU_INT, sizes,    1, MPIU_INT, 0, comm);CHKERRMPI(ierr);
1076       ierr = MPI_Gather(&Nc[1], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRMPI(ierr);
1077       if (d == depth) {ierr = MPI_Gather(&gcNum, 1, MPIU_INT, ghostsizes, 1, MPIU_INT, 0, comm);CHKERRMPI(ierr);}
1078       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", (depth == 1) && d ? dim : d);CHKERRQ(ierr);
1079       for (p = 0; p < size; ++p) {
1080         if (!rank) {
1081           ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]+hybsizes[p]);CHKERRQ(ierr);
1082           if (hybsizes[p]   > 0) {ierr = PetscViewerASCIIPrintf(viewer, " (%D)", hybsizes[p]);CHKERRQ(ierr);}
1083           if (ghostsizes[p] > 0) {ierr = PetscViewerASCIIPrintf(viewer, " [%D]", ghostsizes[p]);CHKERRQ(ierr);}
1084         }
1085       }
1086       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
1087     }
1088     ierr = PetscFree3(sizes,hybsizes,ghostsizes);CHKERRQ(ierr);
1089     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
1090     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
1091     for (l = 0; l < numLabels; ++l) {
1092       DMLabel         label;
1093       const char     *name;
1094       IS              valueIS;
1095       const PetscInt *values;
1096       PetscInt        numValues, v;
1097 
1098       ierr = DMGetLabelName(dm, l, &name);CHKERRQ(ierr);
1099       ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
1100       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
1101       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %D strata with value/size (", name, numValues);CHKERRQ(ierr);
1102       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
1103       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
1104       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_FALSE);CHKERRQ(ierr);
1105       for (v = 0; v < numValues; ++v) {
1106         PetscInt size;
1107 
1108         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
1109         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
1110         ierr = PetscViewerASCIIPrintf(viewer, "%D (%D)", values[v], size);CHKERRQ(ierr);
1111       }
1112       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
1113       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_TRUE);CHKERRQ(ierr);
1114       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
1115       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
1116     }
1117     /* If no fields are specified, people do not want to see adjacency */
1118     if (dm->Nf) {
1119       PetscInt f;
1120 
1121       for (f = 0; f < dm->Nf; ++f) {
1122         const char *name;
1123 
1124         ierr = PetscObjectGetName(dm->fields[f].disc, &name);CHKERRQ(ierr);
1125         if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Field %s:\n", name);CHKERRQ(ierr);}
1126         ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
1127         if (dm->fields[f].label) {ierr = DMLabelView(dm->fields[f].label, viewer);CHKERRQ(ierr);}
1128         if (dm->fields[f].adjacency[0]) {
1129           if (dm->fields[f].adjacency[1]) {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FVM++\n");CHKERRQ(ierr);}
1130           else                            {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FVM\n");CHKERRQ(ierr);}
1131         } else {
1132           if (dm->fields[f].adjacency[1]) {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FEM\n");CHKERRQ(ierr);}
1133           else                            {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FUNKY\n");CHKERRQ(ierr);}
1134         }
1135         ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
1136       }
1137     }
1138     ierr = DMGetCoarseDM(dm, &cdm);CHKERRQ(ierr);
1139     if (cdm) {
1140       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
1141       ierr = DMPlexView_Ascii(cdm, viewer);CHKERRQ(ierr);
1142       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
1143     }
1144   }
1145   PetscFunctionReturn(0);
1146 }
1147 
1148 static PetscErrorCode DMPlexDrawCell(DM dm, PetscDraw draw, PetscInt cell, const PetscScalar coords[])
1149 {
1150   DMPolytopeType ct;
1151   PetscMPIInt    rank;
1152   PetscErrorCode ierr;
1153 
1154   PetscFunctionBegin;
1155   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRMPI(ierr);
1156   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1157   switch (ct) {
1158   case DM_POLYTOPE_TRIANGLE:
1159     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]),
1160                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1161                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1162                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1163     ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1164     ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1165     ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1166     break;
1167   case DM_POLYTOPE_QUADRILATERAL:
1168     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]),
1169                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1170                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1171                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1172     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]),
1173                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1174                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1175                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1176     ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1177     ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1178     ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1179     ierr = PetscDrawLine(draw, PetscRealPart(coords[6]), PetscRealPart(coords[7]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1180     break;
1181   default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells of type %s", DMPolytopeTypes[ct]);
1182   }
1183   PetscFunctionReturn(0);
1184 }
1185 
1186 static PetscErrorCode DMPlexDrawCellHighOrder(DM dm, PetscDraw draw, PetscInt cell, const PetscScalar coords[], PetscInt edgeDiv, PetscReal refCoords[], PetscReal edgeCoords[])
1187 {
1188   DMPolytopeType ct;
1189   PetscReal      centroid[2] = {0., 0.};
1190   PetscMPIInt    rank;
1191   PetscInt       fillColor, v, e, d;
1192   PetscErrorCode ierr;
1193 
1194   PetscFunctionBegin;
1195   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRMPI(ierr);
1196   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1197   fillColor = PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2;
1198   switch (ct) {
1199   case DM_POLYTOPE_TRIANGLE:
1200     {
1201       PetscReal refVertices[6] = {-1., -1., 1., -1., -1., 1.};
1202 
1203       for (v = 0; v < 3; ++v) {centroid[0] += PetscRealPart(coords[v*2+0])/3.;centroid[1] += PetscRealPart(coords[v*2+1])/3.;}
1204       for (e = 0; e < 3; ++e) {
1205         refCoords[0] = refVertices[e*2+0];
1206         refCoords[1] = refVertices[e*2+1];
1207         for (d = 1; d <= edgeDiv; ++d) {
1208           refCoords[d*2+0] = refCoords[0] + (refVertices[(e+1)%3 * 2 + 0] - refCoords[0])*d/edgeDiv;
1209           refCoords[d*2+1] = refCoords[1] + (refVertices[(e+1)%3 * 2 + 1] - refCoords[1])*d/edgeDiv;
1210         }
1211         ierr = DMPlexReferenceToCoordinates(dm, cell, edgeDiv+1, refCoords, edgeCoords);CHKERRQ(ierr);
1212         for (d = 0; d < edgeDiv; ++d) {
1213           ierr = PetscDrawTriangle(draw, centroid[0], centroid[1], edgeCoords[d*2+0], edgeCoords[d*2+1], edgeCoords[(d+1)*2+0], edgeCoords[(d+1)*2+1], fillColor, fillColor, fillColor);CHKERRQ(ierr);
1214           ierr = PetscDrawLine(draw, edgeCoords[d*2+0], edgeCoords[d*2+1], edgeCoords[(d+1)*2+0], edgeCoords[(d+1)*2+1], PETSC_DRAW_BLACK);CHKERRQ(ierr);
1215         }
1216       }
1217     }
1218     break;
1219   default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells of type %s", DMPolytopeTypes[ct]);
1220   }
1221   PetscFunctionReturn(0);
1222 }
1223 
1224 static PetscErrorCode DMPlexView_Draw(DM dm, PetscViewer viewer)
1225 {
1226   PetscDraw          draw;
1227   DM                 cdm;
1228   PetscSection       coordSection;
1229   Vec                coordinates;
1230   const PetscScalar *coords;
1231   PetscReal          xyl[2],xyr[2],bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
1232   PetscReal         *refCoords, *edgeCoords;
1233   PetscBool          isnull, drawAffine = PETSC_TRUE;
1234   PetscInt           dim, vStart, vEnd, cStart, cEnd, c, N, edgeDiv = 4;
1235   PetscErrorCode     ierr;
1236 
1237   PetscFunctionBegin;
1238   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
1239   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D", dim);
1240   ierr = PetscOptionsGetBool(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_view_draw_affine", &drawAffine, NULL);CHKERRQ(ierr);
1241   if (!drawAffine) {ierr = PetscMalloc2((edgeDiv+1)*dim, &refCoords, (edgeDiv+1)*dim, &edgeCoords);CHKERRQ(ierr);}
1242   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
1243   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
1244   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1245   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
1246   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1247 
1248   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
1249   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
1250   if (isnull) PetscFunctionReturn(0);
1251   ierr = PetscDrawSetTitle(draw, "Mesh");CHKERRQ(ierr);
1252 
1253   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
1254   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
1255   for (c = 0; c < N; c += dim) {
1256     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
1257     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
1258   }
1259   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
1260   ierr = MPIU_Allreduce(&bound[0],xyl,2,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1261   ierr = MPIU_Allreduce(&bound[2],xyr,2,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1262   ierr = PetscDrawSetCoordinates(draw, xyl[0], xyl[1], xyr[0], xyr[1]);CHKERRQ(ierr);
1263   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
1264 
1265   for (c = cStart; c < cEnd; ++c) {
1266     PetscScalar *coords = NULL;
1267     PetscInt     numCoords;
1268 
1269     ierr = DMPlexVecGetClosureAtDepth_Internal(dm, coordSection, coordinates, c, 0, &numCoords, &coords);CHKERRQ(ierr);
1270     if (drawAffine) {
1271       ierr = DMPlexDrawCell(dm, draw, c, coords);CHKERRQ(ierr);
1272     } else {
1273       ierr = DMPlexDrawCellHighOrder(dm, draw, c, coords, edgeDiv, refCoords, edgeCoords);CHKERRQ(ierr);
1274     }
1275     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
1276   }
1277   if (!drawAffine) {ierr = PetscFree2(refCoords, edgeCoords);CHKERRQ(ierr);}
1278   ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
1279   ierr = PetscDrawPause(draw);CHKERRQ(ierr);
1280   ierr = PetscDrawSave(draw);CHKERRQ(ierr);
1281   PetscFunctionReturn(0);
1282 }
1283 
1284 #if defined(PETSC_HAVE_EXODUSII)
1285 #include <exodusII.h>
1286 #endif
1287 
1288 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
1289 {
1290   PetscBool      iascii, ishdf5, isvtk, isdraw, flg, isglvis, isexodus;
1291   char           name[PETSC_MAX_PATH_LEN];
1292   PetscErrorCode ierr;
1293 
1294   PetscFunctionBegin;
1295   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1296   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1297   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII,    &iascii);CHKERRQ(ierr);
1298   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,      &isvtk);CHKERRQ(ierr);
1299   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,     &ishdf5);CHKERRQ(ierr);
1300   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,     &isdraw);CHKERRQ(ierr);
1301   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS,    &isglvis);CHKERRQ(ierr);
1302   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWEREXODUSII, &isexodus);CHKERRQ(ierr);
1303   if (iascii) {
1304     PetscViewerFormat format;
1305     ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
1306     if (format == PETSC_VIEWER_ASCII_GLVIS) {
1307       ierr = DMPlexView_GLVis(dm, viewer);CHKERRQ(ierr);
1308     } else {
1309       ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
1310     }
1311   } else if (ishdf5) {
1312 #if defined(PETSC_HAVE_HDF5)
1313     ierr = DMPlexView_HDF5_Internal(dm, viewer);CHKERRQ(ierr);
1314 #else
1315     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
1316 #endif
1317   } else if (isvtk) {
1318     ierr = DMPlexVTKWriteAll((PetscObject) dm,viewer);CHKERRQ(ierr);
1319   } else if (isdraw) {
1320     ierr = DMPlexView_Draw(dm, viewer);CHKERRQ(ierr);
1321   } else if (isglvis) {
1322     ierr = DMPlexView_GLVis(dm, viewer);CHKERRQ(ierr);
1323 #if defined(PETSC_HAVE_EXODUSII)
1324   } else if (isexodus) {
1325     int exoid;
1326     PetscInt cStart, cEnd, c;
1327 
1328     ierr = DMCreateLabel(dm, "Cell Sets");CHKERRQ(ierr);
1329     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1330     for (c = cStart; c < cEnd; ++c) {ierr = DMSetLabelValue(dm, "Cell Sets", c, 1);CHKERRQ(ierr);}
1331     ierr = PetscViewerExodusIIGetId(viewer, &exoid);CHKERRQ(ierr);
1332     ierr = DMPlexView_ExodusII_Internal(dm, exoid, 1);CHKERRQ(ierr);
1333 #endif
1334   } else {
1335     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Viewer type %s not yet supported for DMPlex writing", ((PetscObject)viewer)->type_name);
1336   }
1337   /* Optionally view the partition */
1338   ierr = PetscOptionsHasName(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_partition_view", &flg);CHKERRQ(ierr);
1339   if (flg) {
1340     Vec ranks;
1341     ierr = DMPlexCreateRankField(dm, &ranks);CHKERRQ(ierr);
1342     ierr = VecView(ranks, viewer);CHKERRQ(ierr);
1343     ierr = VecDestroy(&ranks);CHKERRQ(ierr);
1344   }
1345   /* Optionally view a label */
1346   ierr = PetscOptionsGetString(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_label_view", name, sizeof(name), &flg);CHKERRQ(ierr);
1347   if (flg) {
1348     DMLabel label;
1349     Vec     val;
1350 
1351     ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
1352     if (!label) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Label %s provided to -dm_label_view does not exist in this DM", name);
1353     ierr = DMPlexCreateLabelField(dm, label, &val);CHKERRQ(ierr);
1354     ierr = VecView(val, viewer);CHKERRQ(ierr);
1355     ierr = VecDestroy(&val);CHKERRQ(ierr);
1356   }
1357   PetscFunctionReturn(0);
1358 }
1359 
1360 PetscErrorCode DMLoad_Plex(DM dm, PetscViewer viewer)
1361 {
1362   PetscBool      ishdf5;
1363   PetscErrorCode ierr;
1364 
1365   PetscFunctionBegin;
1366   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1367   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1368   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,   &ishdf5);CHKERRQ(ierr);
1369   if (ishdf5) {
1370 #if defined(PETSC_HAVE_HDF5)
1371     PetscViewerFormat format;
1372     ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
1373     if (format == PETSC_VIEWER_HDF5_XDMF || format == PETSC_VIEWER_HDF5_VIZ) {
1374       ierr = DMPlexLoad_HDF5_Xdmf_Internal(dm, viewer);CHKERRQ(ierr);
1375     } else if (format == PETSC_VIEWER_HDF5_PETSC || format == PETSC_VIEWER_DEFAULT || format == PETSC_VIEWER_NATIVE) {
1376       ierr = DMPlexLoad_HDF5_Internal(dm, viewer);CHKERRQ(ierr);
1377     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "PetscViewerFormat %s not supported for HDF5 input.", PetscViewerFormats[format]);
1378     PetscFunctionReturn(0);
1379 #else
1380     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
1381 #endif
1382   } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Viewer type %s not yet supported for DMPlex loading", ((PetscObject)viewer)->type_name);
1383 }
1384 
1385 PetscErrorCode DMDestroy_Plex(DM dm)
1386 {
1387   DM_Plex       *mesh = (DM_Plex*) dm->data;
1388   PetscErrorCode ierr;
1389 
1390   PetscFunctionBegin;
1391   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMSetUpGLVisViewer_C",NULL);CHKERRQ(ierr);
1392   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMPlexInsertBoundaryValues_C", NULL);CHKERRQ(ierr);
1393   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMCreateNeumannOverlap_C", NULL);CHKERRQ(ierr);
1394   if (--mesh->refct > 0) PetscFunctionReturn(0);
1395   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
1396   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
1397   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
1398   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
1399   ierr = PetscSectionDestroy(&mesh->subdomainSection);CHKERRQ(ierr);
1400   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
1401   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
1402   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
1403   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
1404   ierr = PetscPartitionerDestroy(&mesh->partitioner);CHKERRQ(ierr);
1405   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
1406   ierr = ISDestroy(&mesh->subpointIS);CHKERRQ(ierr);
1407   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
1408   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
1409   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
1410   ierr = ISDestroy(&mesh->anchorIS);CHKERRQ(ierr);
1411   ierr = PetscSectionDestroy(&mesh->parentSection);CHKERRQ(ierr);
1412   ierr = PetscFree(mesh->parents);CHKERRQ(ierr);
1413   ierr = PetscFree(mesh->childIDs);CHKERRQ(ierr);
1414   ierr = PetscSectionDestroy(&mesh->childSection);CHKERRQ(ierr);
1415   ierr = PetscFree(mesh->children);CHKERRQ(ierr);
1416   ierr = DMDestroy(&mesh->referenceTree);CHKERRQ(ierr);
1417   ierr = PetscGridHashDestroy(&mesh->lbox);CHKERRQ(ierr);
1418   ierr = PetscFree(mesh->neighbors);CHKERRQ(ierr);
1419   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
1420   ierr = PetscFree(mesh);CHKERRQ(ierr);
1421   PetscFunctionReturn(0);
1422 }
1423 
1424 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
1425 {
1426   PetscSection           sectionGlobal;
1427   PetscInt               bs = -1, mbs;
1428   PetscInt               localSize;
1429   PetscBool              isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock, isMatIS;
1430   PetscErrorCode         ierr;
1431   MatType                mtype;
1432   ISLocalToGlobalMapping ltog;
1433 
1434   PetscFunctionBegin;
1435   ierr = MatInitializePackage();CHKERRQ(ierr);
1436   mtype = dm->mattype;
1437   ierr = DMGetGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
1438   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
1439   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
1440   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
1441   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
1442   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
1443   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
1444   ierr = MatGetBlockSize(*J, &mbs);CHKERRQ(ierr);
1445   if (mbs > 1) bs = mbs;
1446   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
1447   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
1448   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
1449   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
1450   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
1451   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
1452   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
1453   ierr = PetscStrcmp(mtype, MATIS, &isMatIS);CHKERRQ(ierr);
1454   if (!isShell) {
1455     PetscSection subSection;
1456     PetscBool    fillMatrix = (PetscBool)(!dm->prealloc_only && !isMatIS);
1457     PetscInt    *dnz, *onz, *dnzu, *onzu, bsLocal[2], bsMinMax[2], *ltogidx, lsize;
1458     PetscInt     pStart, pEnd, p, dof, cdof;
1459 
1460     /* Set localtoglobalmapping on the matrix for MatSetValuesLocal() to work (it also creates the local matrices in case of MATIS) */
1461     if (isMatIS) { /* need a different l2g map than the one computed by DMGetLocalToGlobalMapping */
1462       PetscSection section;
1463       PetscInt     size;
1464 
1465       ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1466       ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
1467       ierr = PetscMalloc1(size,&ltogidx);CHKERRQ(ierr);
1468       ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);
1469     } else {
1470       ierr = DMGetLocalToGlobalMapping(dm,&ltog);CHKERRQ(ierr);
1471     }
1472     ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
1473     for (p = pStart, lsize = 0; p < pEnd; ++p) {
1474       PetscInt bdof;
1475 
1476       ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
1477       ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
1478       dof  = dof < 0 ? -(dof+1) : dof;
1479       bdof = cdof && (dof-cdof) ? 1 : dof;
1480       if (dof) {
1481         if (bs < 0)          {bs = bdof;}
1482         else if (bs != bdof) {bs = 1; if (!isMatIS) break;}
1483       }
1484       if (isMatIS) {
1485         PetscInt loff,c,off;
1486         ierr = PetscSectionGetOffset(subSection, p, &loff);CHKERRQ(ierr);
1487         ierr = PetscSectionGetOffset(sectionGlobal, p, &off);CHKERRQ(ierr);
1488         for (c = 0; c < dof-cdof; ++c, ++lsize) ltogidx[loff+c] = off > -1 ? off+c : -(off+1)+c;
1489       }
1490     }
1491     /* Must have same blocksize on all procs (some might have no points) */
1492     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
1493     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
1494     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
1495     else                            {bs = bsMinMax[0];}
1496     bs = PetscMax(1,bs);
1497     if (isMatIS) { /* Must reduce indices by blocksize */
1498       PetscInt l;
1499 
1500       lsize = lsize/bs;
1501       if (bs > 1) for (l = 0; l < lsize; ++l) ltogidx[l] = ltogidx[l*bs]/bs;
1502       ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)dm), bs, lsize, ltogidx, PETSC_OWN_POINTER, &ltog);CHKERRQ(ierr);
1503     }
1504     ierr = MatSetLocalToGlobalMapping(*J,ltog,ltog);CHKERRQ(ierr);
1505     if (isMatIS) {
1506       ierr = ISLocalToGlobalMappingDestroy(&ltog);CHKERRQ(ierr);
1507     }
1508     ierr = PetscCalloc4(localSize/bs, &dnz, localSize/bs, &onz, localSize/bs, &dnzu, localSize/bs, &onzu);CHKERRQ(ierr);
1509     ierr = DMPlexPreallocateOperator(dm, bs, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
1510     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
1511   }
1512   ierr = MatSetDM(*J, dm);CHKERRQ(ierr);
1513   PetscFunctionReturn(0);
1514 }
1515 
1516 /*@
1517   DMPlexGetSubdomainSection - Returns the section associated with the subdomain
1518 
1519   Not collective
1520 
1521   Input Parameter:
1522 . mesh - The DMPlex
1523 
1524   Output Parameters:
1525 . subsection - The subdomain section
1526 
1527   Level: developer
1528 
1529 .seealso:
1530 @*/
1531 PetscErrorCode DMPlexGetSubdomainSection(DM dm, PetscSection *subsection)
1532 {
1533   DM_Plex       *mesh = (DM_Plex*) dm->data;
1534   PetscErrorCode ierr;
1535 
1536   PetscFunctionBegin;
1537   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1538   if (!mesh->subdomainSection) {
1539     PetscSection section;
1540     PetscSF      sf;
1541 
1542     ierr = PetscSFCreate(PETSC_COMM_SELF,&sf);CHKERRQ(ierr);
1543     ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1544     ierr = PetscSectionCreateGlobalSection(section,sf,PETSC_FALSE,PETSC_TRUE,&mesh->subdomainSection);CHKERRQ(ierr);
1545     ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1546   }
1547   *subsection = mesh->subdomainSection;
1548   PetscFunctionReturn(0);
1549 }
1550 
1551 /*@
1552   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
1553 
1554   Not collective
1555 
1556   Input Parameter:
1557 . mesh - The DMPlex
1558 
1559   Output Parameters:
1560 + pStart - The first mesh point
1561 - pEnd   - The upper bound for mesh points
1562 
1563   Level: beginner
1564 
1565 .seealso: DMPlexCreate(), DMPlexSetChart()
1566 @*/
1567 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
1568 {
1569   DM_Plex       *mesh = (DM_Plex*) dm->data;
1570   PetscErrorCode ierr;
1571 
1572   PetscFunctionBegin;
1573   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1574   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1575   PetscFunctionReturn(0);
1576 }
1577 
1578 /*@
1579   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
1580 
1581   Not collective
1582 
1583   Input Parameters:
1584 + mesh - The DMPlex
1585 . pStart - The first mesh point
1586 - pEnd   - The upper bound for mesh points
1587 
1588   Output Parameters:
1589 
1590   Level: beginner
1591 
1592 .seealso: DMPlexCreate(), DMPlexGetChart()
1593 @*/
1594 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
1595 {
1596   DM_Plex       *mesh = (DM_Plex*) dm->data;
1597   PetscErrorCode ierr;
1598 
1599   PetscFunctionBegin;
1600   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1601   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1602   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
1603   PetscFunctionReturn(0);
1604 }
1605 
1606 /*@
1607   DMPlexGetConeSize - Return the number of in-edges for this point in the DAG
1608 
1609   Not collective
1610 
1611   Input Parameters:
1612 + mesh - The DMPlex
1613 - p - The point, which must lie in the chart set with DMPlexSetChart()
1614 
1615   Output Parameter:
1616 . size - The cone size for point p
1617 
1618   Level: beginner
1619 
1620 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1621 @*/
1622 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
1623 {
1624   DM_Plex       *mesh = (DM_Plex*) dm->data;
1625   PetscErrorCode ierr;
1626 
1627   PetscFunctionBegin;
1628   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1629   PetscValidPointer(size, 3);
1630   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1631   PetscFunctionReturn(0);
1632 }
1633 
1634 /*@
1635   DMPlexSetConeSize - Set the number of in-edges for this point in the DAG
1636 
1637   Not collective
1638 
1639   Input Parameters:
1640 + mesh - The DMPlex
1641 . p - The point, which must lie in the chart set with DMPlexSetChart()
1642 - size - The cone size for point p
1643 
1644   Output Parameter:
1645 
1646   Note:
1647   This should be called after DMPlexSetChart().
1648 
1649   Level: beginner
1650 
1651 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
1652 @*/
1653 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
1654 {
1655   DM_Plex       *mesh = (DM_Plex*) dm->data;
1656   PetscErrorCode ierr;
1657 
1658   PetscFunctionBegin;
1659   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1660   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1661 
1662   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
1663   PetscFunctionReturn(0);
1664 }
1665 
1666 /*@
1667   DMPlexAddConeSize - Add the given number of in-edges to this point in the DAG
1668 
1669   Not collective
1670 
1671   Input Parameters:
1672 + mesh - The DMPlex
1673 . p - The point, which must lie in the chart set with DMPlexSetChart()
1674 - size - The additional cone size for point p
1675 
1676   Output Parameter:
1677 
1678   Note:
1679   This should be called after DMPlexSetChart().
1680 
1681   Level: beginner
1682 
1683 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexGetConeSize(), DMPlexSetChart()
1684 @*/
1685 PetscErrorCode DMPlexAddConeSize(DM dm, PetscInt p, PetscInt size)
1686 {
1687   DM_Plex       *mesh = (DM_Plex*) dm->data;
1688   PetscInt       csize;
1689   PetscErrorCode ierr;
1690 
1691   PetscFunctionBegin;
1692   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1693   ierr = PetscSectionAddDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1694   ierr = PetscSectionGetDof(mesh->coneSection, p, &csize);CHKERRQ(ierr);
1695 
1696   mesh->maxConeSize = PetscMax(mesh->maxConeSize, csize);
1697   PetscFunctionReturn(0);
1698 }
1699 
1700 /*@C
1701   DMPlexGetCone - Return the points on the in-edges for this point in the DAG
1702 
1703   Not collective
1704 
1705   Input Parameters:
1706 + dm - The DMPlex
1707 - p - The point, which must lie in the chart set with DMPlexSetChart()
1708 
1709   Output Parameter:
1710 . cone - An array of points which are on the in-edges for point p
1711 
1712   Level: beginner
1713 
1714   Fortran Notes:
1715   Since it returns an array, this routine is only available in Fortran 90, and you must
1716   include petsc.h90 in your code.
1717   You must also call DMPlexRestoreCone() after you finish using the returned array.
1718   DMPlexRestoreCone() is not needed/available in C.
1719 
1720 .seealso: DMPlexGetConeSize(), DMPlexSetCone(), DMPlexGetConeTuple(), DMPlexSetChart()
1721 @*/
1722 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
1723 {
1724   DM_Plex       *mesh = (DM_Plex*) dm->data;
1725   PetscInt       off;
1726   PetscErrorCode ierr;
1727 
1728   PetscFunctionBegin;
1729   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1730   PetscValidPointer(cone, 3);
1731   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1732   *cone = &mesh->cones[off];
1733   PetscFunctionReturn(0);
1734 }
1735 
1736 /*@C
1737   DMPlexGetConeTuple - Return the points on the in-edges of several points in the DAG
1738 
1739   Not collective
1740 
1741   Input Parameters:
1742 + dm - The DMPlex
1743 - p - The IS of points, which must lie in the chart set with DMPlexSetChart()
1744 
1745   Output Parameter:
1746 + pConesSection - PetscSection describing the layout of pCones
1747 - pCones - An array of points which are on the in-edges for the point set p
1748 
1749   Level: intermediate
1750 
1751 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeRecursive(), DMPlexSetChart()
1752 @*/
1753 PetscErrorCode DMPlexGetConeTuple(DM dm, IS p, PetscSection *pConesSection, IS *pCones)
1754 {
1755   PetscSection        cs, newcs;
1756   PetscInt            *cones;
1757   PetscInt            *newarr=NULL;
1758   PetscInt            n;
1759   PetscErrorCode      ierr;
1760 
1761   PetscFunctionBegin;
1762   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
1763   ierr = DMPlexGetConeSection(dm, &cs);CHKERRQ(ierr);
1764   ierr = PetscSectionExtractDofsFromArray(cs, MPIU_INT, cones, p, &newcs, pCones ? ((void**)&newarr) : NULL);CHKERRQ(ierr);
1765   if (pConesSection) *pConesSection = newcs;
1766   if (pCones) {
1767     ierr = PetscSectionGetStorageSize(newcs, &n);CHKERRQ(ierr);
1768     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)p), n, newarr, PETSC_OWN_POINTER, pCones);CHKERRQ(ierr);
1769   }
1770   PetscFunctionReturn(0);
1771 }
1772 
1773 /*@
1774   DMPlexGetConeRecursiveVertices - Expand each given point into its cone points and do that recursively until we end up just with vertices.
1775 
1776   Not collective
1777 
1778   Input Parameters:
1779 + dm - The DMPlex
1780 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1781 
1782   Output Parameter:
1783 . expandedPoints - An array of vertices recursively expanded from input points
1784 
1785   Level: advanced
1786 
1787   Notes:
1788   Like DMPlexGetConeRecursive but returns only the 0-depth IS (i.e. vertices only) and no sections.
1789   There is no corresponding Restore function, just call ISDestroy() on the returned IS to deallocate.
1790 
1791 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexGetConeRecursive(), DMPlexRestoreConeRecursive(), DMPlexGetDepth()
1792 @*/
1793 PetscErrorCode DMPlexGetConeRecursiveVertices(DM dm, IS points, IS *expandedPoints)
1794 {
1795   IS                  *expandedPointsAll;
1796   PetscInt            depth;
1797   PetscErrorCode      ierr;
1798 
1799   PetscFunctionBegin;
1800   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1801   PetscValidHeaderSpecific(points, IS_CLASSID, 2);
1802   PetscValidPointer(expandedPoints, 3);
1803   ierr = DMPlexGetConeRecursive(dm, points, &depth, &expandedPointsAll, NULL);CHKERRQ(ierr);
1804   *expandedPoints = expandedPointsAll[0];
1805   ierr = PetscObjectReference((PetscObject)expandedPointsAll[0]);
1806   ierr = DMPlexRestoreConeRecursive(dm, points, &depth, &expandedPointsAll, NULL);CHKERRQ(ierr);
1807   PetscFunctionReturn(0);
1808 }
1809 
1810 /*@
1811   DMPlexGetConeRecursive - Expand each given point into its cone points and do that recursively until we end up just with vertices (DAG points of depth 0, i.e. without cones).
1812 
1813   Not collective
1814 
1815   Input Parameters:
1816 + dm - The DMPlex
1817 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1818 
1819   Output Parameter:
1820 + depth - (optional) Size of the output arrays, equal to DMPlex depth, returned by DMPlexGetDepth()
1821 . expandedPoints - (optional) An array of index sets with recursively expanded cones
1822 - sections - (optional) An array of sections which describe mappings from points to their cone points
1823 
1824   Level: advanced
1825 
1826   Notes:
1827   Like DMPlexGetConeTuple() but recursive.
1828 
1829   Array expandedPoints has size equal to depth. Each expandedPoints[d] contains DAG points with maximum depth d, recursively cone-wise expanded from the input points.
1830   For example, for d=0 it contains only vertices, for d=1 it can contain vertices and edges, etc.
1831 
1832   Array section has size equal to depth.  Each PetscSection sections[d] realizes mapping from expandedPoints[d+1] (section points) to expandedPoints[d] (section dofs) as follows:
1833   (1) DAG points in expandedPoints[d+1] with depth d+1 to their cone points in expandedPoints[d];
1834   (2) DAG points in expandedPoints[d+1] with depth in [0,d] to the same points in expandedPoints[d].
1835 
1836 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexRestoreConeRecursive(), DMPlexGetConeRecursiveVertices(), DMPlexGetDepth()
1837 @*/
1838 PetscErrorCode DMPlexGetConeRecursive(DM dm, IS points, PetscInt *depth, IS *expandedPoints[], PetscSection *sections[])
1839 {
1840   const PetscInt      *arr0=NULL, *cone=NULL;
1841   PetscInt            *arr=NULL, *newarr=NULL;
1842   PetscInt            d, depth_, i, n, newn, cn, co, start, end;
1843   IS                  *expandedPoints_;
1844   PetscSection        *sections_;
1845   PetscErrorCode      ierr;
1846 
1847   PetscFunctionBegin;
1848   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1849   PetscValidHeaderSpecific(points, IS_CLASSID, 2);
1850   if (depth) PetscValidIntPointer(depth, 3);
1851   if (expandedPoints) PetscValidPointer(expandedPoints, 4);
1852   if (sections) PetscValidPointer(sections, 5);
1853   ierr = ISGetLocalSize(points, &n);CHKERRQ(ierr);
1854   ierr = ISGetIndices(points, &arr0);CHKERRQ(ierr);
1855   ierr = DMPlexGetDepth(dm, &depth_);CHKERRQ(ierr);
1856   ierr = PetscCalloc1(depth_, &expandedPoints_);CHKERRQ(ierr);
1857   ierr = PetscCalloc1(depth_, &sections_);CHKERRQ(ierr);
1858   arr = (PetscInt*) arr0; /* this is ok because first generation of arr is not modified */
1859   for (d=depth_-1; d>=0; d--) {
1860     ierr = PetscSectionCreate(PETSC_COMM_SELF, &sections_[d]);CHKERRQ(ierr);
1861     ierr = PetscSectionSetChart(sections_[d], 0, n);CHKERRQ(ierr);
1862     for (i=0; i<n; i++) {
1863       ierr = DMPlexGetDepthStratum(dm, d+1, &start, &end);CHKERRQ(ierr);
1864       if (arr[i] >= start && arr[i] < end) {
1865         ierr = DMPlexGetConeSize(dm, arr[i], &cn);CHKERRQ(ierr);
1866         ierr = PetscSectionSetDof(sections_[d], i, cn);CHKERRQ(ierr);
1867       } else {
1868         ierr = PetscSectionSetDof(sections_[d], i, 1);CHKERRQ(ierr);
1869       }
1870     }
1871     ierr = PetscSectionSetUp(sections_[d]);CHKERRQ(ierr);
1872     ierr = PetscSectionGetStorageSize(sections_[d], &newn);CHKERRQ(ierr);
1873     ierr = PetscMalloc1(newn, &newarr);CHKERRQ(ierr);
1874     for (i=0; i<n; i++) {
1875       ierr = PetscSectionGetDof(sections_[d], i, &cn);CHKERRQ(ierr);
1876       ierr = PetscSectionGetOffset(sections_[d], i, &co);CHKERRQ(ierr);
1877       if (cn > 1) {
1878         ierr = DMPlexGetCone(dm, arr[i], &cone);CHKERRQ(ierr);
1879         ierr = PetscMemcpy(&newarr[co], cone, cn*sizeof(PetscInt));CHKERRQ(ierr);
1880       } else {
1881         newarr[co] = arr[i];
1882       }
1883     }
1884     ierr = ISCreateGeneral(PETSC_COMM_SELF, newn, newarr, PETSC_OWN_POINTER, &expandedPoints_[d]);CHKERRQ(ierr);
1885     arr = newarr;
1886     n = newn;
1887   }
1888   ierr = ISRestoreIndices(points, &arr0);CHKERRQ(ierr);
1889   *depth = depth_;
1890   if (expandedPoints) *expandedPoints = expandedPoints_;
1891   else {
1892     for (d=0; d<depth_; d++) {ierr = ISDestroy(&expandedPoints_[d]);CHKERRQ(ierr);}
1893     ierr = PetscFree(expandedPoints_);CHKERRQ(ierr);
1894   }
1895   if (sections) *sections = sections_;
1896   else {
1897     for (d=0; d<depth_; d++) {ierr = PetscSectionDestroy(&sections_[d]);CHKERRQ(ierr);}
1898     ierr = PetscFree(sections_);CHKERRQ(ierr);
1899   }
1900   PetscFunctionReturn(0);
1901 }
1902 
1903 /*@
1904   DMPlexRestoreConeRecursive - Deallocates arrays created by DMPlexGetConeRecursive
1905 
1906   Not collective
1907 
1908   Input Parameters:
1909 + dm - The DMPlex
1910 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1911 
1912   Output Parameter:
1913 + depth - (optional) Size of the output arrays, equal to DMPlex depth, returned by DMPlexGetDepth()
1914 . expandedPoints - (optional) An array of recursively expanded cones
1915 - sections - (optional) An array of sections which describe mappings from points to their cone points
1916 
1917   Level: advanced
1918 
1919   Notes:
1920   See DMPlexGetConeRecursive() for details.
1921 
1922 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexGetConeRecursive(), DMPlexGetConeRecursiveVertices(), DMPlexGetDepth()
1923 @*/
1924 PetscErrorCode DMPlexRestoreConeRecursive(DM dm, IS points, PetscInt *depth, IS *expandedPoints[], PetscSection *sections[])
1925 {
1926   PetscInt            d, depth_;
1927   PetscErrorCode      ierr;
1928 
1929   PetscFunctionBegin;
1930   ierr = DMPlexGetDepth(dm, &depth_);CHKERRQ(ierr);
1931   if (depth && *depth != depth_) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "depth changed since last call to DMPlexGetConeRecursive");
1932   if (depth) *depth = 0;
1933   if (expandedPoints) {
1934     for (d=0; d<depth_; d++) {ierr = ISDestroy(&((*expandedPoints)[d]));CHKERRQ(ierr);}
1935     ierr = PetscFree(*expandedPoints);CHKERRQ(ierr);
1936   }
1937   if (sections)  {
1938     for (d=0; d<depth_; d++) {ierr = PetscSectionDestroy(&((*sections)[d]));CHKERRQ(ierr);}
1939     ierr = PetscFree(*sections);CHKERRQ(ierr);
1940   }
1941   PetscFunctionReturn(0);
1942 }
1943 
1944 /*@
1945   DMPlexSetCone - Set the points on the in-edges for this point in the DAG; that is these are the points that cover the specific point
1946 
1947   Not collective
1948 
1949   Input Parameters:
1950 + mesh - The DMPlex
1951 . p - The point, which must lie in the chart set with DMPlexSetChart()
1952 - cone - An array of points which are on the in-edges for point p
1953 
1954   Output Parameter:
1955 
1956   Note:
1957   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1958 
1959   Developer Note: Why not call this DMPlexSetCover()
1960 
1961   Level: beginner
1962 
1963 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp(), DMPlexSetSupport(), DMPlexSetSupportSize()
1964 @*/
1965 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
1966 {
1967   DM_Plex       *mesh = (DM_Plex*) dm->data;
1968   PetscInt       pStart, pEnd;
1969   PetscInt       dof, off, c;
1970   PetscErrorCode ierr;
1971 
1972   PetscFunctionBegin;
1973   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1974   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1975   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1976   if (dof) PetscValidPointer(cone, 3);
1977   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1978   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1979   for (c = 0; c < dof; ++c) {
1980     if ((cone[c] < pStart) || (cone[c] >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone point %D is not in the valid range [%D, %D)", cone[c], pStart, pEnd);
1981     mesh->cones[off+c] = cone[c];
1982   }
1983   PetscFunctionReturn(0);
1984 }
1985 
1986 /*@C
1987   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the DAG
1988 
1989   Not collective
1990 
1991   Input Parameters:
1992 + mesh - The DMPlex
1993 - p - The point, which must lie in the chart set with DMPlexSetChart()
1994 
1995   Output Parameter:
1996 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1997                     integer giving the prescription for cone traversal. If it is negative, the cone is
1998                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1999                     the index of the cone point on which to start.
2000 
2001   Level: beginner
2002 
2003   Fortran Notes:
2004   Since it returns an array, this routine is only available in Fortran 90, and you must
2005   include petsc.h90 in your code.
2006   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
2007   DMPlexRestoreConeOrientation() is not needed/available in C.
2008 
2009 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
2010 @*/
2011 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
2012 {
2013   DM_Plex       *mesh = (DM_Plex*) dm->data;
2014   PetscInt       off;
2015   PetscErrorCode ierr;
2016 
2017   PetscFunctionBegin;
2018   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2019   if (PetscDefined(USE_DEBUG)) {
2020     PetscInt dof;
2021     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2022     if (dof) PetscValidPointer(coneOrientation, 3);
2023   }
2024   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2025 
2026   *coneOrientation = &mesh->coneOrientations[off];
2027   PetscFunctionReturn(0);
2028 }
2029 
2030 /*@
2031   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the DAG
2032 
2033   Not collective
2034 
2035   Input Parameters:
2036 + mesh - The DMPlex
2037 . p - The point, which must lie in the chart set with DMPlexSetChart()
2038 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
2039                     integer giving the prescription for cone traversal. If it is negative, the cone is
2040                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
2041                     the index of the cone point on which to start.
2042 
2043   Output Parameter:
2044 
2045   Note:
2046   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
2047 
2048   Level: beginner
2049 
2050 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2051 @*/
2052 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
2053 {
2054   DM_Plex       *mesh = (DM_Plex*) dm->data;
2055   PetscInt       pStart, pEnd;
2056   PetscInt       dof, off, c;
2057   PetscErrorCode ierr;
2058 
2059   PetscFunctionBegin;
2060   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2061   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2062   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2063   if (dof) PetscValidPointer(coneOrientation, 3);
2064   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2065   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
2066   for (c = 0; c < dof; ++c) {
2067     PetscInt cdof, o = coneOrientation[c];
2068 
2069     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
2070     if (o && ((o < -(cdof+1)) || (o >= cdof))) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone orientation %D is not in the valid range [%D. %D)", o, -(cdof+1), cdof);
2071     mesh->coneOrientations[off+c] = o;
2072   }
2073   PetscFunctionReturn(0);
2074 }
2075 
2076 /*@
2077   DMPlexInsertCone - Insert a point into the in-edges for the point p in the DAG
2078 
2079   Not collective
2080 
2081   Input Parameters:
2082 + mesh - The DMPlex
2083 . p - The point, which must lie in the chart set with DMPlexSetChart()
2084 . conePos - The local index in the cone where the point should be put
2085 - conePoint - The mesh point to insert
2086 
2087   Level: beginner
2088 
2089 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2090 @*/
2091 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
2092 {
2093   DM_Plex       *mesh = (DM_Plex*) dm->data;
2094   PetscInt       pStart, pEnd;
2095   PetscInt       dof, off;
2096   PetscErrorCode ierr;
2097 
2098   PetscFunctionBegin;
2099   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2100   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2101   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
2102   if ((conePoint < pStart) || (conePoint >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone point %D is not in the valid range [%D, %D)", conePoint, pStart, pEnd);
2103   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2104   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2105   if ((conePos < 0) || (conePos >= dof)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone position %D of point %D is not in the valid range [0, %D)", conePos, p, dof);
2106   mesh->cones[off+conePos] = conePoint;
2107   PetscFunctionReturn(0);
2108 }
2109 
2110 /*@
2111   DMPlexInsertConeOrientation - Insert a point orientation for the in-edge for the point p in the DAG
2112 
2113   Not collective
2114 
2115   Input Parameters:
2116 + mesh - The DMPlex
2117 . p - The point, which must lie in the chart set with DMPlexSetChart()
2118 . conePos - The local index in the cone where the point should be put
2119 - coneOrientation - The point orientation to insert
2120 
2121   Level: beginner
2122 
2123 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2124 @*/
2125 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
2126 {
2127   DM_Plex       *mesh = (DM_Plex*) dm->data;
2128   PetscInt       pStart, pEnd;
2129   PetscInt       dof, off;
2130   PetscErrorCode ierr;
2131 
2132   PetscFunctionBegin;
2133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2134   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2135   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
2136   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2137   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2138   if ((conePos < 0) || (conePos >= dof)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone position %D of point %D is not in the valid range [0, %D)", conePos, p, dof);
2139   mesh->coneOrientations[off+conePos] = coneOrientation;
2140   PetscFunctionReturn(0);
2141 }
2142 
2143 /*@
2144   DMPlexGetSupportSize - Return the number of out-edges for this point in the DAG
2145 
2146   Not collective
2147 
2148   Input Parameters:
2149 + mesh - The DMPlex
2150 - p - The point, which must lie in the chart set with DMPlexSetChart()
2151 
2152   Output Parameter:
2153 . size - The support size for point p
2154 
2155   Level: beginner
2156 
2157 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
2158 @*/
2159 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
2160 {
2161   DM_Plex       *mesh = (DM_Plex*) dm->data;
2162   PetscErrorCode ierr;
2163 
2164   PetscFunctionBegin;
2165   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2166   PetscValidPointer(size, 3);
2167   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
2168   PetscFunctionReturn(0);
2169 }
2170 
2171 /*@
2172   DMPlexSetSupportSize - Set the number of out-edges for this point in the DAG
2173 
2174   Not collective
2175 
2176   Input Parameters:
2177 + mesh - The DMPlex
2178 . p - The point, which must lie in the chart set with DMPlexSetChart()
2179 - size - The support size for point p
2180 
2181   Output Parameter:
2182 
2183   Note:
2184   This should be called after DMPlexSetChart().
2185 
2186   Level: beginner
2187 
2188 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
2189 @*/
2190 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
2191 {
2192   DM_Plex       *mesh = (DM_Plex*) dm->data;
2193   PetscErrorCode ierr;
2194 
2195   PetscFunctionBegin;
2196   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2197   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
2198 
2199   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
2200   PetscFunctionReturn(0);
2201 }
2202 
2203 /*@C
2204   DMPlexGetSupport - Return the points on the out-edges for this point in the DAG
2205 
2206   Not collective
2207 
2208   Input Parameters:
2209 + mesh - The DMPlex
2210 - p - The point, which must lie in the chart set with DMPlexSetChart()
2211 
2212   Output Parameter:
2213 . support - An array of points which are on the out-edges for point p
2214 
2215   Level: beginner
2216 
2217   Fortran Notes:
2218   Since it returns an array, this routine is only available in Fortran 90, and you must
2219   include petsc.h90 in your code.
2220   You must also call DMPlexRestoreSupport() after you finish using the returned array.
2221   DMPlexRestoreSupport() is not needed/available in C.
2222 
2223 .seealso: DMPlexGetSupportSize(), DMPlexSetSupport(), DMPlexGetCone(), DMPlexSetChart()
2224 @*/
2225 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
2226 {
2227   DM_Plex       *mesh = (DM_Plex*) dm->data;
2228   PetscInt       off;
2229   PetscErrorCode ierr;
2230 
2231   PetscFunctionBegin;
2232   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2233   PetscValidPointer(support, 3);
2234   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2235   *support = &mesh->supports[off];
2236   PetscFunctionReturn(0);
2237 }
2238 
2239 /*@
2240   DMPlexSetSupport - Set the points on the out-edges for this point in the DAG, that is the list of points that this point covers
2241 
2242   Not collective
2243 
2244   Input Parameters:
2245 + mesh - The DMPlex
2246 . p - The point, which must lie in the chart set with DMPlexSetChart()
2247 - support - An array of points which are on the out-edges for point p
2248 
2249   Output Parameter:
2250 
2251   Note:
2252   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
2253 
2254   Level: beginner
2255 
2256 .seealso: DMPlexSetCone(), DMPlexSetConeSize(), DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
2257 @*/
2258 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
2259 {
2260   DM_Plex       *mesh = (DM_Plex*) dm->data;
2261   PetscInt       pStart, pEnd;
2262   PetscInt       dof, off, c;
2263   PetscErrorCode ierr;
2264 
2265   PetscFunctionBegin;
2266   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2267   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
2268   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2269   if (dof) PetscValidPointer(support, 3);
2270   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2271   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
2272   for (c = 0; c < dof; ++c) {
2273     if ((support[c] < pStart) || (support[c] >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support point %D is not in the valid range [%D, %D)", support[c], pStart, pEnd);
2274     mesh->supports[off+c] = support[c];
2275   }
2276   PetscFunctionReturn(0);
2277 }
2278 
2279 /*@
2280   DMPlexInsertSupport - Insert a point into the out-edges for the point p in the DAG
2281 
2282   Not collective
2283 
2284   Input Parameters:
2285 + mesh - The DMPlex
2286 . p - The point, which must lie in the chart set with DMPlexSetChart()
2287 . supportPos - The local index in the cone where the point should be put
2288 - supportPoint - The mesh point to insert
2289 
2290   Level: beginner
2291 
2292 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2293 @*/
2294 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
2295 {
2296   DM_Plex       *mesh = (DM_Plex*) dm->data;
2297   PetscInt       pStart, pEnd;
2298   PetscInt       dof, off;
2299   PetscErrorCode ierr;
2300 
2301   PetscFunctionBegin;
2302   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2303   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
2304   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2305   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2306   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
2307   if ((supportPoint < pStart) || (supportPoint >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support point %D is not in the valid range [%D, %D)", supportPoint, pStart, pEnd);
2308   if (supportPos >= dof) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support position %D of point %D is not in the valid range [0, %D)", supportPos, p, dof);
2309   mesh->supports[off+supportPos] = supportPoint;
2310   PetscFunctionReturn(0);
2311 }
2312 
2313 /*@C
2314   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the DAG
2315 
2316   Not collective
2317 
2318   Input Parameters:
2319 + mesh - The DMPlex
2320 . p - The point, which must lie in the chart set with DMPlexSetChart()
2321 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2322 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
2323 
2324   Output Parameters:
2325 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
2326 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
2327 
2328   Note:
2329   If using internal storage (points is NULL on input), each call overwrites the last output.
2330 
2331   Fortran Notes:
2332   Since it returns an array, this routine is only available in Fortran 90, and you must
2333   include petsc.h90 in your code.
2334 
2335   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2336 
2337   Level: beginner
2338 
2339 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2340 @*/
2341 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2342 {
2343   DM_Plex        *mesh = (DM_Plex*) dm->data;
2344   PetscInt       *closure, *fifo;
2345   const PetscInt *tmp = NULL, *tmpO = NULL;
2346   PetscInt        tmpSize, t;
2347   PetscInt        depth       = 0, maxSize;
2348   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
2349   PetscErrorCode  ierr;
2350 
2351   PetscFunctionBegin;
2352   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2353   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2354   /* This is only 1-level */
2355   if (useCone) {
2356     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
2357     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
2358     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
2359   } else {
2360     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
2361     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
2362   }
2363   if (depth == 1) {
2364     if (*points) {
2365       closure = *points;
2366     } else {
2367       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
2368       ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2369     }
2370     closure[0] = p; closure[1] = 0;
2371     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
2372       closure[closureSize]   = tmp[t];
2373       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
2374     }
2375     if (numPoints) *numPoints = closureSize/2;
2376     if (points)    *points    = closure;
2377     PetscFunctionReturn(0);
2378   }
2379   {
2380     PetscInt c, coneSeries, s,supportSeries;
2381 
2382     c = mesh->maxConeSize;
2383     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
2384     s = mesh->maxSupportSize;
2385     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
2386     maxSize = 2*PetscMax(coneSeries,supportSeries);
2387   }
2388   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2389   if (*points) {
2390     closure = *points;
2391   } else {
2392     ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2393   }
2394   closure[0] = p; closure[1] = 0;
2395   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
2396     const PetscInt cp = tmp[t];
2397     const PetscInt co = tmpO ? tmpO[t] : 0;
2398 
2399     closure[closureSize]   = cp;
2400     closure[closureSize+1] = co;
2401     fifo[fifoSize]         = cp;
2402     fifo[fifoSize+1]       = co;
2403   }
2404   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
2405   while (fifoSize - fifoStart) {
2406     const PetscInt q   = fifo[fifoStart];
2407     const PetscInt o   = fifo[fifoStart+1];
2408     const PetscInt rev = o >= 0 ? 0 : 1;
2409     const PetscInt off = rev ? -(o+1) : o;
2410 
2411     if (useCone) {
2412       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
2413       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
2414       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
2415     } else {
2416       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
2417       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
2418       tmpO = NULL;
2419     }
2420     for (t = 0; t < tmpSize; ++t) {
2421       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
2422       const PetscInt cp = tmp[i];
2423       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
2424       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
2425        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
2426       PetscInt       co = tmpO ? tmpO[i] : 0;
2427       PetscInt       c;
2428 
2429       if (rev) {
2430         PetscInt childSize, coff;
2431         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2432         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
2433         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2434       }
2435       /* Check for duplicate */
2436       for (c = 0; c < closureSize; c += 2) {
2437         if (closure[c] == cp) break;
2438       }
2439       if (c == closureSize) {
2440         closure[closureSize]   = cp;
2441         closure[closureSize+1] = co;
2442         fifo[fifoSize]         = cp;
2443         fifo[fifoSize+1]       = co;
2444         closureSize           += 2;
2445         fifoSize              += 2;
2446       }
2447     }
2448     fifoStart += 2;
2449   }
2450   if (numPoints) *numPoints = closureSize/2;
2451   if (points)    *points    = closure;
2452   ierr = DMRestoreWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2453   PetscFunctionReturn(0);
2454 }
2455 
2456 /*@C
2457   DMPlexGetTransitiveClosure_Internal - Return the points on the transitive closure of the in-edges or out-edges for this point in the DAG with a specified initial orientation
2458 
2459   Not collective
2460 
2461   Input Parameters:
2462 + mesh - The DMPlex
2463 . p - The point, which must lie in the chart set with DMPlexSetChart()
2464 . orientation - The orientation of the point
2465 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2466 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
2467 
2468   Output Parameters:
2469 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
2470 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
2471 
2472   Note:
2473   If using internal storage (points is NULL on input), each call overwrites the last output.
2474 
2475   Fortran Notes:
2476   Since it returns an array, this routine is only available in Fortran 90, and you must
2477   include petsc.h90 in your code.
2478 
2479   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2480 
2481   Level: beginner
2482 
2483 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2484 @*/
2485 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM dm, PetscInt p, PetscInt ornt, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2486 {
2487   DM_Plex        *mesh = (DM_Plex*) dm->data;
2488   PetscInt       *closure, *fifo;
2489   const PetscInt *tmp = NULL, *tmpO = NULL;
2490   PetscInt        tmpSize, t;
2491   PetscInt        depth       = 0, maxSize;
2492   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
2493   PetscErrorCode  ierr;
2494 
2495   PetscFunctionBegin;
2496   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2497   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2498   /* This is only 1-level */
2499   if (useCone) {
2500     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
2501     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
2502     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
2503   } else {
2504     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
2505     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
2506   }
2507   if (depth == 1) {
2508     if (*points) {
2509       closure = *points;
2510     } else {
2511       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
2512       ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2513     }
2514     closure[0] = p; closure[1] = ornt;
2515     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
2516       const PetscInt i = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
2517       closure[closureSize]   = tmp[i];
2518       closure[closureSize+1] = tmpO ? tmpO[i] : 0;
2519     }
2520     if (numPoints) *numPoints = closureSize/2;
2521     if (points)    *points    = closure;
2522     PetscFunctionReturn(0);
2523   }
2524   {
2525     PetscInt c, coneSeries, s,supportSeries;
2526 
2527     c = mesh->maxConeSize;
2528     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
2529     s = mesh->maxSupportSize;
2530     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
2531     maxSize = 2*PetscMax(coneSeries,supportSeries);
2532   }
2533   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2534   if (*points) {
2535     closure = *points;
2536   } else {
2537     ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2538   }
2539   closure[0] = p; closure[1] = ornt;
2540   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
2541     const PetscInt i  = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
2542     const PetscInt cp = tmp[i];
2543     PetscInt       co = tmpO ? tmpO[i] : 0;
2544 
2545     if (ornt < 0) {
2546       PetscInt childSize, coff;
2547       ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2548       coff = co < 0 ? -(tmpO[i]+1) : tmpO[i];
2549       co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2550     }
2551     closure[closureSize]   = cp;
2552     closure[closureSize+1] = co;
2553     fifo[fifoSize]         = cp;
2554     fifo[fifoSize+1]       = co;
2555   }
2556   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
2557   while (fifoSize - fifoStart) {
2558     const PetscInt q   = fifo[fifoStart];
2559     const PetscInt o   = fifo[fifoStart+1];
2560     const PetscInt rev = o >= 0 ? 0 : 1;
2561     const PetscInt off = rev ? -(o+1) : o;
2562 
2563     if (useCone) {
2564       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
2565       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
2566       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
2567     } else {
2568       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
2569       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
2570       tmpO = NULL;
2571     }
2572     for (t = 0; t < tmpSize; ++t) {
2573       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
2574       const PetscInt cp = tmp[i];
2575       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
2576       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
2577        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
2578       PetscInt       co = tmpO ? tmpO[i] : 0;
2579       PetscInt       c;
2580 
2581       if (rev) {
2582         PetscInt childSize, coff;
2583         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2584         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
2585         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2586       }
2587       /* Check for duplicate */
2588       for (c = 0; c < closureSize; c += 2) {
2589         if (closure[c] == cp) break;
2590       }
2591       if (c == closureSize) {
2592         closure[closureSize]   = cp;
2593         closure[closureSize+1] = co;
2594         fifo[fifoSize]         = cp;
2595         fifo[fifoSize+1]       = co;
2596         closureSize           += 2;
2597         fifoSize              += 2;
2598       }
2599     }
2600     fifoStart += 2;
2601   }
2602   if (numPoints) *numPoints = closureSize/2;
2603   if (points)    *points    = closure;
2604   ierr = DMRestoreWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2605   PetscFunctionReturn(0);
2606 }
2607 
2608 /*@C
2609   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the DAG
2610 
2611   Not collective
2612 
2613   Input Parameters:
2614 + mesh - The DMPlex
2615 . p - The point, which must lie in the chart set with DMPlexSetChart()
2616 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2617 . numPoints - The number of points in the closure, so points[] is of size 2*numPoints, zeroed on exit
2618 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...], zeroed on exit
2619 
2620   Note:
2621   If not using internal storage (points is not NULL on input), this call is unnecessary
2622 
2623   Fortran Notes:
2624   Since it returns an array, this routine is only available in Fortran 90, and you must
2625   include petsc.h90 in your code.
2626 
2627   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2628 
2629   Level: beginner
2630 
2631 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2632 @*/
2633 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2634 {
2635   PetscErrorCode ierr;
2636 
2637   PetscFunctionBegin;
2638   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2639   if (numPoints) PetscValidIntPointer(numPoints,4);
2640   if (points) PetscValidPointer(points,5);
2641   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, points);CHKERRQ(ierr);
2642   if (numPoints) *numPoints = 0;
2643   PetscFunctionReturn(0);
2644 }
2645 
2646 /*@
2647   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the DAG
2648 
2649   Not collective
2650 
2651   Input Parameter:
2652 . mesh - The DMPlex
2653 
2654   Output Parameters:
2655 + maxConeSize - The maximum number of in-edges
2656 - maxSupportSize - The maximum number of out-edges
2657 
2658   Level: beginner
2659 
2660 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
2661 @*/
2662 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
2663 {
2664   DM_Plex *mesh = (DM_Plex*) dm->data;
2665 
2666   PetscFunctionBegin;
2667   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2668   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
2669   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
2670   PetscFunctionReturn(0);
2671 }
2672 
2673 PetscErrorCode DMSetUp_Plex(DM dm)
2674 {
2675   DM_Plex       *mesh = (DM_Plex*) dm->data;
2676   PetscInt       size;
2677   PetscErrorCode ierr;
2678 
2679   PetscFunctionBegin;
2680   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2681   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
2682   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
2683   ierr = PetscMalloc1(size, &mesh->cones);CHKERRQ(ierr);
2684   ierr = PetscCalloc1(size, &mesh->coneOrientations);CHKERRQ(ierr);
2685   ierr = PetscLogObjectMemory((PetscObject) dm, size*2*sizeof(PetscInt));CHKERRQ(ierr);
2686   if (mesh->maxSupportSize) {
2687     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2688     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
2689     ierr = PetscMalloc1(size, &mesh->supports);CHKERRQ(ierr);
2690     ierr = PetscLogObjectMemory((PetscObject) dm, size*sizeof(PetscInt));CHKERRQ(ierr);
2691   }
2692   PetscFunctionReturn(0);
2693 }
2694 
2695 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, const PetscInt fields[], IS *is, DM *subdm)
2696 {
2697   PetscErrorCode ierr;
2698 
2699   PetscFunctionBegin;
2700   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
2701   ierr = DMCreateSectionSubDM(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
2702   if (subdm) {(*subdm)->useNatural = dm->useNatural;}
2703   if (dm->useNatural && dm->sfMigration) {
2704     PetscSF        sfMigrationInv,sfNatural;
2705     PetscSection   section, sectionSeq;
2706 
2707     (*subdm)->sfMigration = dm->sfMigration;
2708     ierr = PetscObjectReference((PetscObject) dm->sfMigration);CHKERRQ(ierr);
2709     ierr = DMGetLocalSection((*subdm), &section);CHKERRQ(ierr);
2710     ierr = PetscSFCreateInverseSF((*subdm)->sfMigration, &sfMigrationInv);CHKERRQ(ierr);
2711     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) (*subdm)), &sectionSeq);CHKERRQ(ierr);
2712     ierr = PetscSFDistributeSection(sfMigrationInv, section, NULL, sectionSeq);CHKERRQ(ierr);
2713 
2714     ierr = DMPlexCreateGlobalToNaturalSF(*subdm, sectionSeq, (*subdm)->sfMigration, &sfNatural);CHKERRQ(ierr);
2715     (*subdm)->sfNatural = sfNatural;
2716     ierr = PetscSectionDestroy(&sectionSeq);CHKERRQ(ierr);
2717     ierr = PetscSFDestroy(&sfMigrationInv);CHKERRQ(ierr);
2718   }
2719   PetscFunctionReturn(0);
2720 }
2721 
2722 PetscErrorCode DMCreateSuperDM_Plex(DM dms[], PetscInt len, IS **is, DM *superdm)
2723 {
2724   PetscErrorCode ierr;
2725   PetscInt       i = 0;
2726 
2727   PetscFunctionBegin;
2728   ierr = DMClone(dms[0], superdm);CHKERRQ(ierr);
2729   ierr = DMCreateSectionSuperDM(dms, len, is, superdm);CHKERRQ(ierr);
2730   (*superdm)->useNatural = PETSC_FALSE;
2731   for (i = 0; i < len; i++){
2732     if (dms[i]->useNatural && dms[i]->sfMigration) {
2733       PetscSF        sfMigrationInv,sfNatural;
2734       PetscSection   section, sectionSeq;
2735 
2736       (*superdm)->sfMigration = dms[i]->sfMigration;
2737       ierr = PetscObjectReference((PetscObject) dms[i]->sfMigration);CHKERRQ(ierr);
2738       (*superdm)->useNatural = PETSC_TRUE;
2739       ierr = DMGetLocalSection((*superdm), &section);CHKERRQ(ierr);
2740       ierr = PetscSFCreateInverseSF((*superdm)->sfMigration, &sfMigrationInv);CHKERRQ(ierr);
2741       ierr = PetscSectionCreate(PetscObjectComm((PetscObject) (*superdm)), &sectionSeq);CHKERRQ(ierr);
2742       ierr = PetscSFDistributeSection(sfMigrationInv, section, NULL, sectionSeq);CHKERRQ(ierr);
2743 
2744       ierr = DMPlexCreateGlobalToNaturalSF(*superdm, sectionSeq, (*superdm)->sfMigration, &sfNatural);CHKERRQ(ierr);
2745       (*superdm)->sfNatural = sfNatural;
2746       ierr = PetscSectionDestroy(&sectionSeq);CHKERRQ(ierr);
2747       ierr = PetscSFDestroy(&sfMigrationInv);CHKERRQ(ierr);
2748       break;
2749     }
2750   }
2751   PetscFunctionReturn(0);
2752 }
2753 
2754 /*@
2755   DMPlexSymmetrize - Create support (out-edge) information from cone (in-edge) information
2756 
2757   Not collective
2758 
2759   Input Parameter:
2760 . mesh - The DMPlex
2761 
2762   Output Parameter:
2763 
2764   Note:
2765   This should be called after all calls to DMPlexSetCone()
2766 
2767   Level: beginner
2768 
2769 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
2770 @*/
2771 PetscErrorCode DMPlexSymmetrize(DM dm)
2772 {
2773   DM_Plex       *mesh = (DM_Plex*) dm->data;
2774   PetscInt      *offsets;
2775   PetscInt       supportSize;
2776   PetscInt       pStart, pEnd, p;
2777   PetscErrorCode ierr;
2778 
2779   PetscFunctionBegin;
2780   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2781   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
2782   ierr = PetscLogEventBegin(DMPLEX_Symmetrize,dm,0,0,0);CHKERRQ(ierr);
2783   /* Calculate support sizes */
2784   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2785   for (p = pStart; p < pEnd; ++p) {
2786     PetscInt dof, off, c;
2787 
2788     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2789     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2790     for (c = off; c < off+dof; ++c) {
2791       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
2792     }
2793   }
2794   for (p = pStart; p < pEnd; ++p) {
2795     PetscInt dof;
2796 
2797     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2798 
2799     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
2800   }
2801   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2802   /* Calculate supports */
2803   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
2804   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
2805   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
2806   for (p = pStart; p < pEnd; ++p) {
2807     PetscInt dof, off, c;
2808 
2809     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2810     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2811     for (c = off; c < off+dof; ++c) {
2812       const PetscInt q = mesh->cones[c];
2813       PetscInt       offS;
2814 
2815       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
2816 
2817       mesh->supports[offS+offsets[q]] = p;
2818       ++offsets[q];
2819     }
2820   }
2821   ierr = PetscFree(offsets);CHKERRQ(ierr);
2822   ierr = PetscLogEventEnd(DMPLEX_Symmetrize,dm,0,0,0);CHKERRQ(ierr);
2823   PetscFunctionReturn(0);
2824 }
2825 
2826 static PetscErrorCode DMPlexCreateDepthStratum(DM dm, DMLabel label, PetscInt depth, PetscInt pStart, PetscInt pEnd)
2827 {
2828   IS             stratumIS;
2829   PetscErrorCode ierr;
2830 
2831   PetscFunctionBegin;
2832   if (pStart >= pEnd) PetscFunctionReturn(0);
2833   if (PetscDefined(USE_DEBUG)) {
2834     PetscInt  qStart, qEnd, numLevels, level;
2835     PetscBool overlap = PETSC_FALSE;
2836     ierr = DMLabelGetNumValues(label, &numLevels);CHKERRQ(ierr);
2837     for (level = 0; level < numLevels; level++) {
2838       ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2839       if ((pStart >= qStart && pStart < qEnd) || (pEnd > qStart && pEnd <= qEnd)) {overlap = PETSC_TRUE; break;}
2840     }
2841     if (overlap) SETERRQ6(PETSC_COMM_SELF, PETSC_ERR_PLIB, "New depth %D range [%D,%D) overlaps with depth %D range [%D,%D)", depth, pStart, pEnd, level, qStart, qEnd);
2842   }
2843   ierr = ISCreateStride(PETSC_COMM_SELF, pEnd-pStart, pStart, 1, &stratumIS);CHKERRQ(ierr);
2844   ierr = DMLabelSetStratumIS(label, depth, stratumIS);CHKERRQ(ierr);
2845   ierr = ISDestroy(&stratumIS);CHKERRQ(ierr);
2846   PetscFunctionReturn(0);
2847 }
2848 
2849 /*@
2850   DMPlexStratify - The DAG for most topologies is a graded poset (https://en.wikipedia.org/wiki/Graded_poset), and
2851   can be illustrated by a Hasse Diagram (https://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
2852   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
2853   the DAG.
2854 
2855   Collective on dm
2856 
2857   Input Parameter:
2858 . mesh - The DMPlex
2859 
2860   Output Parameter:
2861 
2862   Notes:
2863   Concretely, DMPlexStratify() creates a new label named "depth" containing the depth in the DAG of each point. For cell-vertex
2864   meshes, vertices are depth 0 and cells are depth 1. For fully interpolated meshes, depth 0 for vertices, 1 for edges, and so on
2865   until cells have depth equal to the dimension of the mesh. The depth label can be accessed through DMPlexGetDepthLabel() or DMPlexGetDepthStratum(), or
2866   manually via DMGetLabel().  The height is defined implicitly by height = maxDimension - depth, and can be accessed
2867   via DMPlexGetHeightStratum().  For example, cells have height 0 and faces have height 1.
2868 
2869   The depth of a point is calculated by executing a breadth-first search (BFS) on the DAG. This could produce surprising results
2870   if run on a partially interpolated mesh, meaning one that had some edges and faces, but not others. For example, suppose that
2871   we had a mesh consisting of one triangle (c0) and three vertices (v0, v1, v2), and only one edge is on the boundary so we choose
2872   to interpolate only that one (e0), so that
2873 $  cone(c0) = {e0, v2}
2874 $  cone(e0) = {v0, v1}
2875   If DMPlexStratify() is run on this mesh, it will give depths
2876 $  depth 0 = {v0, v1, v2}
2877 $  depth 1 = {e0, c0}
2878   where the triangle has been given depth 1, instead of 2, because it is reachable from vertex v2.
2879 
2880   DMPlexStratify() should be called after all calls to DMPlexSymmetrize()
2881 
2882   Level: beginner
2883 
2884 .seealso: DMPlexCreate(), DMPlexSymmetrize(), DMPlexComputeCellTypes()
2885 @*/
2886 PetscErrorCode DMPlexStratify(DM dm)
2887 {
2888   DM_Plex       *mesh = (DM_Plex*) dm->data;
2889   DMLabel        label;
2890   PetscInt       pStart, pEnd, p;
2891   PetscInt       numRoots = 0, numLeaves = 0;
2892   PetscErrorCode ierr;
2893 
2894   PetscFunctionBegin;
2895   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2896   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2897 
2898   /* Create depth label */
2899   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2900   ierr = DMCreateLabel(dm, "depth");CHKERRQ(ierr);
2901   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2902 
2903   {
2904     /* Initialize roots and count leaves */
2905     PetscInt sMin = PETSC_MAX_INT;
2906     PetscInt sMax = PETSC_MIN_INT;
2907     PetscInt coneSize, supportSize;
2908 
2909     for (p = pStart; p < pEnd; ++p) {
2910       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2911       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2912       if (!coneSize && supportSize) {
2913         sMin = PetscMin(p, sMin);
2914         sMax = PetscMax(p, sMax);
2915         ++numRoots;
2916       } else if (!supportSize && coneSize) {
2917         ++numLeaves;
2918       } else if (!supportSize && !coneSize) {
2919         /* Isolated points */
2920         sMin = PetscMin(p, sMin);
2921         sMax = PetscMax(p, sMax);
2922       }
2923     }
2924     ierr = DMPlexCreateDepthStratum(dm, label, 0, sMin, sMax+1);CHKERRQ(ierr);
2925   }
2926 
2927   if (numRoots + numLeaves == (pEnd - pStart)) {
2928     PetscInt sMin = PETSC_MAX_INT;
2929     PetscInt sMax = PETSC_MIN_INT;
2930     PetscInt coneSize, supportSize;
2931 
2932     for (p = pStart; p < pEnd; ++p) {
2933       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2934       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2935       if (!supportSize && coneSize) {
2936         sMin = PetscMin(p, sMin);
2937         sMax = PetscMax(p, sMax);
2938       }
2939     }
2940     ierr = DMPlexCreateDepthStratum(dm, label, 1, sMin, sMax+1);CHKERRQ(ierr);
2941   } else {
2942     PetscInt level = 0;
2943     PetscInt qStart, qEnd, q;
2944 
2945     ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2946     while (qEnd > qStart) {
2947       PetscInt sMin = PETSC_MAX_INT;
2948       PetscInt sMax = PETSC_MIN_INT;
2949 
2950       for (q = qStart; q < qEnd; ++q) {
2951         const PetscInt *support;
2952         PetscInt        supportSize, s;
2953 
2954         ierr = DMPlexGetSupportSize(dm, q, &supportSize);CHKERRQ(ierr);
2955         ierr = DMPlexGetSupport(dm, q, &support);CHKERRQ(ierr);
2956         for (s = 0; s < supportSize; ++s) {
2957           sMin = PetscMin(support[s], sMin);
2958           sMax = PetscMax(support[s], sMax);
2959         }
2960       }
2961       ierr = DMLabelGetNumValues(label, &level);CHKERRQ(ierr);
2962       ierr = DMPlexCreateDepthStratum(dm, label, level, sMin, sMax+1);CHKERRQ(ierr);
2963       ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2964     }
2965   }
2966   { /* just in case there is an empty process */
2967     PetscInt numValues, maxValues = 0, v;
2968 
2969     ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
2970     ierr = MPI_Allreduce(&numValues,&maxValues,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
2971     for (v = numValues; v < maxValues; v++) {
2972       ierr = DMLabelAddStratum(label, v);CHKERRQ(ierr);
2973     }
2974   }
2975   ierr = PetscObjectStateGet((PetscObject) label, &mesh->depthState);CHKERRQ(ierr);
2976   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2977   PetscFunctionReturn(0);
2978 }
2979 
2980 PetscErrorCode DMPlexComputeCellType_Internal(DM dm, PetscInt p, PetscInt pdepth, DMPolytopeType *pt)
2981 {
2982   DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
2983   PetscInt       dim, depth, pheight, coneSize;
2984   PetscErrorCode ierr;
2985 
2986   PetscFunctionBeginHot;
2987   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2988   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2989   ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2990   pheight = depth - pdepth;
2991   if (depth <= 1) {
2992     switch (pdepth) {
2993       case 0: ct = DM_POLYTOPE_POINT;break;
2994       case 1:
2995         switch (coneSize) {
2996           case 2: ct = DM_POLYTOPE_SEGMENT;break;
2997           case 3: ct = DM_POLYTOPE_TRIANGLE;break;
2998           case 4:
2999           switch (dim) {
3000             case 2: ct = DM_POLYTOPE_QUADRILATERAL;break;
3001             case 3: ct = DM_POLYTOPE_TETRAHEDRON;break;
3002             default: break;
3003           }
3004           break;
3005         case 5: ct = DM_POLYTOPE_PYRAMID;break;
3006         case 6: ct = DM_POLYTOPE_TRI_PRISM_TENSOR;break;
3007         case 8: ct = DM_POLYTOPE_HEXAHEDRON;break;
3008         default: break;
3009       }
3010     }
3011   } else {
3012     if (pdepth == 0) {
3013       ct = DM_POLYTOPE_POINT;
3014     } else if (pheight == 0) {
3015       switch (dim) {
3016         case 1:
3017           switch (coneSize) {
3018             case 2: ct = DM_POLYTOPE_SEGMENT;break;
3019             default: break;
3020           }
3021           break;
3022         case 2:
3023           switch (coneSize) {
3024             case 3: ct = DM_POLYTOPE_TRIANGLE;break;
3025             case 4: ct = DM_POLYTOPE_QUADRILATERAL;break;
3026             default: break;
3027           }
3028           break;
3029         case 3:
3030           switch (coneSize) {
3031             case 4: ct = DM_POLYTOPE_TETRAHEDRON;break;
3032             case 5:
3033             {
3034               const PetscInt *cone;
3035               PetscInt        faceConeSize;
3036 
3037               ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
3038               ierr = DMPlexGetConeSize(dm, cone[0], &faceConeSize);CHKERRQ(ierr);
3039               switch (faceConeSize) {
3040                 case 3: ct = DM_POLYTOPE_TRI_PRISM_TENSOR;break;
3041                 case 4: ct = DM_POLYTOPE_PYRAMID;break;
3042               }
3043             }
3044             break;
3045             case 6: ct = DM_POLYTOPE_HEXAHEDRON;break;
3046             default: break;
3047           }
3048           break;
3049         default: break;
3050       }
3051     } else if (pheight > 0) {
3052       switch (coneSize) {
3053         case 2: ct = DM_POLYTOPE_SEGMENT;break;
3054         case 3: ct = DM_POLYTOPE_TRIANGLE;break;
3055         case 4: ct = DM_POLYTOPE_QUADRILATERAL;break;
3056         default: break;
3057       }
3058     }
3059   }
3060   *pt = ct;
3061   PetscFunctionReturn(0);
3062 }
3063 
3064 /*@
3065   DMPlexComputeCellTypes - Infer the polytope type of every cell using its dimension and cone size.
3066 
3067   Collective on dm
3068 
3069   Input Parameter:
3070 . mesh - The DMPlex
3071 
3072   DMPlexComputeCellTypes() should be called after all calls to DMPlexSymmetrize() and DMPlexStratify()
3073 
3074   Level: developer
3075 
3076   Note: This function is normally called automatically by Plex when a cell type is requested. It creates an
3077   internal DMLabel named "celltype" which can be directly accessed using DMGetLabel(). A user may disable
3078   automatic creation by creating the label manually, using DMCreateLabel(dm, "celltype").
3079 
3080 .seealso: DMPlexCreate(), DMPlexSymmetrize(), DMPlexStratify(), DMGetLabel(), DMCreateLabel()
3081 @*/
3082 PetscErrorCode DMPlexComputeCellTypes(DM dm)
3083 {
3084   DM_Plex       *mesh;
3085   DMLabel        ctLabel;
3086   PetscInt       pStart, pEnd, p;
3087   PetscErrorCode ierr;
3088 
3089   PetscFunctionBegin;
3090   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3091   mesh = (DM_Plex *) dm->data;
3092   ierr = DMCreateLabel(dm, "celltype");CHKERRQ(ierr);
3093   ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
3094   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3095   for (p = pStart; p < pEnd; ++p) {
3096     DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
3097     PetscInt       pdepth;
3098 
3099     ierr = DMPlexGetPointDepth(dm, p, &pdepth);CHKERRQ(ierr);
3100     ierr = DMPlexComputeCellType_Internal(dm, p, pdepth, &ct);CHKERRQ(ierr);
3101     if (ct == DM_POLYTOPE_UNKNOWN) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Point %D is screwed up", p);
3102     ierr = DMLabelSetValue(ctLabel, p, ct);CHKERRQ(ierr);
3103   }
3104   ierr = PetscObjectStateGet((PetscObject) ctLabel, &mesh->celltypeState);CHKERRQ(ierr);
3105   ierr = PetscObjectViewFromOptions((PetscObject) ctLabel, NULL, "-dm_plex_celltypes_view");CHKERRQ(ierr);
3106   PetscFunctionReturn(0);
3107 }
3108 
3109 /*@C
3110   DMPlexGetJoin - Get an array for the join of the set of points
3111 
3112   Not Collective
3113 
3114   Input Parameters:
3115 + dm - The DMPlex object
3116 . numPoints - The number of input points for the join
3117 - points - The input points
3118 
3119   Output Parameters:
3120 + numCoveredPoints - The number of points in the join
3121 - coveredPoints - The points in the join
3122 
3123   Level: intermediate
3124 
3125   Note: Currently, this is restricted to a single level join
3126 
3127   Fortran Notes:
3128   Since it returns an array, this routine is only available in Fortran 90, and you must
3129   include petsc.h90 in your code.
3130 
3131   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3132 
3133 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
3134 @*/
3135 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3136 {
3137   DM_Plex       *mesh = (DM_Plex*) dm->data;
3138   PetscInt      *join[2];
3139   PetscInt       joinSize, i = 0;
3140   PetscInt       dof, off, p, c, m;
3141   PetscErrorCode ierr;
3142 
3143   PetscFunctionBegin;
3144   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3145   PetscValidIntPointer(points, 3);
3146   PetscValidIntPointer(numCoveredPoints, 4);
3147   PetscValidPointer(coveredPoints, 5);
3148   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
3149   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
3150   /* Copy in support of first point */
3151   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
3152   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
3153   for (joinSize = 0; joinSize < dof; ++joinSize) {
3154     join[i][joinSize] = mesh->supports[off+joinSize];
3155   }
3156   /* Check each successive support */
3157   for (p = 1; p < numPoints; ++p) {
3158     PetscInt newJoinSize = 0;
3159 
3160     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
3161     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
3162     for (c = 0; c < dof; ++c) {
3163       const PetscInt point = mesh->supports[off+c];
3164 
3165       for (m = 0; m < joinSize; ++m) {
3166         if (point == join[i][m]) {
3167           join[1-i][newJoinSize++] = point;
3168           break;
3169         }
3170       }
3171     }
3172     joinSize = newJoinSize;
3173     i        = 1-i;
3174   }
3175   *numCoveredPoints = joinSize;
3176   *coveredPoints    = join[i];
3177   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
3178   PetscFunctionReturn(0);
3179 }
3180 
3181 /*@C
3182   DMPlexRestoreJoin - Restore an array for the join of the set of points
3183 
3184   Not Collective
3185 
3186   Input Parameters:
3187 + dm - The DMPlex object
3188 . numPoints - The number of input points for the join
3189 - points - The input points
3190 
3191   Output Parameters:
3192 + numCoveredPoints - The number of points in the join
3193 - coveredPoints - The points in the join
3194 
3195   Fortran Notes:
3196   Since it returns an array, this routine is only available in Fortran 90, and you must
3197   include petsc.h90 in your code.
3198 
3199   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3200 
3201   Level: intermediate
3202 
3203 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
3204 @*/
3205 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3206 {
3207   PetscErrorCode ierr;
3208 
3209   PetscFunctionBegin;
3210   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3211   if (points) PetscValidIntPointer(points,3);
3212   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
3213   PetscValidPointer(coveredPoints, 5);
3214   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
3215   if (numCoveredPoints) *numCoveredPoints = 0;
3216   PetscFunctionReturn(0);
3217 }
3218 
3219 /*@C
3220   DMPlexGetFullJoin - Get an array for the join of the set of points
3221 
3222   Not Collective
3223 
3224   Input Parameters:
3225 + dm - The DMPlex object
3226 . numPoints - The number of input points for the join
3227 - points - The input points
3228 
3229   Output Parameters:
3230 + numCoveredPoints - The number of points in the join
3231 - coveredPoints - The points in the join
3232 
3233   Fortran Notes:
3234   Since it returns an array, this routine is only available in Fortran 90, and you must
3235   include petsc.h90 in your code.
3236 
3237   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3238 
3239   Level: intermediate
3240 
3241 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
3242 @*/
3243 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3244 {
3245   DM_Plex       *mesh = (DM_Plex*) dm->data;
3246   PetscInt      *offsets, **closures;
3247   PetscInt      *join[2];
3248   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
3249   PetscInt       p, d, c, m, ms;
3250   PetscErrorCode ierr;
3251 
3252   PetscFunctionBegin;
3253   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3254   PetscValidIntPointer(points, 3);
3255   PetscValidIntPointer(numCoveredPoints, 4);
3256   PetscValidPointer(coveredPoints, 5);
3257 
3258   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3259   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
3260   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3261   ms      = mesh->maxSupportSize;
3262   maxSize = (ms > 1) ? ((PetscPowInt(ms,depth+1)-1)/(ms-1)) : depth + 1;
3263   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
3264   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
3265 
3266   for (p = 0; p < numPoints; ++p) {
3267     PetscInt closureSize;
3268 
3269     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
3270 
3271     offsets[p*(depth+2)+0] = 0;
3272     for (d = 0; d < depth+1; ++d) {
3273       PetscInt pStart, pEnd, i;
3274 
3275       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
3276       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
3277         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
3278           offsets[p*(depth+2)+d+1] = i;
3279           break;
3280         }
3281       }
3282       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
3283     }
3284     if (offsets[p*(depth+2)+depth+1] != closureSize) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Total size of closure %D should be %D", offsets[p*(depth+2)+depth+1], closureSize);
3285   }
3286   for (d = 0; d < depth+1; ++d) {
3287     PetscInt dof;
3288 
3289     /* Copy in support of first point */
3290     dof = offsets[d+1] - offsets[d];
3291     for (joinSize = 0; joinSize < dof; ++joinSize) {
3292       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
3293     }
3294     /* Check each successive cone */
3295     for (p = 1; p < numPoints && joinSize; ++p) {
3296       PetscInt newJoinSize = 0;
3297 
3298       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
3299       for (c = 0; c < dof; ++c) {
3300         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
3301 
3302         for (m = 0; m < joinSize; ++m) {
3303           if (point == join[i][m]) {
3304             join[1-i][newJoinSize++] = point;
3305             break;
3306           }
3307         }
3308       }
3309       joinSize = newJoinSize;
3310       i        = 1-i;
3311     }
3312     if (joinSize) break;
3313   }
3314   *numCoveredPoints = joinSize;
3315   *coveredPoints    = join[i];
3316   for (p = 0; p < numPoints; ++p) {
3317     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
3318   }
3319   ierr = PetscFree(closures);CHKERRQ(ierr);
3320   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3321   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
3322   PetscFunctionReturn(0);
3323 }
3324 
3325 /*@C
3326   DMPlexGetMeet - Get an array for the meet of the set of points
3327 
3328   Not Collective
3329 
3330   Input Parameters:
3331 + dm - The DMPlex object
3332 . numPoints - The number of input points for the meet
3333 - points - The input points
3334 
3335   Output Parameters:
3336 + numCoveredPoints - The number of points in the meet
3337 - coveredPoints - The points in the meet
3338 
3339   Level: intermediate
3340 
3341   Note: Currently, this is restricted to a single level meet
3342 
3343   Fortran Notes:
3344   Since it returns an array, this routine is only available in Fortran 90, and you must
3345   include petsc.h90 in your code.
3346 
3347   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3348 
3349 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
3350 @*/
3351 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
3352 {
3353   DM_Plex       *mesh = (DM_Plex*) dm->data;
3354   PetscInt      *meet[2];
3355   PetscInt       meetSize, i = 0;
3356   PetscInt       dof, off, p, c, m;
3357   PetscErrorCode ierr;
3358 
3359   PetscFunctionBegin;
3360   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3361   PetscValidPointer(points, 2);
3362   PetscValidPointer(numCoveringPoints, 3);
3363   PetscValidPointer(coveringPoints, 4);
3364   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
3365   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
3366   /* Copy in cone of first point */
3367   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
3368   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
3369   for (meetSize = 0; meetSize < dof; ++meetSize) {
3370     meet[i][meetSize] = mesh->cones[off+meetSize];
3371   }
3372   /* Check each successive cone */
3373   for (p = 1; p < numPoints; ++p) {
3374     PetscInt newMeetSize = 0;
3375 
3376     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
3377     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
3378     for (c = 0; c < dof; ++c) {
3379       const PetscInt point = mesh->cones[off+c];
3380 
3381       for (m = 0; m < meetSize; ++m) {
3382         if (point == meet[i][m]) {
3383           meet[1-i][newMeetSize++] = point;
3384           break;
3385         }
3386       }
3387     }
3388     meetSize = newMeetSize;
3389     i        = 1-i;
3390   }
3391   *numCoveringPoints = meetSize;
3392   *coveringPoints    = meet[i];
3393   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
3394   PetscFunctionReturn(0);
3395 }
3396 
3397 /*@C
3398   DMPlexRestoreMeet - Restore an array for the meet of the set of points
3399 
3400   Not Collective
3401 
3402   Input Parameters:
3403 + dm - The DMPlex object
3404 . numPoints - The number of input points for the meet
3405 - points - The input points
3406 
3407   Output Parameters:
3408 + numCoveredPoints - The number of points in the meet
3409 - coveredPoints - The points in the meet
3410 
3411   Level: intermediate
3412 
3413   Fortran Notes:
3414   Since it returns an array, this routine is only available in Fortran 90, and you must
3415   include petsc.h90 in your code.
3416 
3417   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3418 
3419 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
3420 @*/
3421 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3422 {
3423   PetscErrorCode ierr;
3424 
3425   PetscFunctionBegin;
3426   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3427   if (points) PetscValidIntPointer(points,3);
3428   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
3429   PetscValidPointer(coveredPoints,5);
3430   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
3431   if (numCoveredPoints) *numCoveredPoints = 0;
3432   PetscFunctionReturn(0);
3433 }
3434 
3435 /*@C
3436   DMPlexGetFullMeet - Get an array for the meet of the set of points
3437 
3438   Not Collective
3439 
3440   Input Parameters:
3441 + dm - The DMPlex object
3442 . numPoints - The number of input points for the meet
3443 - points - The input points
3444 
3445   Output Parameters:
3446 + numCoveredPoints - The number of points in the meet
3447 - coveredPoints - The points in the meet
3448 
3449   Level: intermediate
3450 
3451   Fortran Notes:
3452   Since it returns an array, this routine is only available in Fortran 90, and you must
3453   include petsc.h90 in your code.
3454 
3455   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3456 
3457 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
3458 @*/
3459 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3460 {
3461   DM_Plex       *mesh = (DM_Plex*) dm->data;
3462   PetscInt      *offsets, **closures;
3463   PetscInt      *meet[2];
3464   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
3465   PetscInt       p, h, c, m, mc;
3466   PetscErrorCode ierr;
3467 
3468   PetscFunctionBegin;
3469   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3470   PetscValidPointer(points, 2);
3471   PetscValidPointer(numCoveredPoints, 3);
3472   PetscValidPointer(coveredPoints, 4);
3473 
3474   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
3475   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
3476   ierr    = DMGetWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3477   mc      = mesh->maxConeSize;
3478   maxSize = (mc > 1) ? ((PetscPowInt(mc,height+1)-1)/(mc-1)) : height + 1;
3479   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
3480   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
3481 
3482   for (p = 0; p < numPoints; ++p) {
3483     PetscInt closureSize;
3484 
3485     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
3486 
3487     offsets[p*(height+2)+0] = 0;
3488     for (h = 0; h < height+1; ++h) {
3489       PetscInt pStart, pEnd, i;
3490 
3491       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
3492       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
3493         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
3494           offsets[p*(height+2)+h+1] = i;
3495           break;
3496         }
3497       }
3498       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
3499     }
3500     if (offsets[p*(height+2)+height+1] != closureSize) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Total size of closure %D should be %D", offsets[p*(height+2)+height+1], closureSize);
3501   }
3502   for (h = 0; h < height+1; ++h) {
3503     PetscInt dof;
3504 
3505     /* Copy in cone of first point */
3506     dof = offsets[h+1] - offsets[h];
3507     for (meetSize = 0; meetSize < dof; ++meetSize) {
3508       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
3509     }
3510     /* Check each successive cone */
3511     for (p = 1; p < numPoints && meetSize; ++p) {
3512       PetscInt newMeetSize = 0;
3513 
3514       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
3515       for (c = 0; c < dof; ++c) {
3516         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
3517 
3518         for (m = 0; m < meetSize; ++m) {
3519           if (point == meet[i][m]) {
3520             meet[1-i][newMeetSize++] = point;
3521             break;
3522           }
3523         }
3524       }
3525       meetSize = newMeetSize;
3526       i        = 1-i;
3527     }
3528     if (meetSize) break;
3529   }
3530   *numCoveredPoints = meetSize;
3531   *coveredPoints    = meet[i];
3532   for (p = 0; p < numPoints; ++p) {
3533     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
3534   }
3535   ierr = PetscFree(closures);CHKERRQ(ierr);
3536   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3537   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
3538   PetscFunctionReturn(0);
3539 }
3540 
3541 /*@C
3542   DMPlexEqual - Determine if two DMs have the same topology
3543 
3544   Not Collective
3545 
3546   Input Parameters:
3547 + dmA - A DMPlex object
3548 - dmB - A DMPlex object
3549 
3550   Output Parameters:
3551 . equal - PETSC_TRUE if the topologies are identical
3552 
3553   Level: intermediate
3554 
3555   Notes:
3556   We are not solving graph isomorphism, so we do not permutation.
3557 
3558 .seealso: DMPlexGetCone()
3559 @*/
3560 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
3561 {
3562   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
3563   PetscErrorCode ierr;
3564 
3565   PetscFunctionBegin;
3566   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
3567   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
3568   PetscValidPointer(equal, 3);
3569 
3570   *equal = PETSC_FALSE;
3571   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
3572   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
3573   if (depth != depthB) PetscFunctionReturn(0);
3574   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
3575   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
3576   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
3577   for (p = pStart; p < pEnd; ++p) {
3578     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
3579     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
3580 
3581     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
3582     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
3583     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
3584     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
3585     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
3586     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
3587     if (coneSize != coneSizeB) PetscFunctionReturn(0);
3588     for (c = 0; c < coneSize; ++c) {
3589       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
3590       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
3591     }
3592     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
3593     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
3594     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
3595     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
3596     if (supportSize != supportSizeB) PetscFunctionReturn(0);
3597     for (s = 0; s < supportSize; ++s) {
3598       if (support[s] != supportB[s]) PetscFunctionReturn(0);
3599     }
3600   }
3601   *equal = PETSC_TRUE;
3602   PetscFunctionReturn(0);
3603 }
3604 
3605 /*@C
3606   DMPlexGetNumFaceVertices - Returns the number of vertices on a face
3607 
3608   Not Collective
3609 
3610   Input Parameters:
3611 + dm         - The DMPlex
3612 . cellDim    - The cell dimension
3613 - numCorners - The number of vertices on a cell
3614 
3615   Output Parameters:
3616 . numFaceVertices - The number of vertices on a face
3617 
3618   Level: developer
3619 
3620   Notes:
3621   Of course this can only work for a restricted set of symmetric shapes
3622 
3623 .seealso: DMPlexGetCone()
3624 @*/
3625 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
3626 {
3627   MPI_Comm       comm;
3628   PetscErrorCode ierr;
3629 
3630   PetscFunctionBegin;
3631   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3632   PetscValidPointer(numFaceVertices,3);
3633   switch (cellDim) {
3634   case 0:
3635     *numFaceVertices = 0;
3636     break;
3637   case 1:
3638     *numFaceVertices = 1;
3639     break;
3640   case 2:
3641     switch (numCorners) {
3642     case 3: /* triangle */
3643       *numFaceVertices = 2; /* Edge has 2 vertices */
3644       break;
3645     case 4: /* quadrilateral */
3646       *numFaceVertices = 2; /* Edge has 2 vertices */
3647       break;
3648     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
3649       *numFaceVertices = 3; /* Edge has 3 vertices */
3650       break;
3651     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
3652       *numFaceVertices = 3; /* Edge has 3 vertices */
3653       break;
3654     default:
3655       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
3656     }
3657     break;
3658   case 3:
3659     switch (numCorners) {
3660     case 4: /* tetradehdron */
3661       *numFaceVertices = 3; /* Face has 3 vertices */
3662       break;
3663     case 6: /* tet cohesive cells */
3664       *numFaceVertices = 4; /* Face has 4 vertices */
3665       break;
3666     case 8: /* hexahedron */
3667       *numFaceVertices = 4; /* Face has 4 vertices */
3668       break;
3669     case 9: /* tet cohesive Lagrange cells */
3670       *numFaceVertices = 6; /* Face has 6 vertices */
3671       break;
3672     case 10: /* quadratic tetrahedron */
3673       *numFaceVertices = 6; /* Face has 6 vertices */
3674       break;
3675     case 12: /* hex cohesive Lagrange cells */
3676       *numFaceVertices = 6; /* Face has 6 vertices */
3677       break;
3678     case 18: /* quadratic tet cohesive Lagrange cells */
3679       *numFaceVertices = 6; /* Face has 6 vertices */
3680       break;
3681     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
3682       *numFaceVertices = 9; /* Face has 9 vertices */
3683       break;
3684     default:
3685       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
3686     }
3687     break;
3688   default:
3689     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %D", cellDim);
3690   }
3691   PetscFunctionReturn(0);
3692 }
3693 
3694 /*@
3695   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
3696 
3697   Not Collective
3698 
3699   Input Parameter:
3700 . dm    - The DMPlex object
3701 
3702   Output Parameter:
3703 . depthLabel - The DMLabel recording point depth
3704 
3705   Level: developer
3706 
3707 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum(), DMPlexGetPointDepth(),
3708 @*/
3709 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
3710 {
3711   PetscFunctionBegin;
3712   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3713   PetscValidPointer(depthLabel, 2);
3714   *depthLabel = dm->depthLabel;
3715   PetscFunctionReturn(0);
3716 }
3717 
3718 /*@
3719   DMPlexGetDepth - Get the depth of the DAG representing this mesh
3720 
3721   Not Collective
3722 
3723   Input Parameter:
3724 . dm    - The DMPlex object
3725 
3726   Output Parameter:
3727 . depth - The number of strata (breadth first levels) in the DAG
3728 
3729   Level: developer
3730 
3731   Notes:
3732   This returns maximum of point depths over all points, i.e. maximum value of the label returned by DMPlexGetDepthLabel().
3733   The point depth is described more in detail in DMPlexGetDepthStratum().
3734   An empty mesh gives -1.
3735 
3736 .seealso: DMPlexGetDepthLabel(), DMPlexGetDepthStratum(), DMPlexGetPointDepth(), DMPlexSymmetrize()
3737 @*/
3738 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
3739 {
3740   DMLabel        label;
3741   PetscInt       d = 0;
3742   PetscErrorCode ierr;
3743 
3744   PetscFunctionBegin;
3745   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3746   PetscValidPointer(depth, 2);
3747   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3748   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
3749   *depth = d-1;
3750   PetscFunctionReturn(0);
3751 }
3752 
3753 /*@
3754   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
3755 
3756   Not Collective
3757 
3758   Input Parameters:
3759 + dm           - The DMPlex object
3760 - stratumValue - The requested depth
3761 
3762   Output Parameters:
3763 + start - The first point at this depth
3764 - end   - One beyond the last point at this depth
3765 
3766   Notes:
3767   Depth indexing is related to topological dimension.  Depth stratum 0 contains the lowest topological dimension points,
3768   often "vertices".  If the mesh is "interpolated" (see DMPlexInterpolate()), then depth stratum 1 contains the next
3769   higher dimension, e.g., "edges".
3770 
3771   Level: developer
3772 
3773 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth(), DMPlexGetDepthLabel(), DMPlexGetPointDepth(), DMPlexSymmetrize(), DMPlexInterpolate()
3774 @*/
3775 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3776 {
3777   DMLabel        label;
3778   PetscInt       pStart, pEnd;
3779   PetscErrorCode ierr;
3780 
3781   PetscFunctionBegin;
3782   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3783   if (start) {PetscValidPointer(start, 3); *start = 0;}
3784   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3785   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3786   if (pStart == pEnd) PetscFunctionReturn(0);
3787   if (stratumValue < 0) {
3788     if (start) *start = pStart;
3789     if (end)   *end   = pEnd;
3790     PetscFunctionReturn(0);
3791   }
3792   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3793   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3794   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
3795   PetscFunctionReturn(0);
3796 }
3797 
3798 /*@
3799   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
3800 
3801   Not Collective
3802 
3803   Input Parameters:
3804 + dm           - The DMPlex object
3805 - stratumValue - The requested height
3806 
3807   Output Parameters:
3808 + start - The first point at this height
3809 - end   - One beyond the last point at this height
3810 
3811   Notes:
3812   Height indexing is related to topological codimension.  Height stratum 0 contains the highest topological dimension
3813   points, often called "cells" or "elements".  If the mesh is "interpolated" (see DMPlexInterpolate()), then height
3814   stratum 1 contains the boundary of these "cells", often called "faces" or "facets".
3815 
3816   Level: developer
3817 
3818 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth(), DMPlexGetPointHeight()
3819 @*/
3820 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3821 {
3822   DMLabel        label;
3823   PetscInt       depth, pStart, pEnd;
3824   PetscErrorCode ierr;
3825 
3826   PetscFunctionBegin;
3827   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3828   if (start) {PetscValidPointer(start, 3); *start = 0;}
3829   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3830   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3831   if (pStart == pEnd) PetscFunctionReturn(0);
3832   if (stratumValue < 0) {
3833     if (start) *start = pStart;
3834     if (end)   *end   = pEnd;
3835     PetscFunctionReturn(0);
3836   }
3837   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3838   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3839   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
3840   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
3841   PetscFunctionReturn(0);
3842 }
3843 
3844 /*@
3845   DMPlexGetPointDepth - Get the depth of a given point
3846 
3847   Not Collective
3848 
3849   Input Parameter:
3850 + dm    - The DMPlex object
3851 - point - The point
3852 
3853   Output Parameter:
3854 . depth - The depth of the point
3855 
3856   Level: intermediate
3857 
3858 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexGetPointHeight()
3859 @*/
3860 PetscErrorCode DMPlexGetPointDepth(DM dm, PetscInt point, PetscInt *depth)
3861 {
3862   PetscErrorCode ierr;
3863 
3864   PetscFunctionBegin;
3865   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3866   PetscValidIntPointer(depth, 3);
3867   ierr = DMLabelGetValue(dm->depthLabel, point, depth);CHKERRQ(ierr);
3868   PetscFunctionReturn(0);
3869 }
3870 
3871 /*@
3872   DMPlexGetPointHeight - Get the height of a given point
3873 
3874   Not Collective
3875 
3876   Input Parameter:
3877 + dm    - The DMPlex object
3878 - point - The point
3879 
3880   Output Parameter:
3881 . height - The height of the point
3882 
3883   Level: intermediate
3884 
3885 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexGetPointDepth()
3886 @*/
3887 PetscErrorCode DMPlexGetPointHeight(DM dm, PetscInt point, PetscInt *height)
3888 {
3889   PetscInt       n, pDepth;
3890   PetscErrorCode ierr;
3891 
3892   PetscFunctionBegin;
3893   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3894   PetscValidIntPointer(height, 3);
3895   ierr = DMLabelGetNumValues(dm->depthLabel, &n);CHKERRQ(ierr);
3896   ierr = DMLabelGetValue(dm->depthLabel, point, &pDepth);CHKERRQ(ierr);
3897   *height = n - 1 - pDepth;  /* DAG depth is n-1 */
3898   PetscFunctionReturn(0);
3899 }
3900 
3901 /*@
3902   DMPlexGetCellTypeLabel - Get the DMLabel recording the polytope type of each cell
3903 
3904   Not Collective
3905 
3906   Input Parameter:
3907 . dm - The DMPlex object
3908 
3909   Output Parameter:
3910 . celltypeLabel - The DMLabel recording cell polytope type
3911 
3912   Note: This function will trigger automatica computation of cell types. This can be disabled by calling
3913   DMCreateLabel(dm, "celltype") beforehand.
3914 
3915   Level: developer
3916 
3917 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMCreateLabel()
3918 @*/
3919 PetscErrorCode DMPlexGetCellTypeLabel(DM dm, DMLabel *celltypeLabel)
3920 {
3921   PetscErrorCode ierr;
3922 
3923   PetscFunctionBegin;
3924   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3925   PetscValidPointer(celltypeLabel, 2);
3926   if (!dm->celltypeLabel) {ierr = DMPlexComputeCellTypes(dm);CHKERRQ(ierr);}
3927   *celltypeLabel = dm->celltypeLabel;
3928   PetscFunctionReturn(0);
3929 }
3930 
3931 /*@
3932   DMPlexGetCellType - Get the polytope type of a given cell
3933 
3934   Not Collective
3935 
3936   Input Parameter:
3937 + dm   - The DMPlex object
3938 - cell - The cell
3939 
3940   Output Parameter:
3941 . celltype - The polytope type of the cell
3942 
3943   Level: intermediate
3944 
3945 .seealso: DMPlexGetCellTypeLabel(), DMPlexGetDepthLabel(), DMPlexGetDepth()
3946 @*/
3947 PetscErrorCode DMPlexGetCellType(DM dm, PetscInt cell, DMPolytopeType *celltype)
3948 {
3949   DMLabel        label;
3950   PetscInt       ct;
3951   PetscErrorCode ierr;
3952 
3953   PetscFunctionBegin;
3954   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3955   PetscValidPointer(celltype, 3);
3956   ierr = DMPlexGetCellTypeLabel(dm, &label);CHKERRQ(ierr);
3957   ierr = DMLabelGetValue(label, cell, &ct);CHKERRQ(ierr);
3958   *celltype = (DMPolytopeType) ct;
3959   PetscFunctionReturn(0);
3960 }
3961 
3962 /*@
3963   DMPlexSetCellType - Set the polytope type of a given cell
3964 
3965   Not Collective
3966 
3967   Input Parameters:
3968 + dm   - The DMPlex object
3969 . cell - The cell
3970 - celltype - The polytope type of the cell
3971 
3972   Note: By default, cell types will be automatically computed using DMPlexComputeCellTypes() before this function
3973   is executed. This function will override the computed type. However, if automatic classification will not succeed
3974   and a user wants to manually specify all types, the classification must be disabled by calling
3975   DMCreaateLabel(dm, "celltype") before getting or setting any cell types.
3976 
3977   Level: advanced
3978 
3979 .seealso: DMPlexGetCellTypeLabel(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexComputeCellTypes(), DMCreateLabel()
3980 @*/
3981 PetscErrorCode DMPlexSetCellType(DM dm, PetscInt cell, DMPolytopeType celltype)
3982 {
3983   DMLabel        label;
3984   PetscErrorCode ierr;
3985 
3986   PetscFunctionBegin;
3987   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3988   ierr = DMPlexGetCellTypeLabel(dm, &label);CHKERRQ(ierr);
3989   ierr = DMLabelSetValue(label, cell, celltype);CHKERRQ(ierr);
3990   PetscFunctionReturn(0);
3991 }
3992 
3993 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3994 {
3995   PetscSection   section, s;
3996   Mat            m;
3997   PetscInt       maxHeight;
3998   PetscErrorCode ierr;
3999 
4000   PetscFunctionBegin;
4001   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4002   ierr = DMPlexGetMaxProjectionHeight(dm, &maxHeight);CHKERRQ(ierr);
4003   ierr = DMPlexSetMaxProjectionHeight(*cdm, maxHeight);CHKERRQ(ierr);
4004   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4005   ierr = DMSetLocalSection(*cdm, section);CHKERRQ(ierr);
4006   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4007   ierr = PetscSectionCreate(PETSC_COMM_SELF, &s);CHKERRQ(ierr);
4008   ierr = MatCreate(PETSC_COMM_SELF, &m);CHKERRQ(ierr);
4009   ierr = DMSetDefaultConstraints(*cdm, s, m);CHKERRQ(ierr);
4010   ierr = PetscSectionDestroy(&s);CHKERRQ(ierr);
4011   ierr = MatDestroy(&m);CHKERRQ(ierr);
4012 
4013   ierr = DMSetNumFields(*cdm, 1);CHKERRQ(ierr);
4014   ierr = DMCreateDS(*cdm);CHKERRQ(ierr);
4015   PetscFunctionReturn(0);
4016 }
4017 
4018 PetscErrorCode DMCreateCoordinateField_Plex(DM dm, DMField *field)
4019 {
4020   Vec            coordsLocal;
4021   DM             coordsDM;
4022   PetscErrorCode ierr;
4023 
4024   PetscFunctionBegin;
4025   *field = NULL;
4026   ierr = DMGetCoordinatesLocal(dm,&coordsLocal);CHKERRQ(ierr);
4027   ierr = DMGetCoordinateDM(dm,&coordsDM);CHKERRQ(ierr);
4028   if (coordsLocal && coordsDM) {
4029     ierr = DMFieldCreateDS(coordsDM, 0, coordsLocal, field);CHKERRQ(ierr);
4030   }
4031   PetscFunctionReturn(0);
4032 }
4033 
4034 /*@C
4035   DMPlexGetConeSection - Return a section which describes the layout of cone data
4036 
4037   Not Collective
4038 
4039   Input Parameters:
4040 . dm        - The DMPlex object
4041 
4042   Output Parameter:
4043 . section - The PetscSection object
4044 
4045   Level: developer
4046 
4047 .seealso: DMPlexGetSupportSection(), DMPlexGetCones(), DMPlexGetConeOrientations()
4048 @*/
4049 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4050 {
4051   DM_Plex *mesh = (DM_Plex*) dm->data;
4052 
4053   PetscFunctionBegin;
4054   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4055   if (section) *section = mesh->coneSection;
4056   PetscFunctionReturn(0);
4057 }
4058 
4059 /*@C
4060   DMPlexGetSupportSection - Return a section which describes the layout of support data
4061 
4062   Not Collective
4063 
4064   Input Parameters:
4065 . dm        - The DMPlex object
4066 
4067   Output Parameter:
4068 . section - The PetscSection object
4069 
4070   Level: developer
4071 
4072 .seealso: DMPlexGetConeSection()
4073 @*/
4074 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4075 {
4076   DM_Plex *mesh = (DM_Plex*) dm->data;
4077 
4078   PetscFunctionBegin;
4079   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4080   if (section) *section = mesh->supportSection;
4081   PetscFunctionReturn(0);
4082 }
4083 
4084 /*@C
4085   DMPlexGetCones - Return cone data
4086 
4087   Not Collective
4088 
4089   Input Parameters:
4090 . dm        - The DMPlex object
4091 
4092   Output Parameter:
4093 . cones - The cone for each point
4094 
4095   Level: developer
4096 
4097 .seealso: DMPlexGetConeSection()
4098 @*/
4099 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4100 {
4101   DM_Plex *mesh = (DM_Plex*) dm->data;
4102 
4103   PetscFunctionBegin;
4104   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4105   if (cones) *cones = mesh->cones;
4106   PetscFunctionReturn(0);
4107 }
4108 
4109 /*@C
4110   DMPlexGetConeOrientations - Return cone orientation data
4111 
4112   Not Collective
4113 
4114   Input Parameters:
4115 . dm        - The DMPlex object
4116 
4117   Output Parameter:
4118 . coneOrientations - The cone orientation for each point
4119 
4120   Level: developer
4121 
4122 .seealso: DMPlexGetConeSection()
4123 @*/
4124 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4125 {
4126   DM_Plex *mesh = (DM_Plex*) dm->data;
4127 
4128   PetscFunctionBegin;
4129   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4130   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4131   PetscFunctionReturn(0);
4132 }
4133 
4134 /******************************** FEM Support **********************************/
4135 
4136 /*
4137  Returns number of components and tensor degree for the field.  For interpolated meshes, line should be a point
4138  representing a line in the section.
4139 */
4140 static PetscErrorCode PetscSectionFieldGetTensorDegree_Private(PetscSection section,PetscInt field,PetscInt line,PetscBool vertexchart,PetscInt *Nc,PetscInt *k)
4141 {
4142   PetscErrorCode ierr;
4143 
4144   PetscFunctionBeginHot;
4145   ierr = PetscSectionGetFieldComponents(section, field, Nc);CHKERRQ(ierr);
4146   if (line < 0) {
4147     *k = 0;
4148     *Nc = 0;
4149   } else if (vertexchart) {            /* If we only have a vertex chart, we must have degree k=1 */
4150     *k = 1;
4151   } else {                      /* Assume the full interpolated mesh is in the chart; lines in particular */
4152     /* An order k SEM disc has k-1 dofs on an edge */
4153     ierr = PetscSectionGetFieldDof(section, line, field, k);CHKERRQ(ierr);
4154     *k = *k / *Nc + 1;
4155   }
4156   PetscFunctionReturn(0);
4157 }
4158 
4159 /*@
4160 
4161   DMPlexSetClosurePermutationTensor - Create a permutation from the default (BFS) point ordering in the closure, to a
4162   lexicographic ordering over the tensor product cell (i.e., line, quad, hex, etc.), and set this permutation in the
4163   section provided (or the section of the DM).
4164 
4165   Input Parameters:
4166 + dm      - The DM
4167 . point   - Either a cell (highest dim point) or an edge (dim 1 point), or PETSC_DETERMINE
4168 - section - The PetscSection to reorder, or NULL for the default section
4169 
4170   Note: The point is used to determine the number of dofs/field on an edge. For SEM, this is related to the polynomial
4171   degree of the basis.
4172 
4173   Example:
4174   A typical interpolated single-quad mesh might order points as
4175 .vb
4176   [c0, v1, v2, v3, v4, e5, e6, e7, e8]
4177 
4178   v4 -- e6 -- v3
4179   |           |
4180   e7    c0    e8
4181   |           |
4182   v1 -- e5 -- v2
4183 .ve
4184 
4185   (There is no significance to the ordering described here.)  The default section for a Q3 quad might typically assign
4186   dofs in the order of points, e.g.,
4187 .vb
4188     c0 -> [0,1,2,3]
4189     v1 -> [4]
4190     ...
4191     e5 -> [8, 9]
4192 .ve
4193 
4194   which corresponds to the dofs
4195 .vb
4196     6   10  11  7
4197     13  2   3   15
4198     12  0   1   14
4199     4   8   9   5
4200 .ve
4201 
4202   The closure in BFS ordering works through height strata (cells, edges, vertices) to produce the ordering
4203 .vb
4204   0 1 2 3 8 9 14 15 11 10 13 12 4 5 7 6
4205 .ve
4206 
4207   After calling DMPlexSetClosurePermutationTensor(), the closure will be ordered lexicographically,
4208 .vb
4209    4 8 9 5 12 0 1 14 13 2 3 15 6 10 11 7
4210 .ve
4211 
4212   Level: developer
4213 
4214 .seealso: DMGetLocalSection(), PetscSectionSetClosurePermutation(), DMSetGlobalSection()
4215 @*/
4216 PetscErrorCode DMPlexSetClosurePermutationTensor(DM dm, PetscInt point, PetscSection section)
4217 {
4218   DMLabel        label;
4219   PetscInt       dim, depth = -1, eStart = -1, Nf;
4220   PetscBool      vertexchart;
4221   PetscErrorCode ierr;
4222 
4223   PetscFunctionBegin;
4224   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4225   if (dim < 1) PetscFunctionReturn(0);
4226   if (point < 0) {
4227     PetscInt sStart,sEnd;
4228 
4229     ierr = DMPlexGetDepthStratum(dm, 1, &sStart, &sEnd);CHKERRQ(ierr);
4230     point = sEnd-sStart ? sStart : point;
4231   }
4232   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4233   if (point >= 0) { ierr = DMLabelGetValue(label, point, &depth);CHKERRQ(ierr); }
4234   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4235   if (depth == 1) {eStart = point;}
4236   else if  (depth == dim) {
4237     const PetscInt *cone;
4238 
4239     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4240     if (dim == 2) eStart = cone[0];
4241     else if (dim == 3) {
4242       const PetscInt *cone2;
4243       ierr = DMPlexGetCone(dm, cone[0], &cone2);CHKERRQ(ierr);
4244       eStart = cone2[0];
4245     } else SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %D of depth %D cannot be used to bootstrap spectral ordering for dim %D", point, depth, dim);
4246   } else if (depth >= 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %D of depth %D cannot be used to bootstrap spectral ordering for dim %D", point, depth, dim);
4247   {                             /* Determine whether the chart covers all points or just vertices. */
4248     PetscInt pStart,pEnd,cStart,cEnd;
4249     ierr = DMPlexGetDepthStratum(dm,0,&pStart,&pEnd);CHKERRQ(ierr);
4250     ierr = PetscSectionGetChart(section,&cStart,&cEnd);CHKERRQ(ierr);
4251     if (pStart == cStart && pEnd == cEnd) vertexchart = PETSC_TRUE; /* Just vertices */
4252     else vertexchart = PETSC_FALSE;                                 /* Assume all interpolated points are in chart */
4253   }
4254   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
4255   for (PetscInt d=1; d<=dim; d++) {
4256     PetscInt k, f, Nc, c, i, j, size = 0, offset = 0, foffset = 0;
4257     PetscInt *perm;
4258 
4259     for (f = 0; f < Nf; ++f) {
4260       ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4261       size += PetscPowInt(k+1, d)*Nc;
4262     }
4263     ierr = PetscMalloc1(size, &perm);CHKERRQ(ierr);
4264     for (f = 0; f < Nf; ++f) {
4265       switch (d) {
4266       case 1:
4267         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4268         /*
4269          Original ordering is [ edge of length k-1; vtx0; vtx1 ]
4270          We want              [ vtx0; edge of length k-1; vtx1 ]
4271          */
4272         for (c=0; c<Nc; c++,offset++) perm[offset] = (k-1)*Nc + c + foffset;
4273         for (i=0; i<k-1; i++) for (c=0; c<Nc; c++,offset++) perm[offset] = i*Nc + c + foffset;
4274         for (c=0; c<Nc; c++,offset++) perm[offset] = k*Nc + c + foffset;
4275         foffset = offset;
4276         break;
4277       case 2:
4278         /* The original quad closure is oriented clockwise, {f, e_b, e_r, e_t, e_l, v_lb, v_rb, v_tr, v_tl} */
4279         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4280         /* The SEM order is
4281 
4282          v_lb, {e_b}, v_rb,
4283          e^{(k-1)-i}_l, {f^{i*(k-1)}}, e^i_r,
4284          v_lt, reverse {e_t}, v_rt
4285          */
4286         {
4287           const PetscInt of   = 0;
4288           const PetscInt oeb  = of   + PetscSqr(k-1);
4289           const PetscInt oer  = oeb  + (k-1);
4290           const PetscInt oet  = oer  + (k-1);
4291           const PetscInt oel  = oet  + (k-1);
4292           const PetscInt ovlb = oel  + (k-1);
4293           const PetscInt ovrb = ovlb + 1;
4294           const PetscInt ovrt = ovrb + 1;
4295           const PetscInt ovlt = ovrt + 1;
4296           PetscInt       o;
4297 
4298           /* bottom */
4299           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlb*Nc + c + foffset;
4300           for (o = oeb; o < oer; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4301           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrb*Nc + c + foffset;
4302           /* middle */
4303           for (i = 0; i < k-1; ++i) {
4304             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oel+(k-2)-i)*Nc + c + foffset;
4305             for (o = of+(k-1)*i; o < of+(k-1)*(i+1); ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4306             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oer+i)*Nc + c + foffset;
4307           }
4308           /* top */
4309           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlt*Nc + c + foffset;
4310           for (o = oel-1; o >= oet; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4311           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrt*Nc + c + foffset;
4312           foffset = offset;
4313         }
4314         break;
4315       case 3:
4316         /* The original hex closure is
4317 
4318          {c,
4319          f_b, f_t, f_f, f_b, f_r, f_l,
4320          e_bl, e_bb, e_br, e_bf,  e_tf, e_tr, e_tb, e_tl,  e_rf, e_lf, e_lb, e_rb,
4321          v_blf, v_blb, v_brb, v_brf, v_tlf, v_trf, v_trb, v_tlb}
4322          */
4323         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4324         /* The SEM order is
4325          Bottom Slice
4326          v_blf, {e^{(k-1)-n}_bf}, v_brf,
4327          e^{i}_bl, f^{n*(k-1)+(k-1)-i}_b, e^{(k-1)-i}_br,
4328          v_blb, {e_bb}, v_brb,
4329 
4330          Middle Slice (j)
4331          {e^{(k-1)-j}_lf}, {f^{j*(k-1)+n}_f}, e^j_rf,
4332          f^{i*(k-1)+j}_l, {c^{(j*(k-1) + i)*(k-1)+n}_t}, f^{j*(k-1)+i}_r,
4333          e^j_lb, {f^{j*(k-1)+(k-1)-n}_b}, e^{(k-1)-j}_rb,
4334 
4335          Top Slice
4336          v_tlf, {e_tf}, v_trf,
4337          e^{(k-1)-i}_tl, {f^{i*(k-1)}_t}, e^{i}_tr,
4338          v_tlb, {e^{(k-1)-n}_tb}, v_trb,
4339          */
4340         {
4341           const PetscInt oc    = 0;
4342           const PetscInt ofb   = oc    + PetscSqr(k-1)*(k-1);
4343           const PetscInt oft   = ofb   + PetscSqr(k-1);
4344           const PetscInt off   = oft   + PetscSqr(k-1);
4345           const PetscInt ofk   = off   + PetscSqr(k-1);
4346           const PetscInt ofr   = ofk   + PetscSqr(k-1);
4347           const PetscInt ofl   = ofr   + PetscSqr(k-1);
4348           const PetscInt oebl  = ofl   + PetscSqr(k-1);
4349           const PetscInt oebb  = oebl  + (k-1);
4350           const PetscInt oebr  = oebb  + (k-1);
4351           const PetscInt oebf  = oebr  + (k-1);
4352           const PetscInt oetf  = oebf  + (k-1);
4353           const PetscInt oetr  = oetf  + (k-1);
4354           const PetscInt oetb  = oetr  + (k-1);
4355           const PetscInt oetl  = oetb  + (k-1);
4356           const PetscInt oerf  = oetl  + (k-1);
4357           const PetscInt oelf  = oerf  + (k-1);
4358           const PetscInt oelb  = oelf  + (k-1);
4359           const PetscInt oerb  = oelb  + (k-1);
4360           const PetscInt ovblf = oerb  + (k-1);
4361           const PetscInt ovblb = ovblf + 1;
4362           const PetscInt ovbrb = ovblb + 1;
4363           const PetscInt ovbrf = ovbrb + 1;
4364           const PetscInt ovtlf = ovbrf + 1;
4365           const PetscInt ovtrf = ovtlf + 1;
4366           const PetscInt ovtrb = ovtrf + 1;
4367           const PetscInt ovtlb = ovtrb + 1;
4368           PetscInt       o, n;
4369 
4370           /* Bottom Slice */
4371           /*   bottom */
4372           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblf*Nc + c + foffset;
4373           for (o = oetf-1; o >= oebf; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4374           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrf*Nc + c + foffset;
4375           /*   middle */
4376           for (i = 0; i < k-1; ++i) {
4377             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebl+i)*Nc + c + foffset;
4378             for (n = 0; n < k-1; ++n) {o = ofb+n*(k-1)+i; for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;}
4379             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebr+(k-2)-i)*Nc + c + foffset;
4380           }
4381           /*   top */
4382           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblb*Nc + c + foffset;
4383           for (o = oebb; o < oebr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4384           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrb*Nc + c + foffset;
4385 
4386           /* Middle Slice */
4387           for (j = 0; j < k-1; ++j) {
4388             /*   bottom */
4389             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelf+(k-2)-j)*Nc + c + foffset;
4390             for (o = off+j*(k-1); o < off+(j+1)*(k-1); ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4391             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerf+j)*Nc + c + foffset;
4392             /*   middle */
4393             for (i = 0; i < k-1; ++i) {
4394               for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofl+i*(k-1)+j)*Nc + c + foffset;
4395               for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oc+(j*(k-1)+i)*(k-1)+n)*Nc + c + foffset;
4396               for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofr+j*(k-1)+i)*Nc + c + foffset;
4397             }
4398             /*   top */
4399             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelb+j)*Nc + c + foffset;
4400             for (o = ofk+j*(k-1)+(k-2); o >= ofk+j*(k-1); --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4401             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerb+(k-2)-j)*Nc + c + foffset;
4402           }
4403 
4404           /* Top Slice */
4405           /*   bottom */
4406           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlf*Nc + c + foffset;
4407           for (o = oetf; o < oetr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4408           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrf*Nc + c + foffset;
4409           /*   middle */
4410           for (i = 0; i < k-1; ++i) {
4411             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetl+(k-2)-i)*Nc + c + foffset;
4412             for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oft+i*(k-1)+n)*Nc + c + foffset;
4413             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetr+i)*Nc + c + foffset;
4414           }
4415           /*   top */
4416           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlb*Nc + c + foffset;
4417           for (o = oetl-1; o >= oetb; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4418           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrb*Nc + c + foffset;
4419 
4420           foffset = offset;
4421         }
4422         break;
4423       default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No spectral ordering for dimension %D", d);
4424       }
4425     }
4426     if (offset != size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Number of permutation entries %D != %D", offset, size);
4427     /* Check permutation */
4428     {
4429       PetscInt *check;
4430 
4431       ierr = PetscMalloc1(size, &check);CHKERRQ(ierr);
4432       for (i = 0; i < size; ++i) {check[i] = -1; if (perm[i] < 0 || perm[i] >= size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid permutation index p[%D] = %D", i, perm[i]);}
4433       for (i = 0; i < size; ++i) check[perm[i]] = i;
4434       for (i = 0; i < size; ++i) {if (check[i] < 0) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Missing permutation index %D", i);}
4435       ierr = PetscFree(check);CHKERRQ(ierr);
4436     }
4437     ierr = PetscSectionSetClosurePermutation_Internal(section, (PetscObject) dm, d, size, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
4438   }
4439   PetscFunctionReturn(0);
4440 }
4441 
4442 PetscErrorCode DMPlexGetPointDualSpaceFEM(DM dm, PetscInt point, PetscInt field, PetscDualSpace *dspace)
4443 {
4444   PetscDS        prob;
4445   PetscInt       depth, Nf, h;
4446   DMLabel        label;
4447   PetscErrorCode ierr;
4448 
4449   PetscFunctionBeginHot;
4450   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4451   Nf      = prob->Nf;
4452   label   = dm->depthLabel;
4453   *dspace = NULL;
4454   if (field < Nf) {
4455     PetscObject disc = prob->disc[field];
4456 
4457     if (disc->classid == PETSCFE_CLASSID) {
4458       PetscDualSpace dsp;
4459 
4460       ierr = PetscFEGetDualSpace((PetscFE)disc,&dsp);CHKERRQ(ierr);
4461       ierr = DMLabelGetNumValues(label,&depth);CHKERRQ(ierr);
4462       ierr = DMLabelGetValue(label,point,&h);CHKERRQ(ierr);
4463       h    = depth - 1 - h;
4464       if (h) {
4465         ierr = PetscDualSpaceGetHeightSubspace(dsp,h,dspace);CHKERRQ(ierr);
4466       } else {
4467         *dspace = dsp;
4468       }
4469     }
4470   }
4471   PetscFunctionReturn(0);
4472 }
4473 
4474 
4475 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4476 {
4477   PetscScalar    *array, *vArray;
4478   const PetscInt *cone, *coneO;
4479   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4480   PetscErrorCode  ierr;
4481 
4482   PetscFunctionBeginHot;
4483   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4484   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4485   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4486   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4487   if (!values || !*values) {
4488     if ((point >= pStart) && (point < pEnd)) {
4489       PetscInt dof;
4490 
4491       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4492       size += dof;
4493     }
4494     for (p = 0; p < numPoints; ++p) {
4495       const PetscInt cp = cone[p];
4496       PetscInt       dof;
4497 
4498       if ((cp < pStart) || (cp >= pEnd)) continue;
4499       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4500       size += dof;
4501     }
4502     if (!values) {
4503       if (csize) *csize = size;
4504       PetscFunctionReturn(0);
4505     }
4506     ierr = DMGetWorkArray(dm, size, MPIU_SCALAR, &array);CHKERRQ(ierr);
4507   } else {
4508     array = *values;
4509   }
4510   size = 0;
4511   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4512   if ((point >= pStart) && (point < pEnd)) {
4513     PetscInt     dof, off, d;
4514     PetscScalar *varr;
4515 
4516     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4517     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4518     varr = &vArray[off];
4519     for (d = 0; d < dof; ++d, ++offset) {
4520       array[offset] = varr[d];
4521     }
4522     size += dof;
4523   }
4524   for (p = 0; p < numPoints; ++p) {
4525     const PetscInt cp = cone[p];
4526     PetscInt       o  = coneO[p];
4527     PetscInt       dof, off, d;
4528     PetscScalar   *varr;
4529 
4530     if ((cp < pStart) || (cp >= pEnd)) continue;
4531     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4532     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
4533     varr = &vArray[off];
4534     if (o >= 0) {
4535       for (d = 0; d < dof; ++d, ++offset) {
4536         array[offset] = varr[d];
4537       }
4538     } else {
4539       for (d = dof-1; d >= 0; --d, ++offset) {
4540         array[offset] = varr[d];
4541       }
4542     }
4543     size += dof;
4544   }
4545   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4546   if (!*values) {
4547     if (csize) *csize = size;
4548     *values = array;
4549   } else {
4550     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4551     *csize = size;
4552   }
4553   PetscFunctionReturn(0);
4554 }
4555 
4556 /* Compress out points not in the section */
4557 PETSC_STATIC_INLINE PetscErrorCode CompressPoints_Private(PetscSection section, PetscInt *numPoints, PetscInt points[])
4558 {
4559   const PetscInt np = *numPoints;
4560   PetscInt       pStart, pEnd, p, q;
4561   PetscErrorCode ierr;
4562 
4563   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4564   for (p = 0, q = 0; p < np; ++p) {
4565     const PetscInt r = points[p*2];
4566     if ((r >= pStart) && (r < pEnd)) {
4567       points[q*2]   = r;
4568       points[q*2+1] = points[p*2+1];
4569       ++q;
4570     }
4571   }
4572   *numPoints = q;
4573   return 0;
4574 }
4575 
4576 static PetscErrorCode DMPlexTransitiveClosure_Hybrid_Internal(DM dm, PetscInt point, PetscInt np, PetscInt *numPoints, PetscInt **points)
4577 {
4578   const PetscInt *cone, *ornt;
4579   PetscInt       *pts,  *closure = NULL;
4580   PetscInt        dim, coneSize, c, d, clSize, cl;
4581   PetscErrorCode  ierr;
4582 
4583   PetscFunctionBeginHot;
4584   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4585   ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
4586   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4587   ierr = DMPlexGetConeOrientation(dm, point, &ornt);CHKERRQ(ierr);
4588   ierr = DMPlexGetTransitiveClosure(dm, cone[0], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4589   ierr = DMGetWorkArray(dm, np*2, MPIU_INT, &pts);CHKERRQ(ierr);
4590   c    = 0;
4591   pts[c*2+0] = point;
4592   pts[c*2+1] = 0;
4593   ++c;
4594   for (cl = 0; cl < clSize*2; cl += 2, ++c) {pts[c*2+0] = closure[cl]; pts[c*2+1] = closure[cl+1];}
4595   ierr = DMPlexGetTransitiveClosure(dm, cone[1], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4596   for (cl = 0; cl < clSize*2; cl += 2, ++c) {pts[c*2+0] = closure[cl]; pts[c*2+1] = closure[cl+1];}
4597   ierr = DMPlexRestoreTransitiveClosure(dm, cone[0], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4598   if (dim >= 2) {
4599     for (d = 2; d < coneSize; ++d, ++c) {pts[c*2+0] = cone[d]; pts[c*2+1] = ornt[d];}
4600   }
4601   if (dim >= 3) {
4602     for (d = 2; d < coneSize; ++d) {
4603       const PetscInt  fpoint = cone[d];
4604       const PetscInt *fcone;
4605       PetscInt        fconeSize, fc, i;
4606 
4607       ierr = DMPlexGetConeSize(dm, fpoint, &fconeSize);CHKERRQ(ierr);
4608       ierr = DMPlexGetCone(dm, fpoint, &fcone);CHKERRQ(ierr);
4609       for (fc = 0; fc < fconeSize; ++fc) {
4610         for (i = 0; i < c; ++i) if (pts[i*2] == fcone[fc]) break;
4611         if (i == c) {pts[c*2+0] = fcone[fc]; pts[c*2+1] = 0; ++c;}
4612       }
4613     }
4614   }
4615   if (c != np) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid closure for hybrid point %D, size %D != %D", point, c, np);
4616   *numPoints = np;
4617   *points    = pts;
4618   PetscFunctionReturn(0);
4619 }
4620 
4621 /* Compressed closure does not apply closure permutation */
4622 PetscErrorCode DMPlexGetCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
4623 {
4624   const PetscInt *cla = NULL;
4625   PetscInt       np, *pts = NULL;
4626   PetscErrorCode ierr;
4627 
4628   PetscFunctionBeginHot;
4629   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, clSec, clPoints);CHKERRQ(ierr);
4630   if (*clPoints) {
4631     PetscInt dof, off;
4632 
4633     ierr = PetscSectionGetDof(*clSec, point, &dof);CHKERRQ(ierr);
4634     ierr = PetscSectionGetOffset(*clSec, point, &off);CHKERRQ(ierr);
4635     ierr = ISGetIndices(*clPoints, &cla);CHKERRQ(ierr);
4636     np   = dof/2;
4637     pts  = (PetscInt *) &cla[off];
4638   } else {
4639     DMPolytopeType ct;
4640 
4641     /* Do not make the label if it does not exist */
4642     if (!dm->celltypeLabel) {ct = DM_POLYTOPE_POINT;}
4643     else                    {ierr = DMPlexGetCellType(dm, point, &ct);CHKERRQ(ierr);}
4644     switch (ct) {
4645       case DM_POLYTOPE_SEG_PRISM_TENSOR:
4646         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 9, &np, &pts);CHKERRQ(ierr);
4647         break;
4648       case DM_POLYTOPE_TRI_PRISM_TENSOR:
4649         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 21, &np, &pts);CHKERRQ(ierr);
4650         break;
4651       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
4652         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 27, &np, &pts);CHKERRQ(ierr);
4653         break;
4654       default:
4655         ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &np, &pts);CHKERRQ(ierr);
4656     }
4657     ierr = CompressPoints_Private(section, &np, pts);CHKERRQ(ierr);
4658   }
4659   *numPoints = np;
4660   *points    = pts;
4661   *clp       = cla;
4662   PetscFunctionReturn(0);
4663 }
4664 
4665 PetscErrorCode DMPlexRestoreCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
4666 {
4667   PetscErrorCode ierr;
4668 
4669   PetscFunctionBeginHot;
4670   if (!*clPoints) {
4671     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, numPoints, points);CHKERRQ(ierr);
4672   } else {
4673     ierr = ISRestoreIndices(*clPoints, clp);CHKERRQ(ierr);
4674   }
4675   *numPoints = 0;
4676   *points    = NULL;
4677   *clSec     = NULL;
4678   *clPoints  = NULL;
4679   *clp       = NULL;
4680   PetscFunctionReturn(0);
4681 }
4682 
4683 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(DM dm, PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscInt clperm[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4684 {
4685   PetscInt          offset = 0, p;
4686   const PetscInt    **perms = NULL;
4687   const PetscScalar **flips = NULL;
4688   PetscErrorCode    ierr;
4689 
4690   PetscFunctionBeginHot;
4691   *size = 0;
4692   ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4693   for (p = 0; p < numPoints; p++) {
4694     const PetscInt    point = points[2*p];
4695     const PetscInt    *perm = perms ? perms[p] : NULL;
4696     const PetscScalar *flip = flips ? flips[p] : NULL;
4697     PetscInt          dof, off, d;
4698     const PetscScalar *varr;
4699 
4700     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4701     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4702     varr = &vArray[off];
4703     if (clperm) {
4704       if (perm) {
4705         for (d = 0; d < dof; d++) array[clperm[offset + perm[d]]]  = varr[d];
4706       } else {
4707         for (d = 0; d < dof; d++) array[clperm[offset +      d ]]  = varr[d];
4708       }
4709       if (flip) {
4710         for (d = 0; d < dof; d++) array[clperm[offset +      d ]] *= flip[d];
4711       }
4712     } else {
4713       if (perm) {
4714         for (d = 0; d < dof; d++) array[offset + perm[d]]  = varr[d];
4715       } else {
4716         for (d = 0; d < dof; d++) array[offset +      d ]  = varr[d];
4717       }
4718       if (flip) {
4719         for (d = 0; d < dof; d++) array[offset +      d ] *= flip[d];
4720       }
4721     }
4722     offset += dof;
4723   }
4724   ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4725   *size = offset;
4726   PetscFunctionReturn(0);
4727 }
4728 
4729 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(DM dm, PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscInt clperm[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4730 {
4731   PetscInt          offset = 0, f;
4732   PetscErrorCode    ierr;
4733 
4734   PetscFunctionBeginHot;
4735   *size = 0;
4736   for (f = 0; f < numFields; ++f) {
4737     PetscInt          p;
4738     const PetscInt    **perms = NULL;
4739     const PetscScalar **flips = NULL;
4740 
4741     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4742     for (p = 0; p < numPoints; p++) {
4743       const PetscInt    point = points[2*p];
4744       PetscInt          fdof, foff, b;
4745       const PetscScalar *varr;
4746       const PetscInt    *perm = perms ? perms[p] : NULL;
4747       const PetscScalar *flip = flips ? flips[p] : NULL;
4748 
4749       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4750       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4751       varr = &vArray[foff];
4752       if (clperm) {
4753         if (perm) {for (b = 0; b < fdof; b++) {array[clperm[offset + perm[b]]]  = varr[b];}}
4754         else      {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]]  = varr[b];}}
4755         if (flip) {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]] *= flip[b];}}
4756       } else {
4757         if (perm) {for (b = 0; b < fdof; b++) {array[offset + perm[b]]  = varr[b];}}
4758         else      {for (b = 0; b < fdof; b++) {array[offset +      b ]  = varr[b];}}
4759         if (flip) {for (b = 0; b < fdof; b++) {array[offset +      b ] *= flip[b];}}
4760       }
4761       offset += fdof;
4762     }
4763     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4764   }
4765   *size = offset;
4766   PetscFunctionReturn(0);
4767 }
4768 
4769 /*@C
4770   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4771 
4772   Not collective
4773 
4774   Input Parameters:
4775 + dm - The DM
4776 . section - The section describing the layout in v, or NULL to use the default section
4777 . v - The local vector
4778 . point - The point in the DM
4779 . csize - The size of the input values array, or NULL
4780 - values - An array to use for the values, or NULL to have it allocated automatically
4781 
4782   Output Parameters:
4783 + csize - The number of values in the closure
4784 - values - The array of values. If the user provided NULL, it is a borrowed array and should not be freed
4785 
4786 $ Note that DMPlexVecGetClosure/DMPlexVecRestoreClosure only allocates the values array if it set to NULL in the
4787 $ calling function. This is because DMPlexVecGetClosure() is typically called in the inner loop of a Vec or Mat
4788 $ assembly function, and a user may already have allocated storage for this operation.
4789 $
4790 $ A typical use could be
4791 $
4792 $  values = NULL;
4793 $  ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4794 $  for (cl = 0; cl < clSize; ++cl) {
4795 $    <Compute on closure>
4796 $  }
4797 $  ierr = DMPlexVecRestoreClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4798 $
4799 $ or
4800 $
4801 $  PetscMalloc1(clMaxSize, &values);
4802 $  for (p = pStart; p < pEnd; ++p) {
4803 $    clSize = clMaxSize;
4804 $    ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4805 $    for (cl = 0; cl < clSize; ++cl) {
4806 $      <Compute on closure>
4807 $    }
4808 $  }
4809 $  PetscFree(values);
4810 
4811   Fortran Notes:
4812   Since it returns an array, this routine is only available in Fortran 90, and you must
4813   include petsc.h90 in your code.
4814 
4815   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4816 
4817   Level: intermediate
4818 
4819 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4820 @*/
4821 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4822 {
4823   PetscSection       clSection;
4824   IS                 clPoints;
4825   PetscInt          *points = NULL;
4826   const PetscInt    *clp, *perm;
4827   PetscInt           depth, numFields, numPoints, asize;
4828   PetscErrorCode     ierr;
4829 
4830   PetscFunctionBeginHot;
4831   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4832   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4833   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4834   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4835   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4836   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4837   if (depth == 1 && numFields < 2) {
4838     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4839     PetscFunctionReturn(0);
4840   }
4841   /* Get points */
4842   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4843   /* Get sizes */
4844   asize = 0;
4845   for (PetscInt p = 0; p < numPoints*2; p += 2) {
4846     PetscInt dof;
4847     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4848     asize += dof;
4849   }
4850   if (values) {
4851     const PetscScalar *vArray;
4852     PetscInt          size;
4853 
4854     if (*values) {
4855       if (PetscUnlikely(*csize < asize)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Provided array size %D not sufficient to hold closure size %D", *csize, asize);
4856     } else {ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, values);CHKERRQ(ierr);}
4857     ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, asize, &perm);CHKERRQ(ierr);
4858     ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4859     /* Get values */
4860     if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, numPoints, points, numFields, perm, vArray, &size, *values);CHKERRQ(ierr);}
4861     else               {ierr = DMPlexVecGetClosure_Static(dm, section, numPoints, points, perm, vArray, &size, *values);CHKERRQ(ierr);}
4862     if (PetscUnlikely(asize != size)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Section size %D does not match Vec closure size %D", asize, size);
4863     /* Cleanup array */
4864     ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4865   }
4866   if (csize) *csize = asize;
4867   /* Cleanup points */
4868   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4869   PetscFunctionReturn(0);
4870 }
4871 
4872 PetscErrorCode DMPlexVecGetClosureAtDepth_Internal(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt depth, PetscInt *csize, PetscScalar *values[])
4873 {
4874   DMLabel            depthLabel;
4875   PetscSection       clSection;
4876   IS                 clPoints;
4877   PetscScalar       *array;
4878   const PetscScalar *vArray;
4879   PetscInt          *points = NULL;
4880   const PetscInt    *clp, *perm = NULL;
4881   PetscInt           mdepth, numFields, numPoints, Np = 0, p, clsize, size;
4882   PetscErrorCode     ierr;
4883 
4884   PetscFunctionBeginHot;
4885   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4886   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4887   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4888   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4889   ierr = DMPlexGetDepth(dm, &mdepth);CHKERRQ(ierr);
4890   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4891   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4892   if (mdepth == 1 && numFields < 2) {
4893     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4894     PetscFunctionReturn(0);
4895   }
4896   /* Get points */
4897   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4898   for (clsize=0,p=0; p<Np; p++) {
4899     PetscInt dof;
4900     ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
4901     clsize += dof;
4902   }
4903   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &perm);CHKERRQ(ierr);
4904   /* Filter points */
4905   for (p = 0; p < numPoints*2; p += 2) {
4906     PetscInt dep;
4907 
4908     ierr = DMLabelGetValue(depthLabel, points[p], &dep);CHKERRQ(ierr);
4909     if (dep != depth) continue;
4910     points[Np*2+0] = points[p];
4911     points[Np*2+1] = points[p+1];
4912     ++Np;
4913   }
4914   /* Get array */
4915   if (!values || !*values) {
4916     PetscInt asize = 0, dof;
4917 
4918     for (p = 0; p < Np*2; p += 2) {
4919       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4920       asize += dof;
4921     }
4922     if (!values) {
4923       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4924       if (csize) *csize = asize;
4925       PetscFunctionReturn(0);
4926     }
4927     ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, &array);CHKERRQ(ierr);
4928   } else {
4929     array = *values;
4930   }
4931   ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4932   /* Get values */
4933   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, Np, points, numFields, perm, vArray, &size, array);CHKERRQ(ierr);}
4934   else               {ierr = DMPlexVecGetClosure_Static(dm, section, Np, points, perm, vArray, &size, array);CHKERRQ(ierr);}
4935   /* Cleanup points */
4936   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4937   /* Cleanup array */
4938   ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4939   if (!*values) {
4940     if (csize) *csize = size;
4941     *values = array;
4942   } else {
4943     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4944     *csize = size;
4945   }
4946   PetscFunctionReturn(0);
4947 }
4948 
4949 /*@C
4950   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
4951 
4952   Not collective
4953 
4954   Input Parameters:
4955 + dm - The DM
4956 . section - The section describing the layout in v, or NULL to use the default section
4957 . v - The local vector
4958 . point - The point in the DM
4959 . csize - The number of values in the closure, or NULL
4960 - values - The array of values, which is a borrowed array and should not be freed
4961 
4962   Note that the array values are discarded and not copied back into v. In order to copy values back to v, use DMPlexVecSetClosure()
4963 
4964   Fortran Notes:
4965   Since it returns an array, this routine is only available in Fortran 90, and you must
4966   include petsc.h90 in your code.
4967 
4968   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4969 
4970   Level: intermediate
4971 
4972 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4973 @*/
4974 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4975 {
4976   PetscInt       size = 0;
4977   PetscErrorCode ierr;
4978 
4979   PetscFunctionBegin;
4980   /* Should work without recalculating size */
4981   ierr = DMRestoreWorkArray(dm, size, MPIU_SCALAR, (void*) values);CHKERRQ(ierr);
4982   *values = NULL;
4983   PetscFunctionReturn(0);
4984 }
4985 
4986 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
4987 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4988 
4989 PETSC_STATIC_INLINE PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscInt perm[], const PetscScalar flip[], const PetscInt clperm[], const PetscScalar values[], PetscInt offset, PetscScalar array[])
4990 {
4991   PetscInt        cdof;   /* The number of constraints on this point */
4992   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4993   PetscScalar    *a;
4994   PetscInt        off, cind = 0, k;
4995   PetscErrorCode  ierr;
4996 
4997   PetscFunctionBegin;
4998   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4999   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5000   a    = &array[off];
5001   if (!cdof || setBC) {
5002     if (clperm) {
5003       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
5004       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
5005     } else {
5006       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
5007       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
5008     }
5009   } else {
5010     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5011     if (clperm) {
5012       if (perm) {for (k = 0; k < dof; ++k) {
5013           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5014           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
5015         }
5016       } else {
5017         for (k = 0; k < dof; ++k) {
5018           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5019           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
5020         }
5021       }
5022     } else {
5023       if (perm) {
5024         for (k = 0; k < dof; ++k) {
5025           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5026           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
5027         }
5028       } else {
5029         for (k = 0; k < dof; ++k) {
5030           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5031           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
5032         }
5033       }
5034     }
5035   }
5036   PetscFunctionReturn(0);
5037 }
5038 
5039 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), const PetscInt perm[], const PetscScalar flip[], const PetscInt clperm[], const PetscScalar values[], PetscInt offset, PetscScalar array[])
5040 {
5041   PetscInt        cdof;   /* The number of constraints on this point */
5042   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5043   PetscScalar    *a;
5044   PetscInt        off, cind = 0, k;
5045   PetscErrorCode  ierr;
5046 
5047   PetscFunctionBegin;
5048   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5049   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5050   a    = &array[off];
5051   if (cdof) {
5052     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5053     if (clperm) {
5054       if (perm) {
5055         for (k = 0; k < dof; ++k) {
5056           if ((cind < cdof) && (k == cdofs[cind])) {
5057             fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
5058             cind++;
5059           }
5060         }
5061       } else {
5062         for (k = 0; k < dof; ++k) {
5063           if ((cind < cdof) && (k == cdofs[cind])) {
5064             fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
5065             cind++;
5066           }
5067         }
5068       }
5069     } else {
5070       if (perm) {
5071         for (k = 0; k < dof; ++k) {
5072           if ((cind < cdof) && (k == cdofs[cind])) {
5073             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
5074             cind++;
5075           }
5076         }
5077       } else {
5078         for (k = 0; k < dof; ++k) {
5079           if ((cind < cdof) && (k == cdofs[cind])) {
5080             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
5081             cind++;
5082           }
5083         }
5084       }
5085     }
5086   }
5087   PetscFunctionReturn(0);
5088 }
5089 
5090 PETSC_STATIC_INLINE PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, const PetscInt *perm, const PetscScalar *flip, PetscInt f, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscInt clperm[], const PetscScalar values[], PetscInt *offset, PetscScalar array[])
5091 {
5092   PetscScalar    *a;
5093   PetscInt        fdof, foff, fcdof, foffset = *offset;
5094   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5095   PetscInt        cind = 0, b;
5096   PetscErrorCode  ierr;
5097 
5098   PetscFunctionBegin;
5099   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5100   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5101   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5102   a    = &array[foff];
5103   if (!fcdof || setBC) {
5104     if (clperm) {
5105       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
5106       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
5107     } else {
5108       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
5109       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
5110     }
5111   } else {
5112     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5113     if (clperm) {
5114       if (perm) {
5115         for (b = 0; b < fdof; b++) {
5116           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5117           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
5118         }
5119       } else {
5120         for (b = 0; b < fdof; b++) {
5121           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5122           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
5123         }
5124       }
5125     } else {
5126       if (perm) {
5127         for (b = 0; b < fdof; b++) {
5128           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5129           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
5130         }
5131       } else {
5132         for (b = 0; b < fdof; b++) {
5133           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5134           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
5135         }
5136       }
5137     }
5138   }
5139   *offset += fdof;
5140   PetscFunctionReturn(0);
5141 }
5142 
5143 PETSC_STATIC_INLINE PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, const PetscInt perm[], const PetscScalar flip[], PetscInt f, PetscInt Ncc, const PetscInt comps[], void (*fuse)(PetscScalar*, PetscScalar), const PetscInt clperm[], const PetscScalar values[], PetscInt *offset, PetscScalar array[])
5144 {
5145   PetscScalar    *a;
5146   PetscInt        fdof, foff, fcdof, foffset = *offset;
5147   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5148   PetscInt        Nc, cind = 0, ncind = 0, b;
5149   PetscBool       ncSet, fcSet;
5150   PetscErrorCode  ierr;
5151 
5152   PetscFunctionBegin;
5153   ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
5154   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5155   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5156   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5157   a    = &array[foff];
5158   if (fcdof) {
5159     /* We just override fcdof and fcdofs with Ncc and comps */
5160     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5161     if (clperm) {
5162       if (perm) {
5163         if (comps) {
5164           for (b = 0; b < fdof; b++) {
5165             ncSet = fcSet = PETSC_FALSE;
5166             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5167             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5168             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}
5169           }
5170         } else {
5171           for (b = 0; b < fdof; b++) {
5172             if ((cind < fcdof) && (b == fcdofs[cind])) {
5173               fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
5174               ++cind;
5175             }
5176           }
5177         }
5178       } else {
5179         if (comps) {
5180           for (b = 0; b < fdof; b++) {
5181             ncSet = fcSet = PETSC_FALSE;
5182             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5183             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5184             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}
5185           }
5186         } else {
5187           for (b = 0; b < fdof; b++) {
5188             if ((cind < fcdof) && (b == fcdofs[cind])) {
5189               fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
5190               ++cind;
5191             }
5192           }
5193         }
5194       }
5195     } else {
5196       if (perm) {
5197         if (comps) {
5198           for (b = 0; b < fdof; b++) {
5199             ncSet = fcSet = PETSC_FALSE;
5200             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5201             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5202             if (ncSet && fcSet) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}
5203           }
5204         } else {
5205           for (b = 0; b < fdof; b++) {
5206             if ((cind < fcdof) && (b == fcdofs[cind])) {
5207               fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
5208               ++cind;
5209             }
5210           }
5211         }
5212       } else {
5213         if (comps) {
5214           for (b = 0; b < fdof; b++) {
5215             ncSet = fcSet = PETSC_FALSE;
5216             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5217             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5218             if (ncSet && fcSet) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}
5219           }
5220         } else {
5221           for (b = 0; b < fdof; b++) {
5222             if ((cind < fcdof) && (b == fcdofs[cind])) {
5223               fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
5224               ++cind;
5225             }
5226           }
5227         }
5228       }
5229     }
5230   }
5231   *offset += fdof;
5232   PetscFunctionReturn(0);
5233 }
5234 
5235 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5236 {
5237   PetscScalar    *array;
5238   const PetscInt *cone, *coneO;
5239   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5240   PetscErrorCode  ierr;
5241 
5242   PetscFunctionBeginHot;
5243   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5244   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5245   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5246   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5247   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5248   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5249     const PetscInt cp = !p ? point : cone[p-1];
5250     const PetscInt o  = !p ? 0     : coneO[p-1];
5251 
5252     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5253     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5254     /* ADD_VALUES */
5255     {
5256       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5257       PetscScalar    *a;
5258       PetscInt        cdof, coff, cind = 0, k;
5259 
5260       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5261       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5262       a    = &array[coff];
5263       if (!cdof) {
5264         if (o >= 0) {
5265           for (k = 0; k < dof; ++k) {
5266             a[k] += values[off+k];
5267           }
5268         } else {
5269           for (k = 0; k < dof; ++k) {
5270             a[k] += values[off+dof-k-1];
5271           }
5272         }
5273       } else {
5274         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5275         if (o >= 0) {
5276           for (k = 0; k < dof; ++k) {
5277             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5278             a[k] += values[off+k];
5279           }
5280         } else {
5281           for (k = 0; k < dof; ++k) {
5282             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5283             a[k] += values[off+dof-k-1];
5284           }
5285         }
5286       }
5287     }
5288   }
5289   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5290   PetscFunctionReturn(0);
5291 }
5292 
5293 /*@C
5294   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5295 
5296   Not collective
5297 
5298   Input Parameters:
5299 + dm - The DM
5300 . section - The section describing the layout in v, or NULL to use the default section
5301 . v - The local vector
5302 . point - The point in the DM
5303 . values - The array of values
5304 - mode - The insert mode. One of INSERT_ALL_VALUES, ADD_ALL_VALUES, INSERT_VALUES, ADD_VALUES, INSERT_BC_VALUES, and ADD_BC_VALUES,
5305          where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions.
5306 
5307   Fortran Notes:
5308   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5309 
5310   Level: intermediate
5311 
5312 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5313 @*/
5314 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5315 {
5316   PetscSection    clSection;
5317   IS              clPoints;
5318   PetscScalar    *array;
5319   PetscInt       *points = NULL;
5320   const PetscInt *clp, *clperm = NULL;
5321   PetscInt        depth, numFields, numPoints, p, clsize;
5322   PetscErrorCode  ierr;
5323 
5324   PetscFunctionBeginHot;
5325   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5326   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
5327   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5328   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5329   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5330   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5331   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5332     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5333     PetscFunctionReturn(0);
5334   }
5335   /* Get points */
5336   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5337   for (clsize=0,p=0; p<numPoints; p++) {
5338     PetscInt dof;
5339     ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
5340     clsize += dof;
5341   }
5342   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &clperm);CHKERRQ(ierr);
5343   /* Get array */
5344   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5345   /* Get values */
5346   if (numFields > 0) {
5347     PetscInt offset = 0, f;
5348     for (f = 0; f < numFields; ++f) {
5349       const PetscInt    **perms = NULL;
5350       const PetscScalar **flips = NULL;
5351 
5352       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5353       switch (mode) {
5354       case INSERT_VALUES:
5355         for (p = 0; p < numPoints; p++) {
5356           const PetscInt    point = points[2*p];
5357           const PetscInt    *perm = perms ? perms[p] : NULL;
5358           const PetscScalar *flip = flips ? flips[p] : NULL;
5359           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
5360         } break;
5361       case INSERT_ALL_VALUES:
5362         for (p = 0; p < numPoints; p++) {
5363           const PetscInt    point = points[2*p];
5364           const PetscInt    *perm = perms ? perms[p] : NULL;
5365           const PetscScalar *flip = flips ? flips[p] : NULL;
5366           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
5367         } break;
5368       case INSERT_BC_VALUES:
5369         for (p = 0; p < numPoints; p++) {
5370           const PetscInt    point = points[2*p];
5371           const PetscInt    *perm = perms ? perms[p] : NULL;
5372           const PetscScalar *flip = flips ? flips[p] : NULL;
5373           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, insert, clperm, values, &offset, array);
5374         } break;
5375       case ADD_VALUES:
5376         for (p = 0; p < numPoints; p++) {
5377           const PetscInt    point = points[2*p];
5378           const PetscInt    *perm = perms ? perms[p] : NULL;
5379           const PetscScalar *flip = flips ? flips[p] : NULL;
5380           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
5381         } break;
5382       case ADD_ALL_VALUES:
5383         for (p = 0; p < numPoints; p++) {
5384           const PetscInt    point = points[2*p];
5385           const PetscInt    *perm = perms ? perms[p] : NULL;
5386           const PetscScalar *flip = flips ? flips[p] : NULL;
5387           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
5388         } break;
5389       case ADD_BC_VALUES:
5390         for (p = 0; p < numPoints; p++) {
5391           const PetscInt    point = points[2*p];
5392           const PetscInt    *perm = perms ? perms[p] : NULL;
5393           const PetscScalar *flip = flips ? flips[p] : NULL;
5394           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, add, clperm, values, &offset, array);
5395         } break;
5396       default:
5397         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5398       }
5399       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5400     }
5401   } else {
5402     PetscInt dof, off;
5403     const PetscInt    **perms = NULL;
5404     const PetscScalar **flips = NULL;
5405 
5406     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5407     switch (mode) {
5408     case INSERT_VALUES:
5409       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5410         const PetscInt    point = points[2*p];
5411         const PetscInt    *perm = perms ? perms[p] : NULL;
5412         const PetscScalar *flip = flips ? flips[p] : NULL;
5413         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5414         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
5415       } break;
5416     case INSERT_ALL_VALUES:
5417       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5418         const PetscInt    point = points[2*p];
5419         const PetscInt    *perm = perms ? perms[p] : NULL;
5420         const PetscScalar *flip = flips ? flips[p] : NULL;
5421         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5422         updatePoint_private(section, point, dof, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
5423       } break;
5424     case INSERT_BC_VALUES:
5425       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5426         const PetscInt    point = points[2*p];
5427         const PetscInt    *perm = perms ? perms[p] : NULL;
5428         const PetscScalar *flip = flips ? flips[p] : NULL;
5429         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5430         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
5431       } break;
5432     case ADD_VALUES:
5433       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5434         const PetscInt    point = points[2*p];
5435         const PetscInt    *perm = perms ? perms[p] : NULL;
5436         const PetscScalar *flip = flips ? flips[p] : NULL;
5437         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5438         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
5439       } break;
5440     case ADD_ALL_VALUES:
5441       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5442         const PetscInt    point = points[2*p];
5443         const PetscInt    *perm = perms ? perms[p] : NULL;
5444         const PetscScalar *flip = flips ? flips[p] : NULL;
5445         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5446         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
5447       } break;
5448     case ADD_BC_VALUES:
5449       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5450         const PetscInt    point = points[2*p];
5451         const PetscInt    *perm = perms ? perms[p] : NULL;
5452         const PetscScalar *flip = flips ? flips[p] : NULL;
5453         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5454         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
5455       } break;
5456     default:
5457       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5458     }
5459     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5460   }
5461   /* Cleanup points */
5462   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5463   /* Cleanup array */
5464   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5465   PetscFunctionReturn(0);
5466 }
5467 
5468 /* Check whether the given point is in the label. If not, update the offset to skip this point */
5469 PETSC_STATIC_INLINE PetscErrorCode CheckPoint_Private(DMLabel label, PetscInt labelId, PetscSection section, PetscInt point, PetscInt f, PetscInt *offset)
5470 {
5471   PetscFunctionBegin;
5472   if (label) {
5473     PetscInt       val, fdof;
5474     PetscErrorCode ierr;
5475 
5476     /* There is a problem with this:
5477          Suppose we have two label values, defining surfaces, interecting along a line in 3D. When we add cells to the label, the cells that
5478        touch both surfaces must pick a label value. Thus we miss setting values for the surface with that other value intersecting that cell.
5479        Thus I am only going to check val != -1, not val != labelId
5480     */
5481     ierr = DMLabelGetValue(label, point, &val);CHKERRQ(ierr);
5482     if (val < 0) {
5483       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5484       *offset += fdof;
5485       PetscFunctionReturn(1);
5486     }
5487   }
5488   PetscFunctionReturn(0);
5489 }
5490 
5491 /* Unlike DMPlexVecSetClosure(), this uses plex-native closure permutation, not a user-specified permutation such as DMPlexSetClosurePermutationTensor(). */
5492 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, PetscInt Ncc, const PetscInt comps[], DMLabel label, PetscInt labelId, const PetscScalar values[], InsertMode mode)
5493 {
5494   PetscSection      clSection;
5495   IS                clPoints;
5496   PetscScalar       *array;
5497   PetscInt          *points = NULL;
5498   const PetscInt    *clp;
5499   PetscInt          numFields, numPoints, p;
5500   PetscInt          offset = 0, f;
5501   PetscErrorCode    ierr;
5502 
5503   PetscFunctionBeginHot;
5504   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5505   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
5506   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5507   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5508   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5509   /* Get points */
5510   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5511   /* Get array */
5512   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5513   /* Get values */
5514   for (f = 0; f < numFields; ++f) {
5515     const PetscInt    **perms = NULL;
5516     const PetscScalar **flips = NULL;
5517 
5518     if (!fieldActive[f]) {
5519       for (p = 0; p < numPoints*2; p += 2) {
5520         PetscInt fdof;
5521         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5522         offset += fdof;
5523       }
5524       continue;
5525     }
5526     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5527     switch (mode) {
5528     case INSERT_VALUES:
5529       for (p = 0; p < numPoints; p++) {
5530         const PetscInt    point = points[2*p];
5531         const PetscInt    *perm = perms ? perms[p] : NULL;
5532         const PetscScalar *flip = flips ? flips[p] : NULL;
5533         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5534         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, NULL, values, &offset, array);
5535       } break;
5536     case INSERT_ALL_VALUES:
5537       for (p = 0; p < numPoints; p++) {
5538         const PetscInt    point = points[2*p];
5539         const PetscInt    *perm = perms ? perms[p] : NULL;
5540         const PetscScalar *flip = flips ? flips[p] : NULL;
5541         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5542         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, NULL, values, &offset, array);
5543       } break;
5544     case INSERT_BC_VALUES:
5545       for (p = 0; p < numPoints; p++) {
5546         const PetscInt    point = points[2*p];
5547         const PetscInt    *perm = perms ? perms[p] : NULL;
5548         const PetscScalar *flip = flips ? flips[p] : NULL;
5549         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5550         updatePointFieldsBC_private(section, point, perm, flip, f, Ncc, comps, insert, NULL, values, &offset, array);
5551       } break;
5552     case ADD_VALUES:
5553       for (p = 0; p < numPoints; p++) {
5554         const PetscInt    point = points[2*p];
5555         const PetscInt    *perm = perms ? perms[p] : NULL;
5556         const PetscScalar *flip = flips ? flips[p] : NULL;
5557         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5558         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, NULL, values, &offset, array);
5559       } break;
5560     case ADD_ALL_VALUES:
5561       for (p = 0; p < numPoints; p++) {
5562         const PetscInt    point = points[2*p];
5563         const PetscInt    *perm = perms ? perms[p] : NULL;
5564         const PetscScalar *flip = flips ? flips[p] : NULL;
5565         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5566         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, NULL, values, &offset, array);
5567       } break;
5568     default:
5569       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5570     }
5571     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5572   }
5573   /* Cleanup points */
5574   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5575   /* Cleanup array */
5576   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5577   PetscFunctionReturn(0);
5578 }
5579 
5580 static PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5581 {
5582   PetscMPIInt    rank;
5583   PetscInt       i, j;
5584   PetscErrorCode ierr;
5585 
5586   PetscFunctionBegin;
5587   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRMPI(ierr);
5588   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for point %D\n", rank, point);CHKERRQ(ierr);
5589   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5590   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5591   numCIndices = numCIndices ? numCIndices : numRIndices;
5592   if (!values) PetscFunctionReturn(0);
5593   for (i = 0; i < numRIndices; i++) {
5594     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
5595     for (j = 0; j < numCIndices; j++) {
5596 #if defined(PETSC_USE_COMPLEX)
5597       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5598 #else
5599       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5600 #endif
5601     }
5602     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5603   }
5604   PetscFunctionReturn(0);
5605 }
5606 
5607 /*
5608   DMPlexGetIndicesPoint_Internal - Add the indices for dofs on a point to an index array
5609 
5610   Input Parameters:
5611 + section - The section for this data layout
5612 . islocal - Is the section (and thus indices being requested) local or global?
5613 . point   - The point contributing dofs with these indices
5614 . off     - The global offset of this point
5615 . loff    - The local offset of each field
5616 . setBC   - The flag determining whether to include indices of bounsary values
5617 . perm    - A permutation of the dofs on this point, or NULL
5618 - indperm - A permutation of the entire indices array, or NULL
5619 
5620   Output Parameter:
5621 . indices - Indices for dofs on this point
5622 
5623   Level: developer
5624 
5625   Note: The indices could be local or global, depending on the value of 'off'.
5626 */
5627 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscBool islocal,PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], const PetscInt indperm[], PetscInt indices[])
5628 {
5629   PetscInt        dof;   /* The number of unknowns on this point */
5630   PetscInt        cdof;  /* The number of constraints on this point */
5631   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5632   PetscInt        cind = 0, k;
5633   PetscErrorCode  ierr;
5634 
5635   PetscFunctionBegin;
5636   if (!islocal && setBC) SETERRQ(PetscObjectComm((PetscObject)section),PETSC_ERR_ARG_INCOMP,"setBC incompatible with global indices; use a local section or disable setBC");
5637   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5638   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5639   if (!cdof || setBC) {
5640     for (k = 0; k < dof; ++k) {
5641       const PetscInt preind = perm ? *loff+perm[k] : *loff+k;
5642       const PetscInt ind    = indperm ? indperm[preind] : preind;
5643 
5644       indices[ind] = off + k;
5645     }
5646   } else {
5647     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5648     for (k = 0; k < dof; ++k) {
5649       const PetscInt preind = perm ? *loff+perm[k] : *loff+k;
5650       const PetscInt ind    = indperm ? indperm[preind] : preind;
5651 
5652       if ((cind < cdof) && (k == cdofs[cind])) {
5653         /* Insert check for returning constrained indices */
5654         indices[ind] = -(off+k+1);
5655         ++cind;
5656       } else {
5657         indices[ind] = off + k - (islocal ? 0 : cind);
5658       }
5659     }
5660   }
5661   *loff += dof;
5662   PetscFunctionReturn(0);
5663 }
5664 
5665 /*
5666  DMPlexGetIndicesPointFields_Internal - gets section indices for a point in its canonical ordering.
5667 
5668  Input Parameters:
5669 + section - a section (global or local)
5670 - islocal - PETSC_TRUE if requesting local indices (i.e., section is local); PETSC_FALSE for global
5671 . point - point within section
5672 . off - The offset of this point in the (local or global) indexed space - should match islocal and (usually) the section
5673 . foffs - array of length numFields containing the offset in canonical point ordering (the location in indices) of each field
5674 . setBC - identify constrained (boundary condition) points via involution.
5675 . perms - perms[f][permsoff][:] is a permutation of dofs within each field
5676 . permsoff - offset
5677 - indperm - index permutation
5678 
5679  Output Parameter:
5680 . foffs - each entry is incremented by the number of (unconstrained if setBC=FALSE) dofs in that field
5681 . indices - array to hold indices (as defined by section) of each dof associated with point
5682 
5683  Notes:
5684  If section is local and setBC=true, there is no distinction between constrained and unconstrained dofs.
5685  If section is local and setBC=false, the indices for constrained points are the involution -(i+1) of their position
5686  in the local vector.
5687 
5688  If section is global and setBC=false, the indices for constrained points are negative (and their value is not
5689  significant).  It is invalid to call with a global section and setBC=true.
5690 
5691  Developer Note:
5692  The section is only used for field layout, so islocal is technically a statement about the offset (off).  At some point
5693  in the future, global sections may have fields set, in which case we could pass the global section and obtain the
5694  offset could be obtained from the section instead of passing it explicitly as we do now.
5695 
5696  Example:
5697  Suppose a point contains one field with three components, and for which the unconstrained indices are {10, 11, 12}.
5698  When the middle component is constrained, we get the array {10, -12, 12} for (islocal=TRUE, setBC=FALSE).
5699  Note that -12 is the involution of 11, so the user can involute negative indices to recover local indices.
5700  The global vector does not store constrained dofs, so when this function returns global indices, say {110, -112, 111}, the value of -112 is an arbitrary flag that should not be interpreted beyond its sign.
5701 
5702  Level: developer
5703 */
5704 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscBool islocal, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, const PetscInt indperm[], PetscInt indices[])
5705 {
5706   PetscInt       numFields, foff, f;
5707   PetscErrorCode ierr;
5708 
5709   PetscFunctionBegin;
5710   if (!islocal && setBC) SETERRQ(PetscObjectComm((PetscObject)section),PETSC_ERR_ARG_INCOMP,"setBC incompatible with global indices; use a local section or disable setBC");
5711   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5712   for (f = 0, foff = 0; f < numFields; ++f) {
5713     PetscInt        fdof, cfdof;
5714     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5715     PetscInt        cind = 0, b;
5716     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
5717 
5718     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5719     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5720     if (!cfdof || setBC) {
5721       for (b = 0; b < fdof; ++b) {
5722         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5723         const PetscInt ind    = indperm ? indperm[preind] : preind;
5724 
5725         indices[ind] = off+foff+b;
5726       }
5727     } else {
5728       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5729       for (b = 0; b < fdof; ++b) {
5730         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5731         const PetscInt ind    = indperm ? indperm[preind] : preind;
5732 
5733         if ((cind < cfdof) && (b == fcdofs[cind])) {
5734           indices[ind] = -(off+foff+b+1);
5735           ++cind;
5736         } else {
5737           indices[ind] = off + foff + b - (islocal ? 0 : cind);
5738         }
5739       }
5740     }
5741     foff     += (setBC || islocal ? fdof : (fdof - cfdof));
5742     foffs[f] += fdof;
5743   }
5744   PetscFunctionReturn(0);
5745 }
5746 
5747 /*
5748   This version believes the globalSection offsets for each field, rather than just the point offset
5749 
5750  . foffs - The offset into 'indices' for each field, since it is segregated by field
5751 
5752  Notes:
5753  The semantics of this function relate to that of setBC=FALSE in DMPlexGetIndicesPointFields_Internal.
5754  Since this function uses global indices, setBC=TRUE would be invalid, so no such argument exists.
5755 */
5756 static PetscErrorCode DMPlexGetIndicesPointFieldsSplit_Internal(PetscSection section, PetscSection globalSection, PetscInt point, PetscInt foffs[], const PetscInt ***perms, PetscInt permsoff, const PetscInt indperm[], PetscInt indices[])
5757 {
5758   PetscInt       numFields, foff, f;
5759   PetscErrorCode ierr;
5760 
5761   PetscFunctionBegin;
5762   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5763   for (f = 0; f < numFields; ++f) {
5764     PetscInt        fdof, cfdof;
5765     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5766     PetscInt        cind = 0, b;
5767     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
5768 
5769     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5770     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5771     ierr = PetscSectionGetFieldOffset(globalSection, point, f, &foff);CHKERRQ(ierr);
5772     if (!cfdof) {
5773       for (b = 0; b < fdof; ++b) {
5774         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5775         const PetscInt ind    = indperm ? indperm[preind] : preind;
5776 
5777         indices[ind] = foff+b;
5778       }
5779     } else {
5780       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5781       for (b = 0; b < fdof; ++b) {
5782         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5783         const PetscInt ind    = indperm ? indperm[preind] : preind;
5784 
5785         if ((cind < cfdof) && (b == fcdofs[cind])) {
5786           indices[ind] = -(foff+b+1);
5787           ++cind;
5788         } else {
5789           indices[ind] = foff+b-cind;
5790         }
5791       }
5792     }
5793     foffs[f] += fdof;
5794   }
5795   PetscFunctionReturn(0);
5796 }
5797 
5798 PetscErrorCode DMPlexAnchorsModifyMat(DM dm, PetscSection section, PetscInt numPoints, PetscInt numIndices, const PetscInt points[], const PetscInt ***perms, const PetscScalar values[], PetscInt *outNumPoints, PetscInt *outNumIndices, PetscInt *outPoints[], PetscScalar *outValues[], PetscInt offsets[], PetscBool multiplyLeft)
5799 {
5800   Mat             cMat;
5801   PetscSection    aSec, cSec;
5802   IS              aIS;
5803   PetscInt        aStart = -1, aEnd = -1;
5804   const PetscInt  *anchors;
5805   PetscInt        numFields, f, p, q, newP = 0;
5806   PetscInt        newNumPoints = 0, newNumIndices = 0;
5807   PetscInt        *newPoints, *indices, *newIndices;
5808   PetscInt        maxAnchor, maxDof;
5809   PetscInt        newOffsets[32];
5810   PetscInt        *pointMatOffsets[32];
5811   PetscInt        *newPointOffsets[32];
5812   PetscScalar     *pointMat[32];
5813   PetscScalar     *newValues=NULL,*tmpValues;
5814   PetscBool       anyConstrained = PETSC_FALSE;
5815   PetscErrorCode  ierr;
5816 
5817   PetscFunctionBegin;
5818   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5819   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5820   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5821 
5822   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
5823   /* if there are point-to-point constraints */
5824   if (aSec) {
5825     ierr = PetscArrayzero(newOffsets, 32);CHKERRQ(ierr);
5826     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5827     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
5828     /* figure out how many points are going to be in the new element matrix
5829      * (we allow double counting, because it's all just going to be summed
5830      * into the global matrix anyway) */
5831     for (p = 0; p < 2*numPoints; p+=2) {
5832       PetscInt b    = points[p];
5833       PetscInt bDof = 0, bSecDof;
5834 
5835       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5836       if (!bSecDof) {
5837         continue;
5838       }
5839       if (b >= aStart && b < aEnd) {
5840         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
5841       }
5842       if (bDof) {
5843         /* this point is constrained */
5844         /* it is going to be replaced by its anchors */
5845         PetscInt bOff, q;
5846 
5847         anyConstrained = PETSC_TRUE;
5848         newNumPoints  += bDof;
5849         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
5850         for (q = 0; q < bDof; q++) {
5851           PetscInt a = anchors[bOff + q];
5852           PetscInt aDof;
5853 
5854           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5855           newNumIndices += aDof;
5856           for (f = 0; f < numFields; ++f) {
5857             PetscInt fDof;
5858 
5859             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
5860             newOffsets[f+1] += fDof;
5861           }
5862         }
5863       }
5864       else {
5865         /* this point is not constrained */
5866         newNumPoints++;
5867         newNumIndices += bSecDof;
5868         for (f = 0; f < numFields; ++f) {
5869           PetscInt fDof;
5870 
5871           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5872           newOffsets[f+1] += fDof;
5873         }
5874       }
5875     }
5876   }
5877   if (!anyConstrained) {
5878     if (outNumPoints)  *outNumPoints  = 0;
5879     if (outNumIndices) *outNumIndices = 0;
5880     if (outPoints)     *outPoints     = NULL;
5881     if (outValues)     *outValues     = NULL;
5882     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
5883     PetscFunctionReturn(0);
5884   }
5885 
5886   if (outNumPoints)  *outNumPoints  = newNumPoints;
5887   if (outNumIndices) *outNumIndices = newNumIndices;
5888 
5889   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
5890 
5891   if (!outPoints && !outValues) {
5892     if (offsets) {
5893       for (f = 0; f <= numFields; f++) {
5894         offsets[f] = newOffsets[f];
5895       }
5896     }
5897     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
5898     PetscFunctionReturn(0);
5899   }
5900 
5901   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
5902 
5903   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
5904 
5905   /* workspaces */
5906   if (numFields) {
5907     for (f = 0; f < numFields; f++) {
5908       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5909       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5910     }
5911   }
5912   else {
5913     ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5914     ierr = DMGetWorkArray(dm,numPoints,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5915   }
5916 
5917   /* get workspaces for the point-to-point matrices */
5918   if (numFields) {
5919     PetscInt totalOffset, totalMatOffset;
5920 
5921     for (p = 0; p < numPoints; p++) {
5922       PetscInt b    = points[2*p];
5923       PetscInt bDof = 0, bSecDof;
5924 
5925       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5926       if (!bSecDof) {
5927         for (f = 0; f < numFields; f++) {
5928           newPointOffsets[f][p + 1] = 0;
5929           pointMatOffsets[f][p + 1] = 0;
5930         }
5931         continue;
5932       }
5933       if (b >= aStart && b < aEnd) {
5934         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5935       }
5936       if (bDof) {
5937         for (f = 0; f < numFields; f++) {
5938           PetscInt fDof, q, bOff, allFDof = 0;
5939 
5940           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5941           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5942           for (q = 0; q < bDof; q++) {
5943             PetscInt a = anchors[bOff + q];
5944             PetscInt aFDof;
5945 
5946             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
5947             allFDof += aFDof;
5948           }
5949           newPointOffsets[f][p+1] = allFDof;
5950           pointMatOffsets[f][p+1] = fDof * allFDof;
5951         }
5952       }
5953       else {
5954         for (f = 0; f < numFields; f++) {
5955           PetscInt fDof;
5956 
5957           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5958           newPointOffsets[f][p+1] = fDof;
5959           pointMatOffsets[f][p+1] = 0;
5960         }
5961       }
5962     }
5963     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
5964       newPointOffsets[f][0] = totalOffset;
5965       pointMatOffsets[f][0] = totalMatOffset;
5966       for (p = 0; p < numPoints; p++) {
5967         newPointOffsets[f][p+1] += newPointOffsets[f][p];
5968         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
5969       }
5970       totalOffset    = newPointOffsets[f][numPoints];
5971       totalMatOffset = pointMatOffsets[f][numPoints];
5972       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5973     }
5974   }
5975   else {
5976     for (p = 0; p < numPoints; p++) {
5977       PetscInt b    = points[2*p];
5978       PetscInt bDof = 0, bSecDof;
5979 
5980       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5981       if (!bSecDof) {
5982         newPointOffsets[0][p + 1] = 0;
5983         pointMatOffsets[0][p + 1] = 0;
5984         continue;
5985       }
5986       if (b >= aStart && b < aEnd) {
5987         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5988       }
5989       if (bDof) {
5990         PetscInt bOff, q, allDof = 0;
5991 
5992         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5993         for (q = 0; q < bDof; q++) {
5994           PetscInt a = anchors[bOff + q], aDof;
5995 
5996           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5997           allDof += aDof;
5998         }
5999         newPointOffsets[0][p+1] = allDof;
6000         pointMatOffsets[0][p+1] = bSecDof * allDof;
6001       }
6002       else {
6003         newPointOffsets[0][p+1] = bSecDof;
6004         pointMatOffsets[0][p+1] = 0;
6005       }
6006     }
6007     newPointOffsets[0][0] = 0;
6008     pointMatOffsets[0][0] = 0;
6009     for (p = 0; p < numPoints; p++) {
6010       newPointOffsets[0][p+1] += newPointOffsets[0][p];
6011       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
6012     }
6013     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
6014   }
6015 
6016   /* output arrays */
6017   ierr = DMGetWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
6018 
6019   /* get the point-to-point matrices; construct newPoints */
6020   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
6021   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6022   ierr = DMGetWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
6023   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
6024   if (numFields) {
6025     for (p = 0, newP = 0; p < numPoints; p++) {
6026       PetscInt b    = points[2*p];
6027       PetscInt o    = points[2*p+1];
6028       PetscInt bDof = 0, bSecDof;
6029 
6030       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
6031       if (!bSecDof) {
6032         continue;
6033       }
6034       if (b >= aStart && b < aEnd) {
6035         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
6036       }
6037       if (bDof) {
6038         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
6039 
6040         fStart[0] = 0;
6041         fEnd[0]   = 0;
6042         for (f = 0; f < numFields; f++) {
6043           PetscInt fDof;
6044 
6045           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
6046           fStart[f+1] = fStart[f] + fDof;
6047           fEnd[f+1]   = fStart[f+1];
6048         }
6049         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
6050         ierr = DMPlexGetIndicesPointFields_Internal(cSec, PETSC_TRUE, b, bOff, fEnd, PETSC_TRUE, perms, p, NULL, indices);CHKERRQ(ierr);
6051 
6052         fAnchorStart[0] = 0;
6053         fAnchorEnd[0]   = 0;
6054         for (f = 0; f < numFields; f++) {
6055           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
6056 
6057           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
6058           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
6059         }
6060         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
6061         for (q = 0; q < bDof; q++) {
6062           PetscInt a = anchors[bOff + q], aOff;
6063 
6064           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
6065           newPoints[2*(newP + q)]     = a;
6066           newPoints[2*(newP + q) + 1] = 0;
6067           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
6068           ierr = DMPlexGetIndicesPointFields_Internal(section, PETSC_TRUE, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, NULL, newIndices);CHKERRQ(ierr);
6069         }
6070         newP += bDof;
6071 
6072         if (outValues) {
6073           /* get the point-to-point submatrix */
6074           for (f = 0; f < numFields; f++) {
6075             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
6076           }
6077         }
6078       }
6079       else {
6080         newPoints[2 * newP]     = b;
6081         newPoints[2 * newP + 1] = o;
6082         newP++;
6083       }
6084     }
6085   } else {
6086     for (p = 0; p < numPoints; p++) {
6087       PetscInt b    = points[2*p];
6088       PetscInt o    = points[2*p+1];
6089       PetscInt bDof = 0, bSecDof;
6090 
6091       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
6092       if (!bSecDof) {
6093         continue;
6094       }
6095       if (b >= aStart && b < aEnd) {
6096         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
6097       }
6098       if (bDof) {
6099         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
6100 
6101         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
6102         ierr = DMPlexGetIndicesPoint_Internal(cSec, PETSC_TRUE, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, NULL, indices);CHKERRQ(ierr);
6103 
6104         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
6105         for (q = 0; q < bDof; q++) {
6106           PetscInt a = anchors[bOff + q], aOff;
6107 
6108           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
6109 
6110           newPoints[2*(newP + q)]     = a;
6111           newPoints[2*(newP + q) + 1] = 0;
6112           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
6113           ierr = DMPlexGetIndicesPoint_Internal(section, PETSC_TRUE, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, NULL, newIndices);CHKERRQ(ierr);
6114         }
6115         newP += bDof;
6116 
6117         /* get the point-to-point submatrix */
6118         if (outValues) {
6119           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
6120         }
6121       }
6122       else {
6123         newPoints[2 * newP]     = b;
6124         newPoints[2 * newP + 1] = o;
6125         newP++;
6126       }
6127     }
6128   }
6129 
6130   if (outValues) {
6131     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
6132     ierr = PetscArrayzero(tmpValues,newNumIndices*numIndices);CHKERRQ(ierr);
6133     /* multiply constraints on the right */
6134     if (numFields) {
6135       for (f = 0; f < numFields; f++) {
6136         PetscInt oldOff = offsets[f];
6137 
6138         for (p = 0; p < numPoints; p++) {
6139           PetscInt cStart = newPointOffsets[f][p];
6140           PetscInt b      = points[2 * p];
6141           PetscInt c, r, k;
6142           PetscInt dof;
6143 
6144           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
6145           if (!dof) {
6146             continue;
6147           }
6148           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
6149             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
6150             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
6151 
6152             for (r = 0; r < numIndices; r++) {
6153               for (c = 0; c < nCols; c++) {
6154                 for (k = 0; k < dof; k++) {
6155                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
6156                 }
6157               }
6158             }
6159           }
6160           else {
6161             /* copy this column as is */
6162             for (r = 0; r < numIndices; r++) {
6163               for (c = 0; c < dof; c++) {
6164                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
6165               }
6166             }
6167           }
6168           oldOff += dof;
6169         }
6170       }
6171     }
6172     else {
6173       PetscInt oldOff = 0;
6174       for (p = 0; p < numPoints; p++) {
6175         PetscInt cStart = newPointOffsets[0][p];
6176         PetscInt b      = points[2 * p];
6177         PetscInt c, r, k;
6178         PetscInt dof;
6179 
6180         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
6181         if (!dof) {
6182           continue;
6183         }
6184         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
6185           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
6186           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
6187 
6188           for (r = 0; r < numIndices; r++) {
6189             for (c = 0; c < nCols; c++) {
6190               for (k = 0; k < dof; k++) {
6191                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
6192               }
6193             }
6194           }
6195         }
6196         else {
6197           /* copy this column as is */
6198           for (r = 0; r < numIndices; r++) {
6199             for (c = 0; c < dof; c++) {
6200               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
6201             }
6202           }
6203         }
6204         oldOff += dof;
6205       }
6206     }
6207 
6208     if (multiplyLeft) {
6209       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
6210       ierr = PetscArrayzero(newValues,newNumIndices*newNumIndices);CHKERRQ(ierr);
6211       /* multiply constraints transpose on the left */
6212       if (numFields) {
6213         for (f = 0; f < numFields; f++) {
6214           PetscInt oldOff = offsets[f];
6215 
6216           for (p = 0; p < numPoints; p++) {
6217             PetscInt rStart = newPointOffsets[f][p];
6218             PetscInt b      = points[2 * p];
6219             PetscInt c, r, k;
6220             PetscInt dof;
6221 
6222             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
6223             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
6224               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
6225               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
6226 
6227               for (r = 0; r < nRows; r++) {
6228                 for (c = 0; c < newNumIndices; c++) {
6229                   for (k = 0; k < dof; k++) {
6230                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
6231                   }
6232                 }
6233               }
6234             }
6235             else {
6236               /* copy this row as is */
6237               for (r = 0; r < dof; r++) {
6238                 for (c = 0; c < newNumIndices; c++) {
6239                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
6240                 }
6241               }
6242             }
6243             oldOff += dof;
6244           }
6245         }
6246       }
6247       else {
6248         PetscInt oldOff = 0;
6249 
6250         for (p = 0; p < numPoints; p++) {
6251           PetscInt rStart = newPointOffsets[0][p];
6252           PetscInt b      = points[2 * p];
6253           PetscInt c, r, k;
6254           PetscInt dof;
6255 
6256           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
6257           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
6258             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
6259             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
6260 
6261             for (r = 0; r < nRows; r++) {
6262               for (c = 0; c < newNumIndices; c++) {
6263                 for (k = 0; k < dof; k++) {
6264                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
6265                 }
6266               }
6267             }
6268           }
6269           else {
6270             /* copy this row as is */
6271             for (r = 0; r < dof; r++) {
6272               for (c = 0; c < newNumIndices; c++) {
6273                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
6274               }
6275             }
6276           }
6277           oldOff += dof;
6278         }
6279       }
6280 
6281       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
6282     }
6283     else {
6284       newValues = tmpValues;
6285     }
6286   }
6287 
6288   /* clean up */
6289   ierr = DMRestoreWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
6290   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
6291 
6292   if (numFields) {
6293     for (f = 0; f < numFields; f++) {
6294       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
6295       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
6296       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
6297     }
6298   }
6299   else {
6300     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
6301     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
6302     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
6303   }
6304   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
6305 
6306   /* output */
6307   if (outPoints) {
6308     *outPoints = newPoints;
6309   }
6310   else {
6311     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
6312   }
6313   if (outValues) {
6314     *outValues = newValues;
6315   }
6316   for (f = 0; f <= numFields; f++) {
6317     offsets[f] = newOffsets[f];
6318   }
6319   PetscFunctionReturn(0);
6320 }
6321 
6322 /*@C
6323   DMPlexGetClosureIndices - Gets the global dof indices associated with the closure of the given point within the provided sections.
6324 
6325   Not collective
6326 
6327   Input Parameters:
6328 + dm         - The DM
6329 . section    - The PetscSection describing the points (a local section)
6330 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6331 . point      - The point defining the closure
6332 - useClPerm  - Use the closure point permutation if available
6333 
6334   Output Parameters:
6335 + numIndices - The number of dof indices in the closure of point with the input sections
6336 . indices    - The dof indices
6337 . outOffsets - Array to write the field offsets into, or NULL
6338 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6339 
6340   Notes:
6341   Must call DMPlexRestoreClosureIndices() to free allocated memory
6342 
6343   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6344   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6345   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6346   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6347   indices (with the above semantics) are implied.
6348 
6349   Level: advanced
6350 
6351 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6352 @*/
6353 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6354                                        PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6355 {
6356   /* Closure ordering */
6357   PetscSection        clSection;
6358   IS                  clPoints;
6359   const PetscInt     *clp;
6360   PetscInt           *points;
6361   const PetscInt     *clperm = NULL;
6362   /* Dof permutation and sign flips */
6363   const PetscInt    **perms[32] = {NULL};
6364   const PetscScalar **flips[32] = {NULL};
6365   PetscScalar        *valCopy   = NULL;
6366   /* Hanging node constraints */
6367   PetscInt           *pointsC = NULL;
6368   PetscScalar        *valuesC = NULL;
6369   PetscInt            NclC, NiC;
6370 
6371   PetscInt           *idx;
6372   PetscInt            Nf, Ncl, Ni = 0, offsets[32], p, f;
6373   PetscBool           isLocal = (section == idxSection) ? PETSC_TRUE : PETSC_FALSE;
6374   PetscErrorCode      ierr;
6375 
6376   PetscFunctionBeginHot;
6377   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6378   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6379   PetscValidHeaderSpecific(idxSection, PETSC_SECTION_CLASSID, 3);
6380   if (numIndices) PetscValidPointer(numIndices, 6);
6381   if (indices)    PetscValidPointer(indices, 7);
6382   if (outOffsets) PetscValidPointer(outOffsets, 8);
6383   if (values)     PetscValidPointer(values, 9);
6384   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
6385   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
6386   ierr = PetscArrayzero(offsets, 32);CHKERRQ(ierr);
6387   /* 1) Get points in closure */
6388   ierr = DMPlexGetCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6389   if (useClPerm) {
6390     PetscInt depth, clsize;
6391     ierr = DMPlexGetPointDepth(dm, point, &depth);CHKERRQ(ierr);
6392     for (clsize=0,p=0; p<Ncl; p++) {
6393       PetscInt dof;
6394       ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
6395       clsize += dof;
6396     }
6397     ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &clperm);CHKERRQ(ierr);
6398   }
6399   /* 2) Get number of indices on these points and field offsets from section */
6400   for (p = 0; p < Ncl*2; p += 2) {
6401     PetscInt dof, fdof;
6402 
6403     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6404     for (f = 0; f < Nf; ++f) {
6405       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6406       offsets[f+1] += fdof;
6407     }
6408     Ni += dof;
6409   }
6410   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
6411   if (Nf && offsets[Nf] != Ni) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Ni);
6412   /* 3) Get symmetries and sign flips. Apply sign flips to values if passed in (only works for square values matrix) */
6413   for (f = 0; f < PetscMax(1, Nf); ++f) {
6414     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6415     else    {ierr = PetscSectionGetPointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6416     /* may need to apply sign changes to the element matrix */
6417     if (values && flips[f]) {
6418       PetscInt foffset = offsets[f];
6419 
6420       for (p = 0; p < Ncl; ++p) {
6421         PetscInt           pnt  = points[2*p], fdof;
6422         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
6423 
6424         if (!Nf) {ierr = PetscSectionGetDof(section, pnt, &fdof);CHKERRQ(ierr);}
6425         else     {ierr = PetscSectionGetFieldDof(section, pnt, f, &fdof);CHKERRQ(ierr);}
6426         if (flip) {
6427           PetscInt i, j, k;
6428 
6429           if (!valCopy) {
6430             ierr = DMGetWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);
6431             for (j = 0; j < Ni * Ni; ++j) valCopy[j] = (*values)[j];
6432             *values = valCopy;
6433           }
6434           for (i = 0; i < fdof; ++i) {
6435             PetscScalar fval = flip[i];
6436 
6437             for (k = 0; k < Ni; ++k) {
6438               valCopy[Ni * (foffset + i) + k] *= fval;
6439               valCopy[Ni * k + (foffset + i)] *= fval;
6440             }
6441           }
6442         }
6443         foffset += fdof;
6444       }
6445     }
6446   }
6447   /* 4) Apply hanging node constraints. Get new symmetries and replace all storage with constrained storage */
6448   ierr = DMPlexAnchorsModifyMat(dm, section, Ncl, Ni, points, perms, values ? *values : NULL, &NclC, &NiC, &pointsC, values ? &valuesC : NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
6449   if (NclC) {
6450     if (valCopy) {ierr = DMRestoreWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);}
6451     for (f = 0; f < PetscMax(1, Nf); ++f) {
6452       if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6453       else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6454     }
6455     for (f = 0; f < PetscMax(1, Nf); ++f) {
6456       if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6457       else    {ierr = PetscSectionGetPointSyms(section, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6458     }
6459     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6460     Ncl     = NclC;
6461     Ni      = NiC;
6462     points  = pointsC;
6463     if (values) *values = valuesC;
6464   }
6465   /* 5) Calculate indices */
6466   ierr = DMGetWorkArray(dm, Ni, MPIU_INT, &idx);CHKERRQ(ierr);
6467   if (Nf) {
6468     PetscInt  idxOff;
6469     PetscBool useFieldOffsets;
6470 
6471     if (outOffsets) {for (f = 0; f <= Nf; f++) outOffsets[f] = offsets[f];}
6472     ierr = PetscSectionGetUseFieldOffsets(idxSection, &useFieldOffsets);CHKERRQ(ierr);
6473     if (useFieldOffsets) {
6474       for (p = 0; p < Ncl; ++p) {
6475         const PetscInt pnt = points[p*2];
6476 
6477         ierr = DMPlexGetIndicesPointFieldsSplit_Internal(section, idxSection, pnt, offsets, perms, p, clperm, idx);CHKERRQ(ierr);
6478       }
6479     } else {
6480       for (p = 0; p < Ncl; ++p) {
6481         const PetscInt pnt = points[p*2];
6482 
6483         ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6484         /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6485          * not (at the time of this writing) have fields set. They probably should, in which case we would pass the
6486          * global section. */
6487         ierr = DMPlexGetIndicesPointFields_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, offsets, PETSC_FALSE, perms, p, clperm, idx);CHKERRQ(ierr);
6488       }
6489     }
6490   } else {
6491     PetscInt off = 0, idxOff;
6492 
6493     for (p = 0; p < Ncl; ++p) {
6494       const PetscInt  pnt  = points[p*2];
6495       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
6496 
6497       ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6498       /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6499        * not (at the time of this writing) have fields set. They probably should, in which case we would pass the global section. */
6500       ierr = DMPlexGetIndicesPoint_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, &off, PETSC_FALSE, perm, clperm, idx);CHKERRQ(ierr);
6501     }
6502   }
6503   /* 6) Cleanup */
6504   for (f = 0; f < PetscMax(1, Nf); ++f) {
6505     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6506     else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6507   }
6508   if (NclC) {
6509     ierr = DMRestoreWorkArray(dm, NclC*2, MPIU_INT, &pointsC);CHKERRQ(ierr);
6510   } else {
6511     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6512   }
6513 
6514   if (numIndices) *numIndices = Ni;
6515   if (indices)    *indices    = idx;
6516   PetscFunctionReturn(0);
6517 }
6518 
6519 /*@C
6520   DMPlexRestoreClosureIndices - Restores the global dof indices associated with the closure of the given point within the provided sections.
6521 
6522   Not collective
6523 
6524   Input Parameters:
6525 + dm         - The DM
6526 . section    - The PetscSection describing the points (a local section)
6527 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6528 . point      - The point defining the closure
6529 - useClPerm  - Use the closure point permutation if available
6530 
6531   Output Parameters:
6532 + numIndices - The number of dof indices in the closure of point with the input sections
6533 . indices    - The dof indices
6534 . outOffsets - Array to write the field offsets into, or NULL
6535 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6536 
6537   Notes:
6538   If values were modified, the user is responsible for calling DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values).
6539 
6540   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6541   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6542   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6543   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6544   indices (with the above semantics) are implied.
6545 
6546   Level: advanced
6547 
6548 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6549 @*/
6550 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6551                                            PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6552 {
6553   PetscErrorCode ierr;
6554 
6555   PetscFunctionBegin;
6556   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6557   PetscValidPointer(indices, 5);
6558   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
6559   PetscFunctionReturn(0);
6560 }
6561 
6562 /*@C
6563   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
6564 
6565   Not collective
6566 
6567   Input Parameters:
6568 + dm - The DM
6569 . section - The section describing the layout in v, or NULL to use the default section
6570 . globalSection - The section describing the layout in v, or NULL to use the default global section
6571 . A - The matrix
6572 . point - The point in the DM
6573 . values - The array of values
6574 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6575 
6576   Fortran Notes:
6577   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
6578 
6579   Level: intermediate
6580 
6581 .seealso DMPlexMatSetClosureGeneral(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6582 @*/
6583 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6584 {
6585   DM_Plex           *mesh = (DM_Plex*) dm->data;
6586   PetscInt          *indices;
6587   PetscInt           numIndices;
6588   const PetscScalar *valuesOrig = values;
6589   PetscErrorCode     ierr;
6590 
6591   PetscFunctionBegin;
6592   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6593   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
6594   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6595   if (!globalSection) {ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
6596   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
6597   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
6598 
6599   ierr = DMPlexGetClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6600 
6601   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
6602   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
6603   if (ierr) {
6604     PetscMPIInt    rank;
6605     PetscErrorCode ierr2;
6606 
6607     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6608     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6609     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
6610     ierr2 = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6611     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6612     CHKERRQ(ierr);
6613   }
6614   if (mesh->printFEM > 1) {
6615     PetscInt i;
6616     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
6617     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
6618     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6619   }
6620 
6621   ierr = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6622   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6623   PetscFunctionReturn(0);
6624 }
6625 
6626 /*@C
6627   DMPlexMatSetClosure - Set an array of the values on the closure of 'point' using a different row and column section
6628 
6629   Not collective
6630 
6631   Input Parameters:
6632 + dmRow - The DM for the row fields
6633 . sectionRow - The section describing the layout, or NULL to use the default section in dmRow
6634 . globalSectionRow - The section describing the layout, or NULL to use the default global section in dmRow
6635 . dmCol - The DM for the column fields
6636 . sectionCol - The section describing the layout, or NULL to use the default section in dmCol
6637 . globalSectionCol - The section describing the layout, or NULL to use the default global section in dmCol
6638 . A - The matrix
6639 . point - The point in the DMs
6640 . values - The array of values
6641 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6642 
6643   Level: intermediate
6644 
6645 .seealso DMPlexMatSetClosure(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6646 @*/
6647 PetscErrorCode DMPlexMatSetClosureGeneral(DM dmRow, PetscSection sectionRow, PetscSection globalSectionRow, DM dmCol, PetscSection sectionCol, PetscSection globalSectionCol, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6648 {
6649   DM_Plex           *mesh = (DM_Plex*) dmRow->data;
6650   PetscInt          *indicesRow, *indicesCol;
6651   PetscInt           numIndicesRow, numIndicesCol;
6652   const PetscScalar *valuesOrig = values;
6653   PetscErrorCode     ierr;
6654 
6655   PetscFunctionBegin;
6656   PetscValidHeaderSpecific(dmRow, DM_CLASSID, 1);
6657   if (!sectionRow) {ierr = DMGetLocalSection(dmRow, &sectionRow);CHKERRQ(ierr);}
6658   PetscValidHeaderSpecific(sectionRow, PETSC_SECTION_CLASSID, 2);
6659   if (!globalSectionRow) {ierr = DMGetGlobalSection(dmRow, &globalSectionRow);CHKERRQ(ierr);}
6660   PetscValidHeaderSpecific(globalSectionRow, PETSC_SECTION_CLASSID, 3);
6661   PetscValidHeaderSpecific(dmCol, DM_CLASSID, 4);
6662   if (!sectionCol) {ierr = DMGetLocalSection(dmCol, &sectionCol);CHKERRQ(ierr);}
6663   PetscValidHeaderSpecific(sectionCol, PETSC_SECTION_CLASSID, 5);
6664   if (!globalSectionCol) {ierr = DMGetGlobalSection(dmCol, &globalSectionCol);CHKERRQ(ierr);}
6665   PetscValidHeaderSpecific(globalSectionCol, PETSC_SECTION_CLASSID, 6);
6666   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6667 
6668   ierr = DMPlexGetClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6669   ierr = DMPlexGetClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6670 
6671   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr);}
6672   ierr = MatSetValues(A, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values, mode);
6673   if (ierr) {
6674     PetscMPIInt    rank;
6675     PetscErrorCode ierr2;
6676 
6677     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6678     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6679     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr2);
6680     ierr2 = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6681     ierr2 = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6682     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6683     CHKERRQ(ierr);
6684   }
6685 
6686   ierr = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6687   ierr = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6688   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6689   PetscFunctionReturn(0);
6690 }
6691 
6692 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6693 {
6694   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
6695   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
6696   PetscInt       *cpoints = NULL;
6697   PetscInt       *findices, *cindices;
6698   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6699   PetscInt        foffsets[32], coffsets[32];
6700   DMPolytopeType  ct;
6701   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6702   PetscErrorCode  ierr;
6703 
6704   PetscFunctionBegin;
6705   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6706   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6707   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6708   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6709   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6710   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6711   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6712   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6713   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6714   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6715   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6716   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6717   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6718   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6719   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6720   /* Column indices */
6721   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6722   maxFPoints = numCPoints;
6723   /* Compress out points not in the section */
6724   /*   TODO: Squeeze out points with 0 dof as well */
6725   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6726   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6727     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6728       cpoints[q*2]   = cpoints[p];
6729       cpoints[q*2+1] = cpoints[p+1];
6730       ++q;
6731     }
6732   }
6733   numCPoints = q;
6734   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6735     PetscInt fdof;
6736 
6737     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6738     if (!dof) continue;
6739     for (f = 0; f < numFields; ++f) {
6740       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6741       coffsets[f+1] += fdof;
6742     }
6743     numCIndices += dof;
6744   }
6745   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6746   /* Row indices */
6747   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6748   {
6749     DMPlexCellRefiner cr;
6750     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6751     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6752     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6753   }
6754   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6755   for (r = 0, q = 0; r < numSubcells; ++r) {
6756     /* TODO Map from coarse to fine cells */
6757     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6758     /* Compress out points not in the section */
6759     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6760     for (p = 0; p < numFPoints*2; p += 2) {
6761       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6762         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6763         if (!dof) continue;
6764         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6765         if (s < q) continue;
6766         ftotpoints[q*2]   = fpoints[p];
6767         ftotpoints[q*2+1] = fpoints[p+1];
6768         ++q;
6769       }
6770     }
6771     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6772   }
6773   numFPoints = q;
6774   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6775     PetscInt fdof;
6776 
6777     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6778     if (!dof) continue;
6779     for (f = 0; f < numFields; ++f) {
6780       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6781       foffsets[f+1] += fdof;
6782     }
6783     numFIndices += dof;
6784   }
6785   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6786 
6787   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6788   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6789   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6790   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6791   if (numFields) {
6792     const PetscInt **permsF[32] = {NULL};
6793     const PetscInt **permsC[32] = {NULL};
6794 
6795     for (f = 0; f < numFields; f++) {
6796       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6797       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6798     }
6799     for (p = 0; p < numFPoints; p++) {
6800       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6801       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6802     }
6803     for (p = 0; p < numCPoints; p++) {
6804       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6805       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6806     }
6807     for (f = 0; f < numFields; f++) {
6808       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6809       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6810     }
6811   } else {
6812     const PetscInt **permsF = NULL;
6813     const PetscInt **permsC = NULL;
6814 
6815     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6816     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6817     for (p = 0, off = 0; p < numFPoints; p++) {
6818       const PetscInt *perm = permsF ? permsF[p] : NULL;
6819 
6820       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6821       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6822     }
6823     for (p = 0, off = 0; p < numCPoints; p++) {
6824       const PetscInt *perm = permsC ? permsC[p] : NULL;
6825 
6826       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6827       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6828     }
6829     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6830     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6831   }
6832   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6833   /* TODO: flips */
6834   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6835   if (ierr) {
6836     PetscMPIInt    rank;
6837     PetscErrorCode ierr2;
6838 
6839     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6840     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6841     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6842     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
6843     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
6844     CHKERRQ(ierr);
6845   }
6846   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6847   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6848   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6849   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6850   PetscFunctionReturn(0);
6851 }
6852 
6853 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
6854 {
6855   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
6856   PetscInt      *cpoints = NULL;
6857   PetscInt       foffsets[32], coffsets[32];
6858   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6859   DMPolytopeType ct;
6860   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6861   PetscErrorCode ierr;
6862 
6863   PetscFunctionBegin;
6864   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6865   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6866   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6867   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6868   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6869   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6870   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6871   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6872   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6873   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6874   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6875   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6876   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6877   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6878   /* Column indices */
6879   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6880   maxFPoints = numCPoints;
6881   /* Compress out points not in the section */
6882   /*   TODO: Squeeze out points with 0 dof as well */
6883   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6884   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6885     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6886       cpoints[q*2]   = cpoints[p];
6887       cpoints[q*2+1] = cpoints[p+1];
6888       ++q;
6889     }
6890   }
6891   numCPoints = q;
6892   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6893     PetscInt fdof;
6894 
6895     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6896     if (!dof) continue;
6897     for (f = 0; f < numFields; ++f) {
6898       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6899       coffsets[f+1] += fdof;
6900     }
6901     numCIndices += dof;
6902   }
6903   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6904   /* Row indices */
6905   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6906   {
6907     DMPlexCellRefiner cr;
6908     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6909     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6910     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6911   }
6912   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6913   for (r = 0, q = 0; r < numSubcells; ++r) {
6914     /* TODO Map from coarse to fine cells */
6915     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6916     /* Compress out points not in the section */
6917     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6918     for (p = 0; p < numFPoints*2; p += 2) {
6919       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6920         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6921         if (!dof) continue;
6922         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6923         if (s < q) continue;
6924         ftotpoints[q*2]   = fpoints[p];
6925         ftotpoints[q*2+1] = fpoints[p+1];
6926         ++q;
6927       }
6928     }
6929     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6930   }
6931   numFPoints = q;
6932   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6933     PetscInt fdof;
6934 
6935     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6936     if (!dof) continue;
6937     for (f = 0; f < numFields; ++f) {
6938       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6939       foffsets[f+1] += fdof;
6940     }
6941     numFIndices += dof;
6942   }
6943   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6944 
6945   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6946   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6947   if (numFields) {
6948     const PetscInt **permsF[32] = {NULL};
6949     const PetscInt **permsC[32] = {NULL};
6950 
6951     for (f = 0; f < numFields; f++) {
6952       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6953       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6954     }
6955     for (p = 0; p < numFPoints; p++) {
6956       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6957       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6958     }
6959     for (p = 0; p < numCPoints; p++) {
6960       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6961       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6962     }
6963     for (f = 0; f < numFields; f++) {
6964       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6965       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6966     }
6967   } else {
6968     const PetscInt **permsF = NULL;
6969     const PetscInt **permsC = NULL;
6970 
6971     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6972     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6973     for (p = 0, off = 0; p < numFPoints; p++) {
6974       const PetscInt *perm = permsF ? permsF[p] : NULL;
6975 
6976       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6977       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6978     }
6979     for (p = 0, off = 0; p < numCPoints; p++) {
6980       const PetscInt *perm = permsC ? permsC[p] : NULL;
6981 
6982       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6983       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6984     }
6985     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6986     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6987   }
6988   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6989   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6990   PetscFunctionReturn(0);
6991 }
6992 
6993 /*@C
6994   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6995 
6996   Input Parameter:
6997 . dm   - The DMPlex object
6998 
6999   Output Parameter:
7000 . cellHeight - The height of a cell
7001 
7002   Level: developer
7003 
7004 .seealso DMPlexSetVTKCellHeight()
7005 @*/
7006 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
7007 {
7008   DM_Plex *mesh = (DM_Plex*) dm->data;
7009 
7010   PetscFunctionBegin;
7011   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7012   PetscValidPointer(cellHeight, 2);
7013   *cellHeight = mesh->vtkCellHeight;
7014   PetscFunctionReturn(0);
7015 }
7016 
7017 /*@C
7018   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
7019 
7020   Input Parameters:
7021 + dm   - The DMPlex object
7022 - cellHeight - The height of a cell
7023 
7024   Level: developer
7025 
7026 .seealso DMPlexGetVTKCellHeight()
7027 @*/
7028 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
7029 {
7030   DM_Plex *mesh = (DM_Plex*) dm->data;
7031 
7032   PetscFunctionBegin;
7033   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7034   mesh->vtkCellHeight = cellHeight;
7035   PetscFunctionReturn(0);
7036 }
7037 
7038 /*@
7039   DMPlexGetGhostCellStratum - Get the range of cells which are used to enforce FV boundary conditions
7040 
7041   Input Parameter:
7042 . dm - The DMPlex object
7043 
7044   Output Parameters:
7045 + gcStart - The first ghost cell, or NULL
7046 - gcEnd   - The upper bound on ghost cells, or NULL
7047 
7048   Level: advanced
7049 
7050 .seealso DMPlexConstructGhostCells(), DMPlexSetGhostCellStratum()
7051 @*/
7052 PetscErrorCode DMPlexGetGhostCellStratum(DM dm, PetscInt *gcStart, PetscInt *gcEnd)
7053 {
7054   DMLabel        ctLabel;
7055   PetscErrorCode ierr;
7056 
7057   PetscFunctionBegin;
7058   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7059   ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
7060   ierr = DMLabelGetStratumBounds(ctLabel, DM_POLYTOPE_FV_GHOST, gcStart, gcEnd);CHKERRQ(ierr);
7061   PetscFunctionReturn(0);
7062 }
7063 
7064 /* We can easily have a form that takes an IS instead */
7065 PetscErrorCode DMPlexCreateNumbering_Plex(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
7066 {
7067   PetscSection   section, globalSection;
7068   PetscInt      *numbers, p;
7069   PetscErrorCode ierr;
7070 
7071   PetscFunctionBegin;
7072   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
7073   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
7074   for (p = pStart; p < pEnd; ++p) {
7075     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
7076   }
7077   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
7078   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7079   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
7080   for (p = pStart; p < pEnd; ++p) {
7081     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
7082     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
7083     else                       numbers[p-pStart] += shift;
7084   }
7085   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
7086   if (globalSize) {
7087     PetscLayout layout;
7088     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
7089     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
7090     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
7091   }
7092   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
7093   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7094   PetscFunctionReturn(0);
7095 }
7096 
7097 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
7098 {
7099   PetscInt       cellHeight, cStart, cEnd;
7100   PetscErrorCode ierr;
7101 
7102   PetscFunctionBegin;
7103   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7104   if (includeHybrid) {ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
7105   else               {ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
7106   ierr = DMPlexCreateNumbering_Plex(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
7107   PetscFunctionReturn(0);
7108 }
7109 
7110 /*@
7111   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
7112 
7113   Input Parameter:
7114 . dm   - The DMPlex object
7115 
7116   Output Parameter:
7117 . globalCellNumbers - Global cell numbers for all cells on this process
7118 
7119   Level: developer
7120 
7121 .seealso DMPlexGetVertexNumbering()
7122 @*/
7123 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7124 {
7125   DM_Plex       *mesh = (DM_Plex*) dm->data;
7126   PetscErrorCode ierr;
7127 
7128   PetscFunctionBegin;
7129   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7130   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
7131   *globalCellNumbers = mesh->globalCellNumbers;
7132   PetscFunctionReturn(0);
7133 }
7134 
7135 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
7136 {
7137   PetscInt       vStart, vEnd;
7138   PetscErrorCode ierr;
7139 
7140   PetscFunctionBegin;
7141   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7142   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7143   ierr = DMPlexCreateNumbering_Plex(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
7144   PetscFunctionReturn(0);
7145 }
7146 
7147 /*@
7148   DMPlexGetVertexNumbering - Get a global vertex numbering for all vertices on this process
7149 
7150   Input Parameter:
7151 . dm   - The DMPlex object
7152 
7153   Output Parameter:
7154 . globalVertexNumbers - Global vertex numbers for all vertices on this process
7155 
7156   Level: developer
7157 
7158 .seealso DMPlexGetCellNumbering()
7159 @*/
7160 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7161 {
7162   DM_Plex       *mesh = (DM_Plex*) dm->data;
7163   PetscErrorCode ierr;
7164 
7165   PetscFunctionBegin;
7166   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7167   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
7168   *globalVertexNumbers = mesh->globalVertexNumbers;
7169   PetscFunctionReturn(0);
7170 }
7171 
7172 /*@
7173   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
7174 
7175   Input Parameter:
7176 . dm   - The DMPlex object
7177 
7178   Output Parameter:
7179 . globalPointNumbers - Global numbers for all points on this process
7180 
7181   Level: developer
7182 
7183 .seealso DMPlexGetCellNumbering()
7184 @*/
7185 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
7186 {
7187   IS             nums[4];
7188   PetscInt       depths[4], gdepths[4], starts[4];
7189   PetscInt       depth, d, shift = 0;
7190   PetscErrorCode ierr;
7191 
7192   PetscFunctionBegin;
7193   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7194   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7195   /* For unstratified meshes use dim instead of depth */
7196   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
7197   for (d = 0; d <= depth; ++d) {
7198     PetscInt end;
7199 
7200     depths[d] = depth-d;
7201     ierr = DMPlexGetDepthStratum(dm, depths[d], &starts[d], &end);CHKERRQ(ierr);
7202     if (!(starts[d]-end)) { starts[d] = depths[d] = -1; }
7203   }
7204   ierr = PetscSortIntWithArray(depth+1, starts, depths);CHKERRQ(ierr);
7205   ierr = MPIU_Allreduce(depths, gdepths, depth+1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
7206   for (d = 0; d <= depth; ++d) {
7207     if (starts[d] >= 0 && depths[d] != gdepths[d]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected depth %D, found %D",depths[d],gdepths[d]);
7208   }
7209   for (d = 0; d <= depth; ++d) {
7210     PetscInt pStart, pEnd, gsize;
7211 
7212     ierr = DMPlexGetDepthStratum(dm, gdepths[d], &pStart, &pEnd);CHKERRQ(ierr);
7213     ierr = DMPlexCreateNumbering_Plex(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
7214     shift += gsize;
7215   }
7216   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
7217   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
7218   PetscFunctionReturn(0);
7219 }
7220 
7221 
7222 /*@
7223   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
7224 
7225   Input Parameter:
7226 . dm - The DMPlex object
7227 
7228   Output Parameter:
7229 . ranks - The rank field
7230 
7231   Options Database Keys:
7232 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
7233 
7234   Level: intermediate
7235 
7236 .seealso: DMView()
7237 @*/
7238 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
7239 {
7240   DM             rdm;
7241   PetscFE        fe;
7242   PetscScalar   *r;
7243   PetscMPIInt    rank;
7244   DMPolytopeType ct;
7245   PetscInt       dim, cStart, cEnd, c;
7246   PetscBool      simplex;
7247   PetscErrorCode ierr;
7248 
7249   PetscFunctionBeginUser;
7250   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7251   PetscValidPointer(ranks, 2);
7252   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRMPI(ierr);
7253   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7254   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7255   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7256   ierr = DMPlexGetCellType(dm, cStart, &ct);CHKERRQ(ierr);
7257   simplex = DMPolytopeTypeGetNumVertices(ct) == DMPolytopeTypeGetDim(ct)+1 ? PETSC_TRUE : PETSC_FALSE;
7258   ierr = PetscFECreateDefault(PETSC_COMM_SELF, dim, 1, simplex, "PETSc___rank_", -1, &fe);CHKERRQ(ierr);
7259   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
7260   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7261   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7262   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7263   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
7264   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
7265   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
7266   for (c = cStart; c < cEnd; ++c) {
7267     PetscScalar *lr;
7268 
7269     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
7270     if (lr) *lr = rank;
7271   }
7272   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
7273   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7274   PetscFunctionReturn(0);
7275 }
7276 
7277 /*@
7278   DMPlexCreateLabelField - Create a cell field whose value is the label value for that cell
7279 
7280   Input Parameters:
7281 + dm    - The DMPlex
7282 - label - The DMLabel
7283 
7284   Output Parameter:
7285 . val - The label value field
7286 
7287   Options Database Keys:
7288 . -dm_label_view - Adds the label value field into the DM output from -dm_view using the same viewer
7289 
7290   Level: intermediate
7291 
7292 .seealso: DMView()
7293 @*/
7294 PetscErrorCode DMPlexCreateLabelField(DM dm, DMLabel label, Vec *val)
7295 {
7296   DM             rdm;
7297   PetscFE        fe;
7298   PetscScalar   *v;
7299   PetscInt       dim, cStart, cEnd, c;
7300   PetscErrorCode ierr;
7301 
7302   PetscFunctionBeginUser;
7303   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7304   PetscValidPointer(label, 2);
7305   PetscValidPointer(val, 3);
7306   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7307   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7308   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___label_value_", -1, &fe);CHKERRQ(ierr);
7309   ierr = PetscObjectSetName((PetscObject) fe, "label_value");CHKERRQ(ierr);
7310   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7311   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7312   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7313   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7314   ierr = DMCreateGlobalVector(rdm, val);CHKERRQ(ierr);
7315   ierr = PetscObjectSetName((PetscObject) *val, "label_value");CHKERRQ(ierr);
7316   ierr = VecGetArray(*val, &v);CHKERRQ(ierr);
7317   for (c = cStart; c < cEnd; ++c) {
7318     PetscScalar *lv;
7319     PetscInt     cval;
7320 
7321     ierr = DMPlexPointGlobalRef(rdm, c, v, &lv);CHKERRQ(ierr);
7322     ierr = DMLabelGetValue(label, c, &cval);CHKERRQ(ierr);
7323     *lv = cval;
7324   }
7325   ierr = VecRestoreArray(*val, &v);CHKERRQ(ierr);
7326   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7327   PetscFunctionReturn(0);
7328 }
7329 
7330 /*@
7331   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
7332 
7333   Input Parameter:
7334 . dm - The DMPlex object
7335 
7336   Notes:
7337   This is a useful diagnostic when creating meshes programmatically.
7338 
7339   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7340 
7341   Level: developer
7342 
7343 .seealso: DMCreate(), DMSetFromOptions()
7344 @*/
7345 PetscErrorCode DMPlexCheckSymmetry(DM dm)
7346 {
7347   PetscSection    coneSection, supportSection;
7348   const PetscInt *cone, *support;
7349   PetscInt        coneSize, c, supportSize, s;
7350   PetscInt        pStart, pEnd, p, pp, csize, ssize;
7351   PetscBool       storagecheck = PETSC_TRUE;
7352   PetscErrorCode  ierr;
7353 
7354   PetscFunctionBegin;
7355   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7356   ierr = DMViewFromOptions(dm, NULL, "-sym_dm_view");CHKERRQ(ierr);
7357   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
7358   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
7359   /* Check that point p is found in the support of its cone points, and vice versa */
7360   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
7361   for (p = pStart; p < pEnd; ++p) {
7362     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
7363     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
7364     for (c = 0; c < coneSize; ++c) {
7365       PetscBool dup = PETSC_FALSE;
7366       PetscInt  d;
7367       for (d = c-1; d >= 0; --d) {
7368         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
7369       }
7370       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
7371       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
7372       for (s = 0; s < supportSize; ++s) {
7373         if (support[s] == p) break;
7374       }
7375       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
7376         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
7377         for (s = 0; s < coneSize; ++s) {
7378           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
7379         }
7380         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7381         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
7382         for (s = 0; s < supportSize; ++s) {
7383           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
7384         }
7385         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7386         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
7387         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
7388       }
7389     }
7390     ierr = DMPlexGetTreeParent(dm, p, &pp, NULL);CHKERRQ(ierr);
7391     if (p != pp) { storagecheck = PETSC_FALSE; continue; }
7392     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
7393     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
7394     for (s = 0; s < supportSize; ++s) {
7395       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
7396       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
7397       for (c = 0; c < coneSize; ++c) {
7398         ierr = DMPlexGetTreeParent(dm, cone[c], &pp, NULL);CHKERRQ(ierr);
7399         if (cone[c] != pp) { c = 0; break; }
7400         if (cone[c] == p) break;
7401       }
7402       if (c >= coneSize) {
7403         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
7404         for (c = 0; c < supportSize; ++c) {
7405           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
7406         }
7407         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7408         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
7409         for (c = 0; c < coneSize; ++c) {
7410           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
7411         }
7412         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7413         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
7414       }
7415     }
7416   }
7417   if (storagecheck) {
7418     ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
7419     ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
7420     if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
7421   }
7422   PetscFunctionReturn(0);
7423 }
7424 
7425 /*
7426   For submeshes with cohesive cells (see DMPlexConstructCohesiveCells()), we allow a special case where some of the boundary of a face (edges and vertices) are not duplicated. We call these special boundary points "unsplit", since the same edge or vertex appears in both copies of the face. These unsplit points throw off our counting, so we have to explicitly account for them here.
7427 */
7428 static PetscErrorCode DMPlexCellUnsplitVertices_Private(DM dm, PetscInt c, DMPolytopeType ct, PetscInt *unsplit)
7429 {
7430   DMPolytopeType  cct;
7431   PetscInt        ptpoints[4];
7432   const PetscInt *cone, *ccone, *ptcone;
7433   PetscInt        coneSize, cp, cconeSize, ccp, npt = 0, pt;
7434   PetscErrorCode  ierr;
7435 
7436   PetscFunctionBegin;
7437   *unsplit = 0;
7438   switch (ct) {
7439     case DM_POLYTOPE_SEG_PRISM_TENSOR:
7440       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7441       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7442       for (cp = 0; cp < coneSize; ++cp) {
7443         ierr = DMPlexGetCellType(dm, cone[cp], &cct);CHKERRQ(ierr);
7444         if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) ptpoints[npt++] = cone[cp];
7445       }
7446       break;
7447     case DM_POLYTOPE_TRI_PRISM_TENSOR:
7448     case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7449       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7450       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7451       for (cp = 0; cp < coneSize; ++cp) {
7452         ierr = DMPlexGetCone(dm, cone[cp], &ccone);CHKERRQ(ierr);
7453         ierr = DMPlexGetConeSize(dm, cone[cp], &cconeSize);CHKERRQ(ierr);
7454         for (ccp = 0; ccp < cconeSize; ++ccp) {
7455           ierr = DMPlexGetCellType(dm, ccone[ccp], &cct);CHKERRQ(ierr);
7456           if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) {
7457             PetscInt p;
7458             for (p = 0; p < npt; ++p) if (ptpoints[p] == ccone[ccp]) break;
7459             if (p == npt) ptpoints[npt++] = ccone[ccp];
7460           }
7461         }
7462       }
7463       break;
7464     default: break;
7465   }
7466   for (pt = 0; pt < npt; ++pt) {
7467     ierr = DMPlexGetCone(dm, ptpoints[pt], &ptcone);CHKERRQ(ierr);
7468     if (ptcone[0] == ptcone[1]) ++(*unsplit);
7469   }
7470   PetscFunctionReturn(0);
7471 }
7472 
7473 /*@
7474   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
7475 
7476   Input Parameters:
7477 + dm - The DMPlex object
7478 - cellHeight - Normally 0
7479 
7480   Notes:
7481   This is a useful diagnostic when creating meshes programmatically.
7482   Currently applicable only to homogeneous simplex or tensor meshes.
7483 
7484   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7485 
7486   Level: developer
7487 
7488 .seealso: DMCreate(), DMSetFromOptions()
7489 @*/
7490 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscInt cellHeight)
7491 {
7492   DMPlexInterpolatedFlag interp;
7493   DMPolytopeType         ct;
7494   PetscInt               vStart, vEnd, cStart, cEnd, c;
7495   PetscErrorCode         ierr;
7496 
7497   PetscFunctionBegin;
7498   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7499   ierr = DMPlexIsInterpolated(dm, &interp);CHKERRQ(ierr);
7500   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7501   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7502   for (c = cStart; c < cEnd; ++c) {
7503     PetscInt *closure = NULL;
7504     PetscInt  coneSize, closureSize, cl, Nv = 0;
7505 
7506     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7507     if ((PetscInt) ct < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has no cell type", c);
7508     if (ct == DM_POLYTOPE_UNKNOWN) continue;
7509     if (interp == DMPLEX_INTERPOLATED_FULL) {
7510       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7511       if (coneSize != DMPolytopeTypeGetConeSize(ct)) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has cone size %D != %D", c, DMPolytopeTypes[ct], coneSize, DMPolytopeTypeGetConeSize(ct));
7512     }
7513     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7514     for (cl = 0; cl < closureSize*2; cl += 2) {
7515       const PetscInt p = closure[cl];
7516       if ((p >= vStart) && (p < vEnd)) ++Nv;
7517     }
7518     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7519     /* Special Case: Tensor faces with identified vertices */
7520     if (Nv < DMPolytopeTypeGetNumVertices(ct)) {
7521       PetscInt unsplit;
7522 
7523       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7524       if (Nv + unsplit == DMPolytopeTypeGetNumVertices(ct)) continue;
7525     }
7526     if (Nv != DMPolytopeTypeGetNumVertices(ct)) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has %D vertices != %D", c, DMPolytopeTypes[ct], Nv, DMPolytopeTypeGetNumVertices(ct));
7527   }
7528   PetscFunctionReturn(0);
7529 }
7530 
7531 /*@
7532   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
7533 
7534   Not Collective
7535 
7536   Input Parameters:
7537 + dm - The DMPlex object
7538 - cellHeight - Normally 0
7539 
7540   Notes:
7541   This is a useful diagnostic when creating meshes programmatically.
7542   This routine is only relevant for meshes that are fully interpolated across all ranks.
7543   It will error out if a partially interpolated mesh is given on some rank.
7544   It will do nothing for locally uninterpolated mesh (as there is nothing to check).
7545 
7546   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7547 
7548   Level: developer
7549 
7550 .seealso: DMCreate(), DMPlexGetVTKCellHeight(), DMSetFromOptions()
7551 @*/
7552 PetscErrorCode DMPlexCheckFaces(DM dm, PetscInt cellHeight)
7553 {
7554   PetscInt       dim, depth, vStart, vEnd, cStart, cEnd, c, h;
7555   PetscErrorCode ierr;
7556   DMPlexInterpolatedFlag interpEnum;
7557 
7558   PetscFunctionBegin;
7559   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7560   ierr = DMPlexIsInterpolated(dm, &interpEnum);CHKERRQ(ierr);
7561   if (interpEnum == DMPLEX_INTERPOLATED_NONE) PetscFunctionReturn(0);
7562   if (interpEnum == DMPLEX_INTERPOLATED_PARTIAL) {
7563     PetscMPIInt rank;
7564     MPI_Comm    comm;
7565 
7566     ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
7567     ierr = MPI_Comm_rank(comm, &rank);CHKERRMPI(ierr);
7568     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Mesh is only partially interpolated on rank %d, this is currently not supported", rank);
7569   }
7570 
7571   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7572   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7573   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7574   for (h = cellHeight; h < PetscMin(depth, dim); ++h) {
7575     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
7576     for (c = cStart; c < cEnd; ++c) {
7577       const PetscInt      *cone, *ornt, *faceSizes, *faces;
7578       const DMPolytopeType *faceTypes;
7579       DMPolytopeType        ct;
7580       PetscInt              numFaces, coneSize, f;
7581       PetscInt             *closure = NULL, closureSize, cl, numCorners = 0, fOff = 0, unsplit;
7582 
7583       ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7584       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7585       if (unsplit) continue;
7586       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7587       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7588       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
7589       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7590       for (cl = 0; cl < closureSize*2; cl += 2) {
7591         const PetscInt p = closure[cl];
7592         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
7593       }
7594       ierr = DMPlexGetRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7595       if (coneSize != numFaces) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has %D faces but should have %D", c, DMPolytopeTypes[ct], coneSize, numFaces);
7596       for (f = 0; f < numFaces; ++f) {
7597         DMPolytopeType fct;
7598         PetscInt       *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
7599 
7600         ierr = DMPlexGetCellType(dm, cone[f], &fct);CHKERRQ(ierr);
7601         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7602         for (cl = 0; cl < fclosureSize*2; cl += 2) {
7603           const PetscInt p = fclosure[cl];
7604           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
7605         }
7606         if (fnumCorners != faceSizes[f]) SETERRQ7(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D of type %s (cone idx %D) of cell %D of type %s has %D vertices but should have %D", cone[f], DMPolytopeTypes[fct], f, c, DMPolytopeTypes[ct], fnumCorners, faceSizes[f]);
7607         for (v = 0; v < fnumCorners; ++v) {
7608           if (fclosure[v] != faces[fOff+v]) SETERRQ8(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D of type %s (cone idx %d) of cell %D of type %s vertex %D, %D != %D", cone[f], DMPolytopeTypes[fct], f, c, DMPolytopeTypes[ct], v, fclosure[v], faces[fOff+v]);
7609         }
7610         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7611         fOff += faceSizes[f];
7612       }
7613       ierr = DMPlexRestoreRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7614       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7615     }
7616   }
7617   PetscFunctionReturn(0);
7618 }
7619 
7620 /*@
7621   DMPlexCheckGeometry - Check the geometry of mesh cells
7622 
7623   Input Parameter:
7624 . dm - The DMPlex object
7625 
7626   Notes:
7627   This is a useful diagnostic when creating meshes programmatically.
7628 
7629   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7630 
7631   Level: developer
7632 
7633 .seealso: DMCreate(), DMSetFromOptions()
7634 @*/
7635 PetscErrorCode DMPlexCheckGeometry(DM dm)
7636 {
7637   PetscReal      detJ, J[9], refVol = 1.0;
7638   PetscReal      vol;
7639   PetscBool      periodic;
7640   PetscInt       dim, depth, dE, d, cStart, cEnd, c;
7641   PetscErrorCode ierr;
7642 
7643   PetscFunctionBegin;
7644   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7645   ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
7646   if (dim != dE) PetscFunctionReturn(0);
7647   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7648   ierr = DMGetPeriodicity(dm, &periodic, NULL, NULL, NULL);CHKERRQ(ierr);
7649   for (d = 0; d < dim; ++d) refVol *= 2.0;
7650   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7651   for (c = cStart; c < cEnd; ++c) {
7652     DMPolytopeType ct;
7653     PetscInt       unsplit;
7654     PetscBool      ignoreZeroVol = PETSC_FALSE;
7655 
7656     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7657     switch (ct) {
7658       case DM_POLYTOPE_SEG_PRISM_TENSOR:
7659       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7660       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7661         ignoreZeroVol = PETSC_TRUE; break;
7662       default: break;
7663     }
7664     switch (ct) {
7665       case DM_POLYTOPE_TRI_PRISM:
7666       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7667       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7668         continue;
7669       default: break;
7670     }
7671     ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7672     if (unsplit) continue;
7673     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, NULL, J, NULL, &detJ);CHKERRQ(ierr);
7674     if (detJ < -PETSC_SMALL || (detJ <= 0.0 && !ignoreZeroVol)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D of type %s is inverted, |J| = %g", c, DMPolytopeTypes[ct], (double) detJ);
7675     ierr = PetscInfo2(dm, "Cell %D FEM Volume %g\n", c, (double) detJ*refVol);CHKERRQ(ierr);
7676     if (depth > 1 && !periodic) {
7677       ierr = DMPlexComputeCellGeometryFVM(dm, c, &vol, NULL, NULL);CHKERRQ(ierr);
7678       if (vol < -PETSC_SMALL || (vol <= 0.0 && !ignoreZeroVol)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D of type %s is inverted, vol = %g", c, DMPolytopeTypes[ct], (double) vol);
7679       ierr = PetscInfo2(dm, "Cell %D FVM Volume %g\n", c, (double) vol);CHKERRQ(ierr);
7680     }
7681   }
7682   PetscFunctionReturn(0);
7683 }
7684 
7685 /*@
7686   DMPlexCheckPointSF - Check that several necessary conditions are met for the point SF of this plex.
7687 
7688   Input Parameters:
7689 . dm - The DMPlex object
7690 
7691   Notes:
7692   This is mainly intended for debugging/testing purposes.
7693   It currently checks only meshes with no partition overlapping.
7694 
7695   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7696 
7697   Level: developer
7698 
7699 .seealso: DMGetPointSF(), DMSetFromOptions()
7700 @*/
7701 PetscErrorCode DMPlexCheckPointSF(DM dm)
7702 {
7703   PetscSF         pointSF;
7704   PetscInt        cellHeight, cStart, cEnd, l, nleaves, nroots, overlap;
7705   const PetscInt *locals, *rootdegree;
7706   PetscBool       distributed;
7707   PetscErrorCode  ierr;
7708 
7709   PetscFunctionBegin;
7710   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7711   ierr = DMGetPointSF(dm, &pointSF);CHKERRQ(ierr);
7712   ierr = DMPlexIsDistributed(dm, &distributed);CHKERRQ(ierr);
7713   if (!distributed) PetscFunctionReturn(0);
7714   ierr = DMPlexGetOverlap(dm, &overlap);CHKERRQ(ierr);
7715   if (overlap) {
7716     ierr = PetscPrintf(PetscObjectComm((PetscObject)dm), "Warning: DMPlexCheckPointSF() is currently not implemented for meshes with partition overlapping");
7717     PetscFunctionReturn(0);
7718   }
7719   if (!pointSF) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but does not have PointSF attached");
7720   ierr = PetscSFGetGraph(pointSF, &nroots, &nleaves, &locals, NULL);CHKERRQ(ierr);
7721   if (nroots < 0) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but its PointSF has no graph set");
7722   ierr = PetscSFComputeDegreeBegin(pointSF, &rootdegree);CHKERRQ(ierr);
7723   ierr = PetscSFComputeDegreeEnd(pointSF, &rootdegree);CHKERRQ(ierr);
7724 
7725   /* 1) check there are no faces in 2D, cells in 3D, in interface */
7726   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7727   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7728   for (l = 0; l < nleaves; ++l) {
7729     const PetscInt point = locals[l];
7730 
7731     if (point >= cStart && point < cEnd) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D which is a cell", point);
7732   }
7733 
7734   /* 2) if some point is in interface, then all its cone points must be also in interface (either as leaves or roots) */
7735   for (l = 0; l < nleaves; ++l) {
7736     const PetscInt  point = locals[l];
7737     const PetscInt *cone;
7738     PetscInt        coneSize, c, idx;
7739 
7740     ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
7741     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
7742     for (c = 0; c < coneSize; ++c) {
7743       if (!rootdegree[cone[c]]) {
7744         ierr = PetscFindInt(cone[c], nleaves, locals, &idx);CHKERRQ(ierr);
7745         if (idx < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D but not %D from its cone", point, cone[c]);
7746       }
7747     }
7748   }
7749   PetscFunctionReturn(0);
7750 }
7751 
7752 typedef struct cell_stats
7753 {
7754   PetscReal min, max, sum, squaresum;
7755   PetscInt  count;
7756 } cell_stats_t;
7757 
7758 static void MPIAPI cell_stats_reduce(void *a, void *b, int * len, MPI_Datatype *datatype)
7759 {
7760   PetscInt i, N = *len;
7761 
7762   for (i = 0; i < N; i++) {
7763     cell_stats_t *A = (cell_stats_t *) a;
7764     cell_stats_t *B = (cell_stats_t *) b;
7765 
7766     B->min = PetscMin(A->min,B->min);
7767     B->max = PetscMax(A->max,B->max);
7768     B->sum += A->sum;
7769     B->squaresum += A->squaresum;
7770     B->count += A->count;
7771   }
7772 }
7773 
7774 /*@
7775   DMPlexCheckCellShape - Checks the Jacobian of the mapping from reference to real cells and computes some minimal statistics.
7776 
7777   Collective on dm
7778 
7779   Input Parameters:
7780 + dm        - The DMPlex object
7781 . output    - If true, statistics will be displayed on stdout
7782 - condLimit - Display all cells above this condition number, or PETSC_DETERMINE for no cell output
7783 
7784   Notes:
7785   This is mainly intended for debugging/testing purposes.
7786 
7787   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7788 
7789   Level: developer
7790 
7791 .seealso: DMSetFromOptions(), DMPlexComputeOrthogonalQuality()
7792 @*/
7793 PetscErrorCode DMPlexCheckCellShape(DM dm, PetscBool output, PetscReal condLimit)
7794 {
7795   DM             dmCoarse;
7796   cell_stats_t   stats, globalStats;
7797   MPI_Comm       comm = PetscObjectComm((PetscObject)dm);
7798   PetscReal      *J, *invJ, min = 0, max = 0, mean = 0, stdev = 0;
7799   PetscReal      limit = condLimit > 0 ? condLimit : PETSC_MAX_REAL;
7800   PetscInt       cdim, cStart, cEnd, c, eStart, eEnd, count = 0;
7801   PetscMPIInt    rank,size;
7802   PetscErrorCode ierr;
7803 
7804   PetscFunctionBegin;
7805   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7806   stats.min   = PETSC_MAX_REAL;
7807   stats.max   = PETSC_MIN_REAL;
7808   stats.sum   = stats.squaresum = 0.;
7809   stats.count = 0;
7810 
7811   ierr = MPI_Comm_size(comm, &size);CHKERRMPI(ierr);
7812   ierr = MPI_Comm_rank(comm, &rank);CHKERRMPI(ierr);
7813   ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
7814   ierr = PetscMalloc2(PetscSqr(cdim), &J, PetscSqr(cdim), &invJ);CHKERRQ(ierr);
7815   ierr = DMPlexGetSimplexOrBoxCells(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
7816   ierr = DMPlexGetDepthStratum(dm,1,&eStart,&eEnd);CHKERRQ(ierr);
7817   for (c = cStart; c < cEnd; c++) {
7818     PetscInt  i;
7819     PetscReal frobJ = 0., frobInvJ = 0., cond2, cond, detJ;
7820 
7821     ierr = DMPlexComputeCellGeometryAffineFEM(dm,c,NULL,J,invJ,&detJ);CHKERRQ(ierr);
7822     if (detJ < 0.0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D is inverted", c);
7823     for (i = 0; i < PetscSqr(cdim); ++i) {
7824       frobJ    += J[i] * J[i];
7825       frobInvJ += invJ[i] * invJ[i];
7826     }
7827     cond2 = frobJ * frobInvJ;
7828     cond  = PetscSqrtReal(cond2);
7829 
7830     stats.min        = PetscMin(stats.min,cond);
7831     stats.max        = PetscMax(stats.max,cond);
7832     stats.sum       += cond;
7833     stats.squaresum += cond2;
7834     stats.count++;
7835     if (output && cond > limit) {
7836       PetscSection coordSection;
7837       Vec          coordsLocal;
7838       PetscScalar *coords = NULL;
7839       PetscInt     Nv, d, clSize, cl, *closure = NULL;
7840 
7841       ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
7842       ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
7843       ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7844       ierr = PetscSynchronizedPrintf(comm, "[%d] Cell %D cond %g\n", rank, c, (double) cond);CHKERRQ(ierr);
7845       for (i = 0; i < Nv/cdim; ++i) {
7846         ierr = PetscSynchronizedPrintf(comm, "  Vertex %D: (", i);CHKERRQ(ierr);
7847         for (d = 0; d < cdim; ++d) {
7848           if (d > 0) {ierr = PetscSynchronizedPrintf(comm, ", ");CHKERRQ(ierr);}
7849           ierr = PetscSynchronizedPrintf(comm, "%g", (double) PetscRealPart(coords[i*cdim+d]));CHKERRQ(ierr);
7850         }
7851         ierr = PetscSynchronizedPrintf(comm, ")\n");CHKERRQ(ierr);
7852       }
7853       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7854       for (cl = 0; cl < clSize*2; cl += 2) {
7855         const PetscInt edge = closure[cl];
7856 
7857         if ((edge >= eStart) && (edge < eEnd)) {
7858           PetscReal len;
7859 
7860           ierr = DMPlexComputeCellGeometryFVM(dm, edge, &len, NULL, NULL);CHKERRQ(ierr);
7861           ierr = PetscSynchronizedPrintf(comm, "  Edge %D: length %g\n", edge, (double) len);CHKERRQ(ierr);
7862         }
7863       }
7864       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7865       ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7866     }
7867   }
7868   if (output) {ierr = PetscSynchronizedFlush(comm, NULL);CHKERRQ(ierr);}
7869 
7870   if (size > 1) {
7871     PetscMPIInt   blockLengths[2] = {4,1};
7872     MPI_Aint      blockOffsets[2] = {offsetof(cell_stats_t,min),offsetof(cell_stats_t,count)};
7873     MPI_Datatype  blockTypes[2]   = {MPIU_REAL,MPIU_INT}, statType;
7874     MPI_Op        statReduce;
7875 
7876     ierr = MPI_Type_create_struct(2,blockLengths,blockOffsets,blockTypes,&statType);CHKERRMPI(ierr);
7877     ierr = MPI_Type_commit(&statType);CHKERRMPI(ierr);
7878     ierr = MPI_Op_create(cell_stats_reduce, PETSC_TRUE, &statReduce);CHKERRMPI(ierr);
7879     ierr = MPI_Reduce(&stats,&globalStats,1,statType,statReduce,0,comm);CHKERRMPI(ierr);
7880     ierr = MPI_Op_free(&statReduce);CHKERRMPI(ierr);
7881     ierr = MPI_Type_free(&statType);CHKERRMPI(ierr);
7882   } else {
7883     ierr = PetscArraycpy(&globalStats,&stats,1);CHKERRQ(ierr);
7884   }
7885   if (!rank) {
7886     count = globalStats.count;
7887     min   = globalStats.min;
7888     max   = globalStats.max;
7889     mean  = globalStats.sum / globalStats.count;
7890     stdev = globalStats.count > 1 ? PetscSqrtReal(PetscMax((globalStats.squaresum - globalStats.count * mean * mean) / (globalStats.count - 1),0)) : 0.0;
7891   }
7892 
7893   if (output) {
7894     ierr = PetscPrintf(comm,"Mesh with %D cells, shape condition numbers: min = %g, max = %g, mean = %g, stddev = %g\n", count, (double) min, (double) max, (double) mean, (double) stdev);CHKERRQ(ierr);
7895   }
7896   ierr = PetscFree2(J,invJ);CHKERRQ(ierr);
7897 
7898   ierr = DMGetCoarseDM(dm,&dmCoarse);CHKERRQ(ierr);
7899   if (dmCoarse) {
7900     PetscBool isplex;
7901 
7902     ierr = PetscObjectTypeCompare((PetscObject)dmCoarse,DMPLEX,&isplex);CHKERRQ(ierr);
7903     if (isplex) {
7904       ierr = DMPlexCheckCellShape(dmCoarse,output,condLimit);CHKERRQ(ierr);
7905     }
7906   }
7907   PetscFunctionReturn(0);
7908 }
7909 
7910 /*@
7911   DMPlexComputeOrthogonalQuality - Compute cell-wise orthogonal quality mesh statistic. Optionally tags all cells with
7912   orthogonal quality below given tolerance.
7913 
7914   Collective
7915 
7916   Input Parameters:
7917 + dm   - The DMPlex object
7918 . fv   - Optional PetscFV object for pre-computed cell/face centroid information
7919 - atol - [0, 1] Absolute tolerance for tagging cells.
7920 
7921   Output Parameters:
7922 + OrthQual      - Vec containing orthogonal quality per cell
7923 - OrthQualLabel - DMLabel tagging cells below atol with DM_ADAPT_REFINE
7924 
7925   Options Database Keys:
7926 + -dm_plex_orthogonal_quality_label_view - view OrthQualLabel if label is requested. Currently only PETSCVIEWERASCII is
7927 supported.
7928 - -dm_plex_orthogonal_quality_vec_view - view OrthQual vector.
7929 
7930   Notes:
7931   Orthogonal quality is given by the following formula:
7932 
7933   \min \left[ \frac{A_i \cdot f_i}{\|A_i\| \|f_i\|} , \frac{A_i \cdot c_i}{\|A_i\| \|c_i\|} \right]
7934 
7935   Where A_i is the i'th face-normal vector, f_i is the vector from the cell centroid to the i'th face centroid, and c_i
7936   is the vector from the current cells centroid to the centroid of its i'th neighbor (which shares a face with the
7937   current cell). This computes the vector similarity between each cell face and its corresponding neighbor centroid by
7938   calculating the cosine of the angle between these vectors.
7939 
7940   Orthogonal quality ranges from 1 (best) to 0 (worst).
7941 
7942   This routine is mainly useful for FVM, however is not restricted to only FVM. The PetscFV object is optionally used to check for
7943   pre-computed FVM cell data, but if it is not passed in then this data will be computed.
7944 
7945   Cells are tagged if they have an orthogonal quality less than or equal to the absolute tolerance.
7946 
7947   Level: intermediate
7948 
7949 .seealso: DMPlexCheckCellShape(), DMCreateLabel()
7950 @*/
7951 PetscErrorCode DMPlexComputeOrthogonalQuality(DM dm, PetscFV fv, PetscReal atol, Vec *OrthQual, DMLabel *OrthQualLabel)
7952 {
7953   PetscInt                nc, cellHeight, cStart, cEnd, cell;
7954   const PetscScalar       *cellGeomArr, *faceGeomArr;
7955   MPI_Comm                comm;
7956   Vec                     cellgeom, facegeom;
7957   DM                      dmFace, dmCell;
7958   IS                      glob;
7959   DMPlexInterpolatedFlag  interpFlag;
7960   ISLocalToGlobalMapping  ltog;
7961   PetscViewer             vwr;
7962   PetscErrorCode          ierr;
7963 
7964   PetscFunctionBegin;
7965   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7966   PetscValidPointer(OrthQual, 4);
7967   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
7968   ierr = DMGetDimension(dm, &nc);CHKERRQ(ierr);
7969   if (nc < 2) {
7970     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "DM must have dimension >= 2 (current %D)", nc);
7971   }
7972   ierr = DMPlexIsInterpolated(dm, &interpFlag);CHKERRQ(ierr);
7973   if (interpFlag != DMPLEX_INTERPOLATED_FULL) {
7974     PetscMPIInt  rank;
7975 
7976     ierr = MPI_Comm_rank(comm, &rank);CHKERRMPI(ierr);
7977     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "DM must be fully interpolated, DM on rank %d is not fully interpolated", rank);
7978   }
7979   if (OrthQualLabel) {
7980     PetscValidPointer(OrthQualLabel, 5);
7981     ierr = DMCreateLabel(dm, "Orthogonal_Quality");CHKERRQ(ierr);
7982     ierr = DMGetLabel(dm, "Orthogonal_Quality", OrthQualLabel);CHKERRQ(ierr);
7983   } else {
7984     *OrthQualLabel = NULL;
7985   }
7986 
7987   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7988   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7989   ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &glob);CHKERRQ(ierr);
7990   ierr = ISLocalToGlobalMappingCreateIS(glob, &ltog);CHKERRQ(ierr);
7991   ierr = ISLocalToGlobalMappingSetType(ltog, ISLOCALTOGLOBALMAPPINGHASH);CHKERRQ(ierr);
7992   ierr = VecCreate(comm, OrthQual);CHKERRQ(ierr);
7993   ierr = VecSetType(*OrthQual, VECSTANDARD);CHKERRQ(ierr);
7994   ierr = VecSetSizes(*OrthQual, cEnd-cStart, PETSC_DETERMINE);CHKERRQ(ierr);
7995   ierr = VecSetLocalToGlobalMapping(*OrthQual, ltog);CHKERRQ(ierr);
7996   ierr = VecSetUp(*OrthQual);CHKERRQ(ierr);
7997   ierr = ISDestroy(&glob);CHKERRQ(ierr);
7998   ierr = ISLocalToGlobalMappingDestroy(&ltog);CHKERRQ(ierr);
7999   ierr = DMPlexGetDataFVM(dm, fv, &cellgeom, &facegeom, NULL);CHKERRQ(ierr);
8000   ierr = VecGetArrayRead(cellgeom, &cellGeomArr);CHKERRQ(ierr);
8001   ierr = VecGetArrayRead(facegeom, &faceGeomArr);CHKERRQ(ierr);
8002   ierr = VecGetDM(cellgeom, &dmCell);CHKERRQ(ierr);
8003   ierr = VecGetDM(facegeom, &dmFace);CHKERRQ(ierr);
8004   for (cell = cStart; cell < cEnd; cell++) {
8005     PetscInt           cellneigh, cellneighiter = 0, nf, adjSize = PETSC_DETERMINE, ix = cell-cStart;
8006     const PetscInt     *cone;
8007     PetscInt           cellarr[2], *adj = NULL;
8008     PetscScalar        *cArr, *fArr;
8009     PetscReal          minvalc = 1.0, minvalf = 1.0, OQ;
8010     PetscFVCellGeom    *cg;
8011 
8012     cellarr[0] = cell;
8013     /* Make indexing into cellGeom easier */
8014     ierr = DMPlexPointLocalRead(dmCell, cell, cellGeomArr, &cg);CHKERRQ(ierr);
8015     ierr = DMPlexGetAdjacency_Internal(dm, cell, PETSC_TRUE, PETSC_FALSE, PETSC_FALSE, &adjSize, &adj);CHKERRQ(ierr);
8016     ierr = DMPlexGetConeSize(dm, cell, &nf);CHKERRQ(ierr);
8017     ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
8018     /* Technically 1 too big, but easier than fiddling with empty adjacency array */
8019     ierr = PetscCalloc2(adjSize, &cArr, adjSize, &fArr);CHKERRQ(ierr);
8020     for (cellneigh = 0; cellneigh < adjSize; cellneigh++) {
8021       PetscInt         numcovpts, i, neigh = adj[cellneigh];
8022       const PetscInt   *covpts;
8023       PetscReal        normci = 0, normfi = 0, normai = 0;
8024       PetscReal        *ci, *fi, *Ai;
8025       PetscFVCellGeom  *cgneigh;
8026       PetscFVFaceGeom  *fg;
8027 
8028       /* Don't count ourselves in the neighbor list */
8029       if (neigh == cell) continue;
8030       ierr = PetscMalloc3(nc, &ci, nc, &fi, nc, &Ai);CHKERRQ(ierr);
8031       ierr = DMPlexPointLocalRead(dmCell, neigh, cellGeomArr, &cgneigh);CHKERRQ(ierr);
8032       cellarr[1] = neigh;
8033       ierr = DMPlexGetMeet(dm, 2, cellarr, &numcovpts, &covpts);CHKERRQ(ierr);
8034       ierr = DMPlexPointLocalRead(dmFace, covpts[0], faceGeomArr, &fg);CHKERRQ(ierr);
8035       ierr = DMPlexRestoreMeet(dm, 2, cellarr, &numcovpts, &covpts);CHKERRQ(ierr);
8036 
8037       /* Compute c_i, f_i and their norms */
8038       for (i = 0; i < nc; i++) {
8039         ci[i] = cgneigh->centroid[i] - cg->centroid[i];
8040         fi[i] = fg->centroid[i] - cg->centroid[i];
8041         Ai[i] = fg->normal[i];
8042         normci += PetscPowScalar(ci[i], 2);
8043         normfi += PetscPowScalar(fi[i], 2);
8044         normai += PetscPowScalar(Ai[i], 2);
8045       }
8046       normci = PetscSqrtScalar(normci);
8047       normfi = PetscSqrtScalar(normfi);
8048       normai = PetscSqrtScalar(normai);
8049 
8050       /* Normalize and compute for each face-cell-normal pair */
8051       for (i = 0; i < nc; i++) {
8052         ci[i] = ci[i]/normci;
8053         fi[i] = fi[i]/normfi;
8054         Ai[i] = Ai[i]/normai;
8055         /* PetscAbs because I don't know if normals are guaranteed to point out */
8056         cArr[cellneighiter] += PetscAbs(Ai[i]*ci[i]);
8057         fArr[cellneighiter] += PetscAbs(Ai[i]*fi[i]);
8058       }
8059       if (PetscRealPart(cArr[cellneighiter]) < minvalc) {
8060         minvalc = PetscRealPart(cArr[cellneighiter]);
8061       }
8062       if (PetscRealPart(fArr[cellneighiter]) < minvalf) {
8063         minvalf = PetscRealPart(fArr[cellneighiter]);
8064       }
8065       cellneighiter++;
8066       ierr = PetscFree3(ci, fi, Ai);CHKERRQ(ierr);
8067     }
8068     ierr = PetscFree(adj);CHKERRQ(ierr);
8069     ierr = PetscFree2(cArr, fArr);CHKERRQ(ierr);
8070     /* Defer to cell if they're equal */
8071     OQ = PetscMin(minvalf, minvalc);
8072     if (OrthQualLabel) {
8073       if (OQ <= atol) {
8074         ierr = DMLabelSetValue(*OrthQualLabel, cell, DM_ADAPT_REFINE);CHKERRQ(ierr);
8075       }
8076     }
8077     ierr = VecSetValuesLocal(*OrthQual, 1, (const PetscInt *) &ix, (const PetscScalar *) &OQ, INSERT_VALUES);CHKERRQ(ierr);
8078   }
8079   ierr = VecAssemblyBegin(*OrthQual);CHKERRQ(ierr);
8080   ierr = VecAssemblyEnd(*OrthQual);CHKERRQ(ierr);
8081   ierr = VecRestoreArrayRead(cellgeom, &cellGeomArr);CHKERRQ(ierr);
8082   ierr = VecRestoreArrayRead(facegeom, &faceGeomArr);CHKERRQ(ierr);
8083   ierr = PetscOptionsGetViewer(comm, NULL, NULL, "-dm_plex_orthogonal_quality_label_view", &vwr, NULL, NULL);CHKERRQ(ierr);
8084   if (OrthQualLabel) {
8085     if (vwr) {
8086       ierr = DMLabelView(*OrthQualLabel, vwr);CHKERRQ(ierr);
8087     }
8088   }
8089   ierr = PetscViewerDestroy(&vwr);CHKERRQ(ierr);
8090   ierr = VecViewFromOptions(*OrthQual, NULL, "-dm_plex_orthogonal_quality_vec_view");CHKERRQ(ierr);
8091   PetscFunctionReturn(0);
8092 }
8093 
8094 /* Pointwise interpolation
8095      Just code FEM for now
8096      u^f = I u^c
8097      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
8098      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
8099      I_{ij} = psi^f_i phi^c_j
8100 */
8101 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
8102 {
8103   PetscSection   gsc, gsf;
8104   PetscInt       m, n;
8105   void          *ctx;
8106   DM             cdm;
8107   PetscBool      regular, ismatis, isRefined = dmCoarse->data == dmFine->data ? PETSC_FALSE : PETSC_TRUE;
8108   PetscErrorCode ierr;
8109 
8110   PetscFunctionBegin;
8111   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
8112   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
8113   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
8114   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
8115 
8116   ierr = PetscStrcmp(dmCoarse->mattype, MATIS, &ismatis);CHKERRQ(ierr);
8117   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
8118   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
8119   ierr = MatSetType(*interpolation, ismatis ? MATAIJ : dmCoarse->mattype);CHKERRQ(ierr);
8120   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
8121 
8122   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
8123   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
8124   if (!isRefined || (regular && cdm == dmCoarse)) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, isRefined, *interpolation, ctx);CHKERRQ(ierr);}
8125   else                                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
8126   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
8127   if (scaling) {
8128     /* Use naive scaling */
8129     ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
8130   }
8131   PetscFunctionReturn(0);
8132 }
8133 
8134 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
8135 {
8136   PetscErrorCode ierr;
8137   VecScatter     ctx;
8138 
8139   PetscFunctionBegin;
8140   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
8141   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
8142   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
8143   PetscFunctionReturn(0);
8144 }
8145 
8146 static void g0_identity_private(PetscInt dim, PetscInt Nf, PetscInt NfAux,
8147                                 const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
8148                                 const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
8149                                 PetscReal t, PetscReal u_tShift, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar g0[])
8150 {
8151   g0[0] = 1.0;
8152 }
8153 
8154 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
8155 {
8156   PetscSection   gsc, gsf;
8157   PetscInt       m, n;
8158   void          *ctx;
8159   DM             cdm;
8160   PetscBool      regular;
8161   PetscErrorCode ierr;
8162 
8163   PetscFunctionBegin;
8164   if (dmFine == dmCoarse) {
8165     DM       dmc;
8166     PetscDS  ds;
8167     Vec      u;
8168     IS       cellIS;
8169     PetscInt depth;
8170 
8171     ierr = DMClone(dmFine, &dmc);CHKERRQ(ierr);
8172     ierr = DMCopyDisc(dmFine, dmc);CHKERRQ(ierr);
8173     ierr = DMGetDS(dmc, &ds);CHKERRQ(ierr);
8174     ierr = PetscDSSetJacobian(ds, 0, 0, g0_identity_private, NULL, NULL, NULL);CHKERRQ(ierr);
8175     ierr = DMCreateMatrix(dmc, mass);CHKERRQ(ierr);
8176     ierr = DMGetGlobalVector(dmc, &u);CHKERRQ(ierr);
8177     ierr = DMPlexGetDepth(dmc, &depth);CHKERRQ(ierr);
8178     ierr = DMGetStratumIS(dmc, "depth", depth, &cellIS);CHKERRQ(ierr);
8179     ierr = MatZeroEntries(*mass);CHKERRQ(ierr);
8180     ierr = DMPlexComputeJacobian_Internal(dmc, cellIS, 0.0, 0.0, u, NULL, *mass, *mass, NULL);CHKERRQ(ierr);
8181     ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
8182     ierr = DMRestoreGlobalVector(dmc, &u);CHKERRQ(ierr);
8183     ierr = DMDestroy(&dmc);CHKERRQ(ierr);
8184   } else {
8185     ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
8186     ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
8187     ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
8188     ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
8189 
8190     ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
8191     ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
8192     ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
8193     ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
8194 
8195     ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
8196     ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
8197     if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
8198     else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
8199   }
8200   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
8201   PetscFunctionReturn(0);
8202 }
8203 
8204 /*@
8205   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
8206 
8207   Input Parameter:
8208 . dm - The DMPlex object
8209 
8210   Output Parameter:
8211 . regular - The flag
8212 
8213   Level: intermediate
8214 
8215 .seealso: DMPlexSetRegularRefinement()
8216 @*/
8217 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
8218 {
8219   PetscFunctionBegin;
8220   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8221   PetscValidPointer(regular, 2);
8222   *regular = ((DM_Plex *) dm->data)->regularRefinement;
8223   PetscFunctionReturn(0);
8224 }
8225 
8226 /*@
8227   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
8228 
8229   Input Parameters:
8230 + dm - The DMPlex object
8231 - regular - The flag
8232 
8233   Level: intermediate
8234 
8235 .seealso: DMPlexGetRegularRefinement()
8236 @*/
8237 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
8238 {
8239   PetscFunctionBegin;
8240   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8241   ((DM_Plex *) dm->data)->regularRefinement = regular;
8242   PetscFunctionReturn(0);
8243 }
8244 
8245 /*@
8246   DMPlexGetCellRefinerType - Get the strategy for refining a cell
8247 
8248   Input Parameter:
8249 . dm - The DMPlex object
8250 
8251   Output Parameter:
8252 . cr - The strategy number
8253 
8254   Level: intermediate
8255 
8256 .seealso: DMPlexSetCellRefinerType(), DMPlexSetRegularRefinement()
8257 @*/
8258 PetscErrorCode DMPlexGetCellRefinerType(DM dm, DMPlexCellRefinerType *cr)
8259 {
8260   PetscFunctionBegin;
8261   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8262   PetscValidPointer(cr, 2);
8263   *cr = ((DM_Plex *) dm->data)->cellRefiner;
8264   PetscFunctionReturn(0);
8265 }
8266 
8267 /*@
8268   DMPlexSetCellRefinerType - Set the strategy for refining a cell
8269 
8270   Input Parameters:
8271 + dm - The DMPlex object
8272 - cr - The strategy number
8273 
8274   Level: intermediate
8275 
8276 .seealso: DMPlexGetCellRefinerType(), DMPlexGetRegularRefinement()
8277 @*/
8278 PetscErrorCode DMPlexSetCellRefinerType(DM dm, DMPlexCellRefinerType cr)
8279 {
8280   PetscFunctionBegin;
8281   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8282   ((DM_Plex *) dm->data)->cellRefiner = cr;
8283   PetscFunctionReturn(0);
8284 }
8285 
8286 /* anchors */
8287 /*@
8288   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
8289   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
8290 
8291   not collective
8292 
8293   Input Parameters:
8294 . dm - The DMPlex object
8295 
8296   Output Parameters:
8297 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
8298 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
8299 
8300 
8301   Level: intermediate
8302 
8303 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
8304 @*/
8305 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
8306 {
8307   DM_Plex *plex = (DM_Plex *)dm->data;
8308   PetscErrorCode ierr;
8309 
8310   PetscFunctionBegin;
8311   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8312   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
8313   if (anchorSection) *anchorSection = plex->anchorSection;
8314   if (anchorIS) *anchorIS = plex->anchorIS;
8315   PetscFunctionReturn(0);
8316 }
8317 
8318 /*@
8319   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
8320   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
8321   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
8322 
8323   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
8324   DMGetConstraints() and filling in the entries in the constraint matrix.
8325 
8326   collective on dm
8327 
8328   Input Parameters:
8329 + dm - The DMPlex object
8330 . anchorSection - The section that describes the mapping from constrained points to the anchor points listed in anchorIS.  Must have a local communicator (PETSC_COMM_SELF or derivative).
8331 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
8332 
8333   The reference counts of anchorSection and anchorIS are incremented.
8334 
8335   Level: intermediate
8336 
8337 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
8338 @*/
8339 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
8340 {
8341   DM_Plex        *plex = (DM_Plex *)dm->data;
8342   PetscMPIInt    result;
8343   PetscErrorCode ierr;
8344 
8345   PetscFunctionBegin;
8346   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8347   if (anchorSection) {
8348     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
8349     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRMPI(ierr);
8350     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
8351   }
8352   if (anchorIS) {
8353     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
8354     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRMPI(ierr);
8355     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
8356   }
8357 
8358   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
8359   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
8360   plex->anchorSection = anchorSection;
8361 
8362   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
8363   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
8364   plex->anchorIS = anchorIS;
8365 
8366   if (PetscUnlikelyDebug(anchorIS && anchorSection)) {
8367     PetscInt size, a, pStart, pEnd;
8368     const PetscInt *anchors;
8369 
8370     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8371     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
8372     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
8373     for (a = 0; a < size; a++) {
8374       PetscInt p;
8375 
8376       p = anchors[a];
8377       if (p >= pStart && p < pEnd) {
8378         PetscInt dof;
8379 
8380         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8381         if (dof) {
8382           PetscErrorCode ierr2;
8383 
8384           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
8385           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
8386         }
8387       }
8388     }
8389     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
8390   }
8391   /* reset the generic constraints */
8392   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
8393   PetscFunctionReturn(0);
8394 }
8395 
8396 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
8397 {
8398   PetscSection anchorSection;
8399   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
8400   PetscErrorCode ierr;
8401 
8402   PetscFunctionBegin;
8403   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8404   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8405   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
8406   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8407   if (numFields) {
8408     PetscInt f;
8409     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
8410 
8411     for (f = 0; f < numFields; f++) {
8412       PetscInt numComp;
8413 
8414       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
8415       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
8416     }
8417   }
8418   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8419   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
8420   pStart = PetscMax(pStart,sStart);
8421   pEnd   = PetscMin(pEnd,sEnd);
8422   pEnd   = PetscMax(pStart,pEnd);
8423   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
8424   for (p = pStart; p < pEnd; p++) {
8425     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8426     if (dof) {
8427       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
8428       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
8429       for (f = 0; f < numFields; f++) {
8430         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
8431         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
8432       }
8433     }
8434   }
8435   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
8436   PetscFunctionReturn(0);
8437 }
8438 
8439 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
8440 {
8441   PetscSection   aSec;
8442   PetscInt       pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
8443   const PetscInt *anchors;
8444   PetscInt       numFields, f;
8445   IS             aIS;
8446   PetscErrorCode ierr;
8447   MatType        mtype;
8448   PetscBool      iscuda,iskokkos;
8449 
8450   PetscFunctionBegin;
8451   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8452   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
8453   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
8454   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
8455   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
8456   ierr = PetscStrcmp(dm->mattype,MATSEQAIJCUSPARSE,&iscuda);CHKERRQ(ierr);
8457   if (!iscuda) { ierr = PetscStrcmp(dm->mattype,MATMPIAIJCUSPARSE,&iscuda);CHKERRQ(ierr); }
8458   ierr = PetscStrcmp(dm->mattype,MATSEQAIJKOKKOS,&iskokkos);CHKERRQ(ierr);
8459   if (!iskokkos) { ierr = PetscStrcmp(dm->mattype,MATMPIAIJKOKKOS,&iskokkos);CHKERRQ(ierr); }
8460   if (iscuda) mtype = MATSEQAIJCUSPARSE;
8461   else if (iskokkos) mtype = MATSEQAIJKOKKOS;
8462   else mtype = MATSEQAIJ;
8463   ierr = MatSetType(*cMat,mtype);CHKERRQ(ierr);
8464   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
8465   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
8466   /* cSec will be a subset of aSec and section */
8467   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
8468   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
8469   i[0] = 0;
8470   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8471   for (p = pStart; p < pEnd; p++) {
8472     PetscInt rDof, rOff, r;
8473 
8474     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8475     if (!rDof) continue;
8476     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8477     if (numFields) {
8478       for (f = 0; f < numFields; f++) {
8479         annz = 0;
8480         for (r = 0; r < rDof; r++) {
8481           a = anchors[rOff + r];
8482           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8483           annz += aDof;
8484         }
8485         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8486         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
8487         for (q = 0; q < dof; q++) {
8488           i[off + q + 1] = i[off + q] + annz;
8489         }
8490       }
8491     }
8492     else {
8493       annz = 0;
8494       for (q = 0; q < dof; q++) {
8495         a = anchors[off + q];
8496         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8497         annz += aDof;
8498       }
8499       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8500       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
8501       for (q = 0; q < dof; q++) {
8502         i[off + q + 1] = i[off + q] + annz;
8503       }
8504     }
8505   }
8506   nnz = i[m];
8507   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
8508   offset = 0;
8509   for (p = pStart; p < pEnd; p++) {
8510     if (numFields) {
8511       for (f = 0; f < numFields; f++) {
8512         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8513         for (q = 0; q < dof; q++) {
8514           PetscInt rDof, rOff, r;
8515           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8516           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8517           for (r = 0; r < rDof; r++) {
8518             PetscInt s;
8519 
8520             a = anchors[rOff + r];
8521             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8522             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
8523             for (s = 0; s < aDof; s++) {
8524               j[offset++] = aOff + s;
8525             }
8526           }
8527         }
8528       }
8529     }
8530     else {
8531       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8532       for (q = 0; q < dof; q++) {
8533         PetscInt rDof, rOff, r;
8534         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8535         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8536         for (r = 0; r < rDof; r++) {
8537           PetscInt s;
8538 
8539           a = anchors[rOff + r];
8540           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8541           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
8542           for (s = 0; s < aDof; s++) {
8543             j[offset++] = aOff + s;
8544           }
8545         }
8546       }
8547     }
8548   }
8549   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
8550   ierr = PetscFree(i);CHKERRQ(ierr);
8551   ierr = PetscFree(j);CHKERRQ(ierr);
8552   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
8553   PetscFunctionReturn(0);
8554 }
8555 
8556 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
8557 {
8558   DM_Plex        *plex = (DM_Plex *)dm->data;
8559   PetscSection   anchorSection, section, cSec;
8560   Mat            cMat;
8561   PetscErrorCode ierr;
8562 
8563   PetscFunctionBegin;
8564   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8565   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8566   if (anchorSection) {
8567     PetscInt Nf;
8568 
8569     ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
8570     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
8571     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
8572     ierr = DMGetNumFields(dm,&Nf);CHKERRQ(ierr);
8573     if (Nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
8574     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
8575     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
8576     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
8577   }
8578   PetscFunctionReturn(0);
8579 }
8580 
8581 PetscErrorCode DMCreateSubDomainDM_Plex(DM dm, DMLabel label, PetscInt value, IS *is, DM *subdm)
8582 {
8583   IS             subis;
8584   PetscSection   section, subsection;
8585   PetscErrorCode ierr;
8586 
8587   PetscFunctionBegin;
8588   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
8589   if (!section) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting subdomain");
8590   if (!subdm)   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set output subDM for splitting subdomain");
8591   /* Create subdomain */
8592   ierr = DMPlexFilter(dm, label, value, subdm);CHKERRQ(ierr);
8593   /* Create submodel */
8594   ierr = DMPlexGetSubpointIS(*subdm, &subis);CHKERRQ(ierr);
8595   ierr = PetscSectionCreateSubmeshSection(section, subis, &subsection);CHKERRQ(ierr);
8596   ierr = DMSetLocalSection(*subdm, subsection);CHKERRQ(ierr);
8597   ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
8598   ierr = DMCopyDisc(dm, *subdm);CHKERRQ(ierr);
8599   /* Create map from submodel to global model */
8600   if (is) {
8601     PetscSection    sectionGlobal, subsectionGlobal;
8602     IS              spIS;
8603     const PetscInt *spmap;
8604     PetscInt       *subIndices;
8605     PetscInt        subSize = 0, subOff = 0, pStart, pEnd, p;
8606     PetscInt        Nf, f, bs = -1, bsLocal[2], bsMinMax[2];
8607 
8608     ierr = DMPlexGetSubpointIS(*subdm, &spIS);CHKERRQ(ierr);
8609     ierr = ISGetIndices(spIS, &spmap);CHKERRQ(ierr);
8610     ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
8611     ierr = DMGetGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
8612     ierr = DMGetGlobalSection(*subdm, &subsectionGlobal);CHKERRQ(ierr);
8613     ierr = PetscSectionGetChart(subsection, &pStart, &pEnd);CHKERRQ(ierr);
8614     for (p = pStart; p < pEnd; ++p) {
8615       PetscInt gdof, pSubSize  = 0;
8616 
8617       ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
8618       if (gdof > 0) {
8619         for (f = 0; f < Nf; ++f) {
8620           PetscInt fdof, fcdof;
8621 
8622           ierr     = PetscSectionGetFieldDof(subsection, p, f, &fdof);CHKERRQ(ierr);
8623           ierr     = PetscSectionGetFieldConstraintDof(subsection, p, f, &fcdof);CHKERRQ(ierr);
8624           pSubSize += fdof-fcdof;
8625         }
8626         subSize += pSubSize;
8627         if (pSubSize) {
8628           if (bs < 0) {
8629             bs = pSubSize;
8630           } else if (bs != pSubSize) {
8631             /* Layout does not admit a pointwise block size */
8632             bs = 1;
8633           }
8634         }
8635       }
8636     }
8637     /* Must have same blocksize on all procs (some might have no points) */
8638     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
8639     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
8640     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
8641     else                            {bs = bsMinMax[0];}
8642     ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
8643     for (p = pStart; p < pEnd; ++p) {
8644       PetscInt gdof, goff;
8645 
8646       ierr = PetscSectionGetDof(subsectionGlobal, p, &gdof);CHKERRQ(ierr);
8647       if (gdof > 0) {
8648         const PetscInt point = spmap[p];
8649 
8650         ierr = PetscSectionGetOffset(sectionGlobal, point, &goff);CHKERRQ(ierr);
8651         for (f = 0; f < Nf; ++f) {
8652           PetscInt fdof, fcdof, fc, f2, poff = 0;
8653 
8654           /* Can get rid of this loop by storing field information in the global section */
8655           for (f2 = 0; f2 < f; ++f2) {
8656             ierr  = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
8657             ierr  = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
8658             poff += fdof-fcdof;
8659           }
8660           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
8661           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
8662           for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
8663             subIndices[subOff] = goff+poff+fc;
8664           }
8665         }
8666       }
8667     }
8668     ierr = ISRestoreIndices(spIS, &spmap);CHKERRQ(ierr);
8669     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
8670     if (bs > 1) {
8671       /* We need to check that the block size does not come from non-contiguous fields */
8672       PetscInt i, j, set = 1;
8673       for (i = 0; i < subSize; i += bs) {
8674         for (j = 0; j < bs; ++j) {
8675           if (subIndices[i+j] != subIndices[i]+j) {set = 0; break;}
8676         }
8677       }
8678       if (set) {ierr = ISSetBlockSize(*is, bs);CHKERRQ(ierr);}
8679     }
8680     /* Attach nullspace */
8681     for (f = 0; f < Nf; ++f) {
8682       (*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[f];
8683       if ((*subdm)->nullspaceConstructors[f]) break;
8684     }
8685     if (f < Nf) {
8686       MatNullSpace nullSpace;
8687 
8688       ierr = (*(*subdm)->nullspaceConstructors[f])(*subdm, f, f, &nullSpace);CHKERRQ(ierr);
8689       ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
8690       ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
8691     }
8692   }
8693   PetscFunctionReturn(0);
8694 }
8695 
8696 /*@
8697   DMPlexMonitorThroughput - Report the cell throughput of FE integration
8698 
8699   Input Parameter:
8700 - dm - The DM
8701 
8702   Level: developer
8703 
8704   Options Database Keys:
8705 . -dm_plex_monitor_throughput - Activate the monitor
8706 
8707 .seealso: DMSetFromOptions(), DMPlexCreate()
8708 @*/
8709 PetscErrorCode DMPlexMonitorThroughput(DM dm, void *dummy)
8710 {
8711 #if defined(PETSC_USE_LOG)
8712   PetscStageLog      stageLog;
8713   PetscLogEvent      event;
8714   PetscLogStage      stage;
8715   PetscEventPerfInfo eventInfo;
8716   PetscReal          cellRate, flopRate;
8717   PetscInt           cStart, cEnd, Nf, N;
8718   const char        *name;
8719   PetscErrorCode     ierr;
8720 #endif
8721 
8722   PetscFunctionBegin;
8723   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8724 #if defined(PETSC_USE_LOG)
8725   ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
8726   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
8727   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
8728   ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
8729   ierr = PetscStageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
8730   ierr = PetscLogEventGetId("DMPlexResidualFE", &event);CHKERRQ(ierr);
8731   ierr = PetscLogEventGetPerfInfo(stage, event, &eventInfo);CHKERRQ(ierr);
8732   N        = (cEnd - cStart)*Nf*eventInfo.count;
8733   flopRate = eventInfo.flops/eventInfo.time;
8734   cellRate = N/eventInfo.time;
8735   ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "DM (%s) FE Residual Integration: %D integrals %D reps\n  Cell rate: %.2g/s flop rate: %.2g MF/s\n", name ? name : "unknown", N, eventInfo.count, (double) cellRate, (double) (flopRate/1.e6));CHKERRQ(ierr);
8736 #else
8737   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Plex Throughput Monitor is not supported if logging is turned off. Reconfigure using --with-log.");
8738 #endif
8739   PetscFunctionReturn(0);
8740 }
8741