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