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