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