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