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