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