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