xref: /petsc/src/dm/impls/plex/plex.c (revision 0a54594789a51e03afa4b1d2c7154c36053c8769)
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 - Gets the global dof indices associated with the closure of the given point within the provided sections.
6226 
6227   Not collective
6228 
6229   Input Parameters:
6230 + dm         - The DM
6231 . section    - The PetscSection describing the points (a local section)
6232 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6233 . point      - The point defining the closure
6234 - useClPerm  - Use the closure point permutation if available
6235 
6236   Output Parameters:
6237 + numIndices - The number of dof indices in the closure of point with the input sections
6238 . indices    - The dof indices
6239 . outOffsets - Array to write the field offsets into, or NULL
6240 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6241 
6242   Notes:
6243   Must call DMPlexRestoreClosureIndices() to free allocated memory
6244 
6245   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6246   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6247   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6248   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6249   indices (with the above semantics) are implied.
6250 
6251   Level: advanced
6252 
6253 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6254 @*/
6255 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6256                                        PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6257 {
6258   /* Closure ordering */
6259   PetscSection        clSection;
6260   IS                  clPoints;
6261   const PetscInt     *clp;
6262   PetscInt           *points;
6263   const PetscInt     *clperm = NULL;
6264   /* Dof permutation and sign flips */
6265   const PetscInt    **perms[32] = {NULL};
6266   const PetscScalar **flips[32] = {NULL};
6267   PetscScalar        *valCopy   = NULL;
6268   /* Hanging node constraints */
6269   PetscInt           *pointsC = NULL;
6270   PetscScalar        *valuesC = NULL;
6271   PetscInt            NclC, NiC;
6272 
6273   PetscInt           *idx;
6274   PetscInt            Nf, Ncl, Ni = 0, offsets[32], p, f;
6275   PetscBool           isLocal = (section == idxSection) ? PETSC_TRUE : PETSC_FALSE;
6276   PetscErrorCode      ierr;
6277 
6278   PetscFunctionBeginHot;
6279   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6280   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6281   PetscValidHeaderSpecific(idxSection, PETSC_SECTION_CLASSID, 3);
6282   if (numIndices) PetscValidPointer(numIndices, 6);
6283   if (indices)    PetscValidPointer(indices, 7);
6284   if (outOffsets) PetscValidPointer(outOffsets, 8);
6285   if (values)     PetscValidPointer(values, 9);
6286   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
6287   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
6288   ierr = PetscArrayzero(offsets, 32);CHKERRQ(ierr);
6289   /* 1) Get points in closure */
6290   ierr = DMPlexGetCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6291   if (useClPerm) {ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);}
6292   /* 2) Get number of indices on these points and field offsets from section */
6293   for (p = 0; p < Ncl*2; p += 2) {
6294     PetscInt dof, fdof;
6295 
6296     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6297     for (f = 0; f < Nf; ++f) {
6298       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6299       offsets[f+1] += fdof;
6300     }
6301     Ni += dof;
6302   }
6303   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
6304   if (Nf && offsets[Nf] != Ni) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Ni);
6305   /* 3) Get symmetries and sign flips. Apply sign flips to values if passed in (only works for square values matrix) */
6306   for (f = 0; f < PetscMax(1, Nf); ++f) {
6307     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6308     else    {ierr = PetscSectionGetPointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6309     /* may need to apply sign changes to the element matrix */
6310     if (values && flips[f]) {
6311       PetscInt foffset = offsets[f];
6312 
6313       for (p = 0; p < Ncl; ++p) {
6314         PetscInt           pnt  = points[2*p], fdof;
6315         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
6316 
6317         if (!Nf) {ierr = PetscSectionGetDof(section, pnt, &fdof);CHKERRQ(ierr);}
6318         else     {ierr = PetscSectionGetFieldDof(section, pnt, f, &fdof);CHKERRQ(ierr);}
6319         if (flip) {
6320           PetscInt i, j, k;
6321 
6322           if (!valCopy) {
6323             ierr = DMGetWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);
6324             for (j = 0; j < Ni * Ni; ++j) valCopy[j] = (*values)[j];
6325             *values = valCopy;
6326           }
6327           for (i = 0; i < fdof; ++i) {
6328             PetscScalar fval = flip[i];
6329 
6330             for (k = 0; k < Ni; ++k) {
6331               valCopy[Ni * (foffset + i) + k] *= fval;
6332               valCopy[Ni * k + (foffset + i)] *= fval;
6333             }
6334           }
6335         }
6336         foffset += fdof;
6337       }
6338     }
6339   }
6340   /* 4) Apply hanging node constraints. Get new symmetries and replace all storage with constrained storage */
6341   ierr = DMPlexAnchorsModifyMat(dm, section, Ncl, Ni, points, perms, values ? *values : NULL, &NclC, &NiC, &pointsC, values ? &valuesC : NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
6342   if (NclC) {
6343     if (valCopy) {ierr = DMRestoreWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);}
6344     for (f = 0; f < PetscMax(1, Nf); ++f) {
6345       if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6346       else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6347     }
6348     for (f = 0; f < PetscMax(1, Nf); ++f) {
6349       if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6350       else    {ierr = PetscSectionGetPointSyms(section, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6351     }
6352     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6353     Ncl     = NclC;
6354     Ni      = NiC;
6355     points  = pointsC;
6356     if (values) *values = valuesC;
6357   }
6358   /* 5) Calculate indices */
6359   ierr = DMGetWorkArray(dm, Ni, MPIU_INT, &idx);CHKERRQ(ierr);
6360   if (Nf) {
6361     PetscInt  idxOff;
6362     PetscBool useFieldOffsets;
6363 
6364     if (outOffsets) {for (f = 0; f <= Nf; f++) outOffsets[f] = offsets[f];}
6365     ierr = PetscSectionGetUseFieldOffsets(idxSection, &useFieldOffsets);CHKERRQ(ierr);
6366     if (useFieldOffsets) {
6367       for (p = 0; p < Ncl; ++p) {
6368         const PetscInt pnt = points[p*2];
6369 
6370         ierr = DMPlexGetIndicesPointFieldsSplit_Internal(section, idxSection, pnt, offsets, perms, p, clperm, idx);CHKERRQ(ierr);
6371       }
6372     } else {
6373       for (p = 0; p < Ncl; ++p) {
6374         const PetscInt pnt = points[p*2];
6375 
6376         ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6377         /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6378          * not (at the time of this writing) have fields set. They probably should, in which case we would pass the
6379          * global section. */
6380         ierr = DMPlexGetIndicesPointFields_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, offsets, PETSC_FALSE, perms, p, clperm, idx);CHKERRQ(ierr);
6381       }
6382     }
6383   } else {
6384     PetscInt off = 0, idxOff;
6385 
6386     for (p = 0; p < Ncl; ++p) {
6387       const PetscInt  pnt  = points[p*2];
6388       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
6389 
6390       ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6391       /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6392        * not (at the time of this writing) have fields set. They probably should, in which case we would pass the global section. */
6393       ierr = DMPlexGetIndicesPoint_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, &off, PETSC_FALSE, perm, clperm, idx);CHKERRQ(ierr);
6394     }
6395   }
6396   /* 6) Cleanup */
6397   for (f = 0; f < PetscMax(1, Nf); ++f) {
6398     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6399     else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6400   }
6401   if (NclC) {
6402     ierr = DMRestoreWorkArray(dm, NclC*2, MPIU_INT, &pointsC);CHKERRQ(ierr);
6403   } else {
6404     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6405   }
6406 
6407   if (numIndices) *numIndices = Ni;
6408   if (indices)    *indices    = idx;
6409   PetscFunctionReturn(0);
6410 }
6411 
6412 /*@C
6413   DMPlexRestoreClosureIndices - Restores the global dof indices associated with the closure of the given point within the provided sections.
6414 
6415   Not collective
6416 
6417   Input Parameters:
6418 + dm         - The DM
6419 . section    - The PetscSection describing the points (a local section)
6420 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6421 . point      - The point defining the closure
6422 - useClPerm  - Use the closure point permutation if available
6423 
6424   Output Parameters:
6425 + numIndices - The number of dof indices in the closure of point with the input sections
6426 . indices    - The dof indices
6427 . outOffsets - Array to write the field offsets into, or NULL
6428 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6429 
6430   Notes:
6431   If values were modified, the user is responsible for calling DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values).
6432 
6433   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6434   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6435   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6436   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6437   indices (with the above semantics) are implied.
6438 
6439   Level: advanced
6440 
6441 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6442 @*/
6443 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6444                                            PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6445 {
6446   PetscErrorCode ierr;
6447 
6448   PetscFunctionBegin;
6449   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6450   PetscValidPointer(indices, 5);
6451   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
6452   PetscFunctionReturn(0);
6453 }
6454 
6455 /*@C
6456   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
6457 
6458   Not collective
6459 
6460   Input Parameters:
6461 + dm - The DM
6462 . section - The section describing the layout in v, or NULL to use the default section
6463 . globalSection - The section describing the layout in v, or NULL to use the default global section
6464 . A - The matrix
6465 . point - The point in the DM
6466 . values - The array of values
6467 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6468 
6469   Fortran Notes:
6470   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
6471 
6472   Level: intermediate
6473 
6474 .seealso DMPlexMatSetClosureGeneral(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6475 @*/
6476 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6477 {
6478   DM_Plex           *mesh = (DM_Plex*) dm->data;
6479   PetscInt          *indices;
6480   PetscInt           numIndices;
6481   const PetscScalar *valuesOrig = values;
6482   PetscErrorCode     ierr;
6483 
6484   PetscFunctionBegin;
6485   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6486   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
6487   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6488   if (!globalSection) {ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
6489   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
6490   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
6491 
6492   ierr = DMPlexGetClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6493 
6494   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
6495   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
6496   if (ierr) {
6497     PetscMPIInt    rank;
6498     PetscErrorCode ierr2;
6499 
6500     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6501     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6502     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
6503     ierr2 = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6504     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6505     CHKERRQ(ierr);
6506   }
6507   if (mesh->printFEM > 1) {
6508     PetscInt i;
6509     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
6510     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
6511     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6512   }
6513 
6514   ierr = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6515   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6516   PetscFunctionReturn(0);
6517 }
6518 
6519 /*@C
6520   DMPlexMatSetClosure - Set an array of the values on the closure of 'point' using a different row and column section
6521 
6522   Not collective
6523 
6524   Input Parameters:
6525 + dmRow - The DM for the row fields
6526 . sectionRow - The section describing the layout, or NULL to use the default section in dmRow
6527 . globalSectionRow - The section describing the layout, or NULL to use the default global section in dmRow
6528 . dmCol - The DM for the column fields
6529 . sectionCol - The section describing the layout, or NULL to use the default section in dmCol
6530 . globalSectionCol - The section describing the layout, or NULL to use the default global section in dmCol
6531 . A - The matrix
6532 . point - The point in the DMs
6533 . values - The array of values
6534 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6535 
6536   Level: intermediate
6537 
6538 .seealso DMPlexMatSetClosure(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6539 @*/
6540 PetscErrorCode DMPlexMatSetClosureGeneral(DM dmRow, PetscSection sectionRow, PetscSection globalSectionRow, DM dmCol, PetscSection sectionCol, PetscSection globalSectionCol, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6541 {
6542   DM_Plex           *mesh = (DM_Plex*) dmRow->data;
6543   PetscInt          *indicesRow, *indicesCol;
6544   PetscInt           numIndicesRow, numIndicesCol;
6545   const PetscScalar *valuesOrig = values;
6546   PetscErrorCode     ierr;
6547 
6548   PetscFunctionBegin;
6549   PetscValidHeaderSpecific(dmRow, DM_CLASSID, 1);
6550   if (!sectionRow) {ierr = DMGetLocalSection(dmRow, &sectionRow);CHKERRQ(ierr);}
6551   PetscValidHeaderSpecific(sectionRow, PETSC_SECTION_CLASSID, 2);
6552   if (!globalSectionRow) {ierr = DMGetGlobalSection(dmRow, &globalSectionRow);CHKERRQ(ierr);}
6553   PetscValidHeaderSpecific(globalSectionRow, PETSC_SECTION_CLASSID, 3);
6554   PetscValidHeaderSpecific(dmCol, DM_CLASSID, 4);
6555   if (!sectionCol) {ierr = DMGetLocalSection(dmCol, &sectionCol);CHKERRQ(ierr);}
6556   PetscValidHeaderSpecific(sectionCol, PETSC_SECTION_CLASSID, 5);
6557   if (!globalSectionCol) {ierr = DMGetGlobalSection(dmCol, &globalSectionCol);CHKERRQ(ierr);}
6558   PetscValidHeaderSpecific(globalSectionCol, PETSC_SECTION_CLASSID, 6);
6559   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6560 
6561   ierr = DMPlexGetClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6562   ierr = DMPlexGetClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6563 
6564   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr);}
6565   ierr = MatSetValues(A, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values, mode);
6566   if (ierr) {
6567     PetscMPIInt    rank;
6568     PetscErrorCode ierr2;
6569 
6570     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6571     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6572     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr2);
6573     ierr2 = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6574     ierr2 = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6575     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6576     CHKERRQ(ierr);
6577   }
6578 
6579   ierr = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6580   ierr = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6581   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6582   PetscFunctionReturn(0);
6583 }
6584 
6585 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6586 {
6587   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
6588   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
6589   PetscInt       *cpoints = NULL;
6590   PetscInt       *findices, *cindices;
6591   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6592   PetscInt        foffsets[32], coffsets[32];
6593   DMPolytopeType  ct;
6594   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6595   PetscErrorCode  ierr;
6596 
6597   PetscFunctionBegin;
6598   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6599   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6600   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6601   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6602   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6603   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6604   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6605   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6606   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6607   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6608   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6609   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6610   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6611   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6612   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6613   /* Column indices */
6614   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6615   maxFPoints = numCPoints;
6616   /* Compress out points not in the section */
6617   /*   TODO: Squeeze out points with 0 dof as well */
6618   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6619   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6620     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6621       cpoints[q*2]   = cpoints[p];
6622       cpoints[q*2+1] = cpoints[p+1];
6623       ++q;
6624     }
6625   }
6626   numCPoints = q;
6627   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6628     PetscInt fdof;
6629 
6630     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6631     if (!dof) continue;
6632     for (f = 0; f < numFields; ++f) {
6633       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6634       coffsets[f+1] += fdof;
6635     }
6636     numCIndices += dof;
6637   }
6638   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6639   /* Row indices */
6640   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6641   {
6642     DMPlexCellRefiner cr;
6643     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6644     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6645     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6646   }
6647   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6648   for (r = 0, q = 0; r < numSubcells; ++r) {
6649     /* TODO Map from coarse to fine cells */
6650     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6651     /* Compress out points not in the section */
6652     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6653     for (p = 0; p < numFPoints*2; p += 2) {
6654       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6655         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6656         if (!dof) continue;
6657         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6658         if (s < q) continue;
6659         ftotpoints[q*2]   = fpoints[p];
6660         ftotpoints[q*2+1] = fpoints[p+1];
6661         ++q;
6662       }
6663     }
6664     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6665   }
6666   numFPoints = q;
6667   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6668     PetscInt fdof;
6669 
6670     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6671     if (!dof) continue;
6672     for (f = 0; f < numFields; ++f) {
6673       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6674       foffsets[f+1] += fdof;
6675     }
6676     numFIndices += dof;
6677   }
6678   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6679 
6680   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6681   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6682   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6683   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6684   if (numFields) {
6685     const PetscInt **permsF[32] = {NULL};
6686     const PetscInt **permsC[32] = {NULL};
6687 
6688     for (f = 0; f < numFields; f++) {
6689       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6690       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6691     }
6692     for (p = 0; p < numFPoints; p++) {
6693       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6694       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6695     }
6696     for (p = 0; p < numCPoints; p++) {
6697       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6698       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6699     }
6700     for (f = 0; f < numFields; f++) {
6701       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6702       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6703     }
6704   } else {
6705     const PetscInt **permsF = NULL;
6706     const PetscInt **permsC = NULL;
6707 
6708     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6709     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6710     for (p = 0, off = 0; p < numFPoints; p++) {
6711       const PetscInt *perm = permsF ? permsF[p] : NULL;
6712 
6713       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6714       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6715     }
6716     for (p = 0, off = 0; p < numCPoints; p++) {
6717       const PetscInt *perm = permsC ? permsC[p] : NULL;
6718 
6719       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6720       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6721     }
6722     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6723     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6724   }
6725   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6726   /* TODO: flips */
6727   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6728   if (ierr) {
6729     PetscMPIInt    rank;
6730     PetscErrorCode ierr2;
6731 
6732     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6733     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6734     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6735     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
6736     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
6737     CHKERRQ(ierr);
6738   }
6739   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6740   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6741   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6742   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6743   PetscFunctionReturn(0);
6744 }
6745 
6746 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
6747 {
6748   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
6749   PetscInt      *cpoints = NULL;
6750   PetscInt       foffsets[32], coffsets[32];
6751   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6752   DMPolytopeType ct;
6753   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6754   PetscErrorCode ierr;
6755 
6756   PetscFunctionBegin;
6757   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6758   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6759   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6760   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6761   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6762   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6763   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6764   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6765   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6766   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6767   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6768   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6769   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6770   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6771   /* Column indices */
6772   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6773   maxFPoints = numCPoints;
6774   /* Compress out points not in the section */
6775   /*   TODO: Squeeze out points with 0 dof as well */
6776   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6777   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6778     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6779       cpoints[q*2]   = cpoints[p];
6780       cpoints[q*2+1] = cpoints[p+1];
6781       ++q;
6782     }
6783   }
6784   numCPoints = q;
6785   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6786     PetscInt fdof;
6787 
6788     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6789     if (!dof) continue;
6790     for (f = 0; f < numFields; ++f) {
6791       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6792       coffsets[f+1] += fdof;
6793     }
6794     numCIndices += dof;
6795   }
6796   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6797   /* Row indices */
6798   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6799   {
6800     DMPlexCellRefiner cr;
6801     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6802     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6803     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6804   }
6805   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6806   for (r = 0, q = 0; r < numSubcells; ++r) {
6807     /* TODO Map from coarse to fine cells */
6808     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6809     /* Compress out points not in the section */
6810     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6811     for (p = 0; p < numFPoints*2; p += 2) {
6812       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6813         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6814         if (!dof) continue;
6815         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6816         if (s < q) continue;
6817         ftotpoints[q*2]   = fpoints[p];
6818         ftotpoints[q*2+1] = fpoints[p+1];
6819         ++q;
6820       }
6821     }
6822     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6823   }
6824   numFPoints = q;
6825   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6826     PetscInt fdof;
6827 
6828     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6829     if (!dof) continue;
6830     for (f = 0; f < numFields; ++f) {
6831       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6832       foffsets[f+1] += fdof;
6833     }
6834     numFIndices += dof;
6835   }
6836   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6837 
6838   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6839   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6840   if (numFields) {
6841     const PetscInt **permsF[32] = {NULL};
6842     const PetscInt **permsC[32] = {NULL};
6843 
6844     for (f = 0; f < numFields; f++) {
6845       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6846       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6847     }
6848     for (p = 0; p < numFPoints; p++) {
6849       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6850       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6851     }
6852     for (p = 0; p < numCPoints; p++) {
6853       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6854       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6855     }
6856     for (f = 0; f < numFields; f++) {
6857       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6858       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6859     }
6860   } else {
6861     const PetscInt **permsF = NULL;
6862     const PetscInt **permsC = NULL;
6863 
6864     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6865     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6866     for (p = 0, off = 0; p < numFPoints; p++) {
6867       const PetscInt *perm = permsF ? permsF[p] : NULL;
6868 
6869       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6870       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6871     }
6872     for (p = 0, off = 0; p < numCPoints; p++) {
6873       const PetscInt *perm = permsC ? permsC[p] : NULL;
6874 
6875       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6876       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6877     }
6878     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6879     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6880   }
6881   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6882   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6883   PetscFunctionReturn(0);
6884 }
6885 
6886 /*@C
6887   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6888 
6889   Input Parameter:
6890 . dm   - The DMPlex object
6891 
6892   Output Parameter:
6893 . cellHeight - The height of a cell
6894 
6895   Level: developer
6896 
6897 .seealso DMPlexSetVTKCellHeight()
6898 @*/
6899 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6900 {
6901   DM_Plex *mesh = (DM_Plex*) dm->data;
6902 
6903   PetscFunctionBegin;
6904   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6905   PetscValidPointer(cellHeight, 2);
6906   *cellHeight = mesh->vtkCellHeight;
6907   PetscFunctionReturn(0);
6908 }
6909 
6910 /*@C
6911   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
6912 
6913   Input Parameters:
6914 + dm   - The DMPlex object
6915 - cellHeight - The height of a cell
6916 
6917   Level: developer
6918 
6919 .seealso DMPlexGetVTKCellHeight()
6920 @*/
6921 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6922 {
6923   DM_Plex *mesh = (DM_Plex*) dm->data;
6924 
6925   PetscFunctionBegin;
6926   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6927   mesh->vtkCellHeight = cellHeight;
6928   PetscFunctionReturn(0);
6929 }
6930 
6931 /*@
6932   DMPlexGetGhostCellStratum - Get the range of cells which are used to enforce FV boundary conditions
6933 
6934   Input Parameter:
6935 . dm - The DMPlex object
6936 
6937   Output Parameters:
6938 + gcStart - The first ghost cell, or NULL
6939 - gcEnd   - The upper bound on ghost cells, or NULL
6940 
6941   Level: advanced
6942 
6943 .seealso DMPlexConstructGhostCells(), DMPlexSetGhostCellStratum()
6944 @*/
6945 PetscErrorCode DMPlexGetGhostCellStratum(DM dm, PetscInt *gcStart, PetscInt *gcEnd)
6946 {
6947   DMLabel        ctLabel;
6948   PetscErrorCode ierr;
6949 
6950   PetscFunctionBegin;
6951   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6952   ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
6953   ierr = DMLabelGetStratumBounds(ctLabel, DM_POLYTOPE_FV_GHOST, gcStart, gcEnd);CHKERRQ(ierr);
6954   PetscFunctionReturn(0);
6955 }
6956 
6957 /* We can easily have a form that takes an IS instead */
6958 PetscErrorCode DMPlexCreateNumbering_Plex(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
6959 {
6960   PetscSection   section, globalSection;
6961   PetscInt      *numbers, p;
6962   PetscErrorCode ierr;
6963 
6964   PetscFunctionBegin;
6965   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6966   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6967   for (p = pStart; p < pEnd; ++p) {
6968     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6969   }
6970   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6971   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6972   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
6973   for (p = pStart; p < pEnd; ++p) {
6974     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6975     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
6976     else                       numbers[p-pStart] += shift;
6977   }
6978   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6979   if (globalSize) {
6980     PetscLayout layout;
6981     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
6982     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
6983     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
6984   }
6985   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6986   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6987   PetscFunctionReturn(0);
6988 }
6989 
6990 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
6991 {
6992   PetscInt       cellHeight, cStart, cEnd;
6993   PetscErrorCode ierr;
6994 
6995   PetscFunctionBegin;
6996   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6997   if (includeHybrid) {ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
6998   else               {ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
6999   ierr = DMPlexCreateNumbering_Plex(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
7000   PetscFunctionReturn(0);
7001 }
7002 
7003 /*@
7004   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
7005 
7006   Input Parameter:
7007 . dm   - The DMPlex object
7008 
7009   Output Parameter:
7010 . globalCellNumbers - Global cell numbers for all cells on this process
7011 
7012   Level: developer
7013 
7014 .seealso DMPlexGetVertexNumbering()
7015 @*/
7016 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7017 {
7018   DM_Plex       *mesh = (DM_Plex*) dm->data;
7019   PetscErrorCode ierr;
7020 
7021   PetscFunctionBegin;
7022   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7023   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
7024   *globalCellNumbers = mesh->globalCellNumbers;
7025   PetscFunctionReturn(0);
7026 }
7027 
7028 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
7029 {
7030   PetscInt       vStart, vEnd;
7031   PetscErrorCode ierr;
7032 
7033   PetscFunctionBegin;
7034   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7035   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7036   ierr = DMPlexCreateNumbering_Plex(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
7037   PetscFunctionReturn(0);
7038 }
7039 
7040 /*@
7041   DMPlexGetVertexNumbering - Get a global vertex numbering for all vertices on this process
7042 
7043   Input Parameter:
7044 . dm   - The DMPlex object
7045 
7046   Output Parameter:
7047 . globalVertexNumbers - Global vertex numbers for all vertices on this process
7048 
7049   Level: developer
7050 
7051 .seealso DMPlexGetCellNumbering()
7052 @*/
7053 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7054 {
7055   DM_Plex       *mesh = (DM_Plex*) dm->data;
7056   PetscErrorCode ierr;
7057 
7058   PetscFunctionBegin;
7059   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7060   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
7061   *globalVertexNumbers = mesh->globalVertexNumbers;
7062   PetscFunctionReturn(0);
7063 }
7064 
7065 /*@
7066   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
7067 
7068   Input Parameter:
7069 . dm   - The DMPlex object
7070 
7071   Output Parameter:
7072 . globalPointNumbers - Global numbers for all points on this process
7073 
7074   Level: developer
7075 
7076 .seealso DMPlexGetCellNumbering()
7077 @*/
7078 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
7079 {
7080   IS             nums[4];
7081   PetscInt       depths[4], gdepths[4], starts[4];
7082   PetscInt       depth, d, shift = 0;
7083   PetscErrorCode ierr;
7084 
7085   PetscFunctionBegin;
7086   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7087   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7088   /* For unstratified meshes use dim instead of depth */
7089   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
7090   for (d = 0; d <= depth; ++d) {
7091     PetscInt end;
7092 
7093     depths[d] = depth-d;
7094     ierr = DMPlexGetDepthStratum(dm, depths[d], &starts[d], &end);CHKERRQ(ierr);
7095     if (!(starts[d]-end)) { starts[d] = depths[d] = -1; }
7096   }
7097   ierr = PetscSortIntWithArray(depth+1, starts, depths);CHKERRQ(ierr);
7098   ierr = MPIU_Allreduce(depths, gdepths, depth+1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
7099   for (d = 0; d <= depth; ++d) {
7100     if (starts[d] >= 0 && depths[d] != gdepths[d]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected depth %D, found %D",depths[d],gdepths[d]);
7101   }
7102   for (d = 0; d <= depth; ++d) {
7103     PetscInt pStart, pEnd, gsize;
7104 
7105     ierr = DMPlexGetDepthStratum(dm, gdepths[d], &pStart, &pEnd);CHKERRQ(ierr);
7106     ierr = DMPlexCreateNumbering_Plex(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
7107     shift += gsize;
7108   }
7109   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
7110   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
7111   PetscFunctionReturn(0);
7112 }
7113 
7114 
7115 /*@
7116   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
7117 
7118   Input Parameter:
7119 . dm - The DMPlex object
7120 
7121   Output Parameter:
7122 . ranks - The rank field
7123 
7124   Options Database Keys:
7125 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
7126 
7127   Level: intermediate
7128 
7129 .seealso: DMView()
7130 @*/
7131 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
7132 {
7133   DM             rdm;
7134   PetscFE        fe;
7135   PetscScalar   *r;
7136   PetscMPIInt    rank;
7137   PetscInt       dim, cStart, cEnd, c;
7138   PetscErrorCode ierr;
7139 
7140   PetscFunctionBeginUser;
7141   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7142   PetscValidPointer(ranks, 2);
7143   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
7144   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7145   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7146   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___rank_", -1, &fe);CHKERRQ(ierr);
7147   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
7148   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7149   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7150   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7151   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7152   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
7153   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
7154   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
7155   for (c = cStart; c < cEnd; ++c) {
7156     PetscScalar *lr;
7157 
7158     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
7159     if (lr) *lr = rank;
7160   }
7161   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
7162   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7163   PetscFunctionReturn(0);
7164 }
7165 
7166 /*@
7167   DMPlexCreateLabelField - Create a cell field whose value is the label value for that cell
7168 
7169   Input Parameters:
7170 + dm    - The DMPlex
7171 - label - The DMLabel
7172 
7173   Output Parameter:
7174 . val - The label value field
7175 
7176   Options Database Keys:
7177 . -dm_label_view - Adds the label value field into the DM output from -dm_view using the same viewer
7178 
7179   Level: intermediate
7180 
7181 .seealso: DMView()
7182 @*/
7183 PetscErrorCode DMPlexCreateLabelField(DM dm, DMLabel label, Vec *val)
7184 {
7185   DM             rdm;
7186   PetscFE        fe;
7187   PetscScalar   *v;
7188   PetscInt       dim, cStart, cEnd, c;
7189   PetscErrorCode ierr;
7190 
7191   PetscFunctionBeginUser;
7192   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7193   PetscValidPointer(label, 2);
7194   PetscValidPointer(val, 3);
7195   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7196   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7197   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___label_value_", -1, &fe);CHKERRQ(ierr);
7198   ierr = PetscObjectSetName((PetscObject) fe, "label_value");CHKERRQ(ierr);
7199   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7200   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7201   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7202   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7203   ierr = DMCreateGlobalVector(rdm, val);CHKERRQ(ierr);
7204   ierr = PetscObjectSetName((PetscObject) *val, "label_value");CHKERRQ(ierr);
7205   ierr = VecGetArray(*val, &v);CHKERRQ(ierr);
7206   for (c = cStart; c < cEnd; ++c) {
7207     PetscScalar *lv;
7208     PetscInt     cval;
7209 
7210     ierr = DMPlexPointGlobalRef(rdm, c, v, &lv);CHKERRQ(ierr);
7211     ierr = DMLabelGetValue(label, c, &cval);CHKERRQ(ierr);
7212     *lv = cval;
7213   }
7214   ierr = VecRestoreArray(*val, &v);CHKERRQ(ierr);
7215   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7216   PetscFunctionReturn(0);
7217 }
7218 
7219 /*@
7220   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
7221 
7222   Input Parameter:
7223 . dm - The DMPlex object
7224 
7225   Notes:
7226   This is a useful diagnostic when creating meshes programmatically.
7227 
7228   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7229 
7230   Level: developer
7231 
7232 .seealso: DMCreate(), DMSetFromOptions()
7233 @*/
7234 PetscErrorCode DMPlexCheckSymmetry(DM dm)
7235 {
7236   PetscSection    coneSection, supportSection;
7237   const PetscInt *cone, *support;
7238   PetscInt        coneSize, c, supportSize, s;
7239   PetscInt        pStart, pEnd, p, pp, csize, ssize;
7240   PetscBool       storagecheck = PETSC_TRUE;
7241   PetscErrorCode  ierr;
7242 
7243   PetscFunctionBegin;
7244   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7245   ierr = DMViewFromOptions(dm, NULL, "-sym_dm_view");CHKERRQ(ierr);
7246   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
7247   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
7248   /* Check that point p is found in the support of its cone points, and vice versa */
7249   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
7250   for (p = pStart; p < pEnd; ++p) {
7251     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
7252     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
7253     for (c = 0; c < coneSize; ++c) {
7254       PetscBool dup = PETSC_FALSE;
7255       PetscInt  d;
7256       for (d = c-1; d >= 0; --d) {
7257         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
7258       }
7259       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
7260       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
7261       for (s = 0; s < supportSize; ++s) {
7262         if (support[s] == p) break;
7263       }
7264       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
7265         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
7266         for (s = 0; s < coneSize; ++s) {
7267           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
7268         }
7269         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7270         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
7271         for (s = 0; s < supportSize; ++s) {
7272           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
7273         }
7274         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7275         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
7276         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
7277       }
7278     }
7279     ierr = DMPlexGetTreeParent(dm, p, &pp, NULL);CHKERRQ(ierr);
7280     if (p != pp) { storagecheck = PETSC_FALSE; continue; }
7281     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
7282     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
7283     for (s = 0; s < supportSize; ++s) {
7284       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
7285       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
7286       for (c = 0; c < coneSize; ++c) {
7287         ierr = DMPlexGetTreeParent(dm, cone[c], &pp, NULL);CHKERRQ(ierr);
7288         if (cone[c] != pp) { c = 0; break; }
7289         if (cone[c] == p) break;
7290       }
7291       if (c >= coneSize) {
7292         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
7293         for (c = 0; c < supportSize; ++c) {
7294           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
7295         }
7296         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7297         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
7298         for (c = 0; c < coneSize; ++c) {
7299           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
7300         }
7301         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7302         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
7303       }
7304     }
7305   }
7306   if (storagecheck) {
7307     ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
7308     ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
7309     if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
7310   }
7311   PetscFunctionReturn(0);
7312 }
7313 
7314 /*
7315   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.
7316 */
7317 static PetscErrorCode DMPlexCellUnsplitVertices_Private(DM dm, PetscInt c, DMPolytopeType ct, PetscInt *unsplit)
7318 {
7319   DMPolytopeType  cct;
7320   PetscInt        ptpoints[4];
7321   const PetscInt *cone, *ccone, *ptcone;
7322   PetscInt        coneSize, cp, cconeSize, ccp, npt = 0, pt;
7323   PetscErrorCode  ierr;
7324 
7325   PetscFunctionBegin;
7326   *unsplit = 0;
7327   switch (ct) {
7328     case DM_POLYTOPE_SEG_PRISM_TENSOR:
7329       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7330       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7331       for (cp = 0; cp < coneSize; ++cp) {
7332         ierr = DMPlexGetCellType(dm, cone[cp], &cct);CHKERRQ(ierr);
7333         if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) ptpoints[npt++] = cone[cp];
7334       }
7335       break;
7336     case DM_POLYTOPE_TRI_PRISM_TENSOR:
7337     case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7338       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7339       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7340       for (cp = 0; cp < coneSize; ++cp) {
7341         ierr = DMPlexGetCone(dm, cone[cp], &ccone);CHKERRQ(ierr);
7342         ierr = DMPlexGetConeSize(dm, cone[cp], &cconeSize);CHKERRQ(ierr);
7343         for (ccp = 0; ccp < cconeSize; ++ccp) {
7344           ierr = DMPlexGetCellType(dm, ccone[ccp], &cct);CHKERRQ(ierr);
7345           if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) {
7346             PetscInt p;
7347             for (p = 0; p < npt; ++p) if (ptpoints[p] == ccone[ccp]) break;
7348             if (p == npt) ptpoints[npt++] = ccone[ccp];
7349           }
7350         }
7351       }
7352       break;
7353     default: break;
7354   }
7355   for (pt = 0; pt < npt; ++pt) {
7356     ierr = DMPlexGetCone(dm, ptpoints[pt], &ptcone);CHKERRQ(ierr);
7357     if (ptcone[0] == ptcone[1]) ++(*unsplit);
7358   }
7359   PetscFunctionReturn(0);
7360 }
7361 
7362 /*@
7363   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
7364 
7365   Input Parameters:
7366 + dm - The DMPlex object
7367 - cellHeight - Normally 0
7368 
7369   Notes:
7370   This is a useful diagnostic when creating meshes programmatically.
7371   Currently applicable only to homogeneous simplex or tensor meshes.
7372 
7373   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7374 
7375   Level: developer
7376 
7377 .seealso: DMCreate(), DMSetFromOptions()
7378 @*/
7379 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscInt cellHeight)
7380 {
7381   DMPlexInterpolatedFlag interp;
7382   DMPolytopeType         ct;
7383   PetscInt               vStart, vEnd, cStart, cEnd, c;
7384   PetscErrorCode         ierr;
7385 
7386   PetscFunctionBegin;
7387   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7388   ierr = DMPlexIsInterpolated(dm, &interp);CHKERRQ(ierr);
7389   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7390   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7391   for (c = cStart; c < cEnd; ++c) {
7392     PetscInt *closure = NULL;
7393     PetscInt  coneSize, closureSize, cl, Nv = 0;
7394 
7395     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7396     if ((PetscInt) ct < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has no cell type", c);
7397     if (ct == DM_POLYTOPE_UNKNOWN) continue;
7398     if (interp == DMPLEX_INTERPOLATED_FULL) {
7399       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7400       if (coneSize != DMPolytopeTypeGetConeSize(ct)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has cone size %D != %D", c, coneSize, DMPolytopeTypeGetConeSize(ct));
7401     }
7402     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7403     for (cl = 0; cl < closureSize*2; cl += 2) {
7404       const PetscInt p = closure[cl];
7405       if ((p >= vStart) && (p < vEnd)) ++Nv;
7406     }
7407     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7408     /* Special Case: Tensor faces with identified vertices */
7409     if (Nv < DMPolytopeTypeGetNumVertices(ct)) {
7410       PetscInt unsplit;
7411 
7412       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7413       if (Nv + unsplit == DMPolytopeTypeGetNumVertices(ct)) continue;
7414     }
7415     if (Nv != DMPolytopeTypeGetNumVertices(ct)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D vertices != %D", c, Nv, DMPolytopeTypeGetNumVertices(ct));
7416   }
7417   PetscFunctionReturn(0);
7418 }
7419 
7420 /*@
7421   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
7422 
7423   Not Collective
7424 
7425   Input Parameters:
7426 + dm - The DMPlex object
7427 - cellHeight - Normally 0
7428 
7429   Notes:
7430   This is a useful diagnostic when creating meshes programmatically.
7431   This routine is only relevant for meshes that are fully interpolated across all ranks.
7432   It will error out if a partially interpolated mesh is given on some rank.
7433   It will do nothing for locally uninterpolated mesh (as there is nothing to check).
7434 
7435   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7436 
7437   Level: developer
7438 
7439 .seealso: DMCreate(), DMPlexGetVTKCellHeight(), DMSetFromOptions()
7440 @*/
7441 PetscErrorCode DMPlexCheckFaces(DM dm, PetscInt cellHeight)
7442 {
7443   PetscInt       dim, depth, vStart, vEnd, cStart, cEnd, c, h;
7444   PetscErrorCode ierr;
7445   DMPlexInterpolatedFlag interpEnum;
7446 
7447   PetscFunctionBegin;
7448   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7449   ierr = DMPlexIsInterpolated(dm, &interpEnum);CHKERRQ(ierr);
7450   if (interpEnum == DMPLEX_INTERPOLATED_NONE) PetscFunctionReturn(0);
7451   if (interpEnum == DMPLEX_INTERPOLATED_PARTIAL) {
7452     PetscMPIInt	rank;
7453     MPI_Comm	comm;
7454 
7455     ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
7456     ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
7457     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Mesh is only partially interpolated on rank %d, this is currently not supported", rank);
7458   }
7459 
7460   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7461   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7462   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7463   for (h = cellHeight; h < PetscMin(depth, dim); ++h) {
7464     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
7465     for (c = cStart; c < cEnd; ++c) {
7466       const PetscInt      *cone, *ornt, *faceSizes, *faces;
7467       const DMPolytopeType *faceTypes;
7468       DMPolytopeType        ct;
7469       PetscInt              numFaces, coneSize, f;
7470       PetscInt             *closure = NULL, closureSize, cl, numCorners = 0, fOff = 0, unsplit;
7471 
7472       ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7473       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7474       if (unsplit) continue;
7475       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7476       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7477       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
7478       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7479       for (cl = 0; cl < closureSize*2; cl += 2) {
7480         const PetscInt p = closure[cl];
7481         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
7482       }
7483       ierr = DMPlexGetRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7484       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D faces but should have %D", c, coneSize, numFaces);
7485       for (f = 0; f < numFaces; ++f) {
7486         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
7487 
7488         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7489         for (cl = 0; cl < fclosureSize*2; cl += 2) {
7490           const PetscInt p = fclosure[cl];
7491           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
7492         }
7493         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]);
7494         for (v = 0; v < fnumCorners; ++v) {
7495           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]);
7496         }
7497         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7498         fOff += faceSizes[f];
7499       }
7500       ierr = DMPlexRestoreRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7501       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7502     }
7503   }
7504   PetscFunctionReturn(0);
7505 }
7506 
7507 /*@
7508   DMPlexCheckGeometry - Check the geometry of mesh cells
7509 
7510   Input Parameter:
7511 . dm - The DMPlex object
7512 
7513   Notes:
7514   This is a useful diagnostic when creating meshes programmatically.
7515 
7516   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7517 
7518   Level: developer
7519 
7520 .seealso: DMCreate(), DMSetFromOptions()
7521 @*/
7522 PetscErrorCode DMPlexCheckGeometry(DM dm)
7523 {
7524   PetscReal      detJ, J[9], refVol = 1.0;
7525   PetscReal      vol;
7526   PetscBool      periodic;
7527   PetscInt       dim, depth, d, cStart, cEnd, c;
7528   PetscErrorCode ierr;
7529 
7530   PetscFunctionBegin;
7531   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7532   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7533   ierr = DMGetPeriodicity(dm, &periodic, NULL, NULL, NULL);CHKERRQ(ierr);
7534   for (d = 0; d < dim; ++d) refVol *= 2.0;
7535   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7536   for (c = cStart; c < cEnd; ++c) {
7537     DMPolytopeType ct;
7538     PetscInt       unsplit;
7539     PetscBool      ignoreZeroVol = PETSC_FALSE;
7540 
7541     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7542     switch (ct) {
7543       case DM_POLYTOPE_SEG_PRISM_TENSOR:
7544       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7545       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7546         ignoreZeroVol = PETSC_TRUE; break;
7547       default: break;
7548     }
7549     switch (ct) {
7550       case DM_POLYTOPE_TRI_PRISM:
7551       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7552       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7553         continue;
7554       default: break;
7555     }
7556     ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7557     if (unsplit) continue;
7558     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, NULL, J, NULL, &detJ);CHKERRQ(ierr);
7559     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);
7560     ierr = PetscInfo2(dm, "Cell %D FEM Volume %g\n", c, (double) detJ*refVol);CHKERRQ(ierr);
7561     if (depth > 1 && !periodic) {
7562       ierr = DMPlexComputeCellGeometryFVM(dm, c, &vol, NULL, NULL);CHKERRQ(ierr);
7563       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);
7564       ierr = PetscInfo2(dm, "Cell %D FVM Volume %g\n", c, (double) vol);CHKERRQ(ierr);
7565     }
7566   }
7567   PetscFunctionReturn(0);
7568 }
7569 
7570 /*@
7571   DMPlexCheckPointSF - Check that several necessary conditions are met for the point SF of this plex.
7572 
7573   Input Parameters:
7574 . dm - The DMPlex object
7575 
7576   Notes:
7577   This is mainly intended for debugging/testing purposes.
7578   It currently checks only meshes with no partition overlapping.
7579 
7580   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7581 
7582   Level: developer
7583 
7584 .seealso: DMGetPointSF(), DMSetFromOptions()
7585 @*/
7586 PetscErrorCode DMPlexCheckPointSF(DM dm)
7587 {
7588   PetscSF         pointSF;
7589   PetscInt        cellHeight, cStart, cEnd, l, nleaves, nroots, overlap;
7590   const PetscInt *locals, *rootdegree;
7591   PetscBool       distributed;
7592   PetscErrorCode  ierr;
7593 
7594   PetscFunctionBegin;
7595   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7596   ierr = DMGetPointSF(dm, &pointSF);CHKERRQ(ierr);
7597   ierr = DMPlexIsDistributed(dm, &distributed);CHKERRQ(ierr);
7598   if (!distributed) PetscFunctionReturn(0);
7599   ierr = DMPlexGetOverlap(dm, &overlap);CHKERRQ(ierr);
7600   if (overlap) {
7601     ierr = PetscPrintf(PetscObjectComm((PetscObject)dm), "Warning: DMPlexCheckPointSF() is currently not implemented for meshes with partition overlapping");
7602     PetscFunctionReturn(0);
7603   }
7604   if (!pointSF) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but does not have PointSF attached");
7605   ierr = PetscSFGetGraph(pointSF, &nroots, &nleaves, &locals, NULL);CHKERRQ(ierr);
7606   if (nroots < 0) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but its PointSF has no graph set");
7607   ierr = PetscSFComputeDegreeBegin(pointSF, &rootdegree);CHKERRQ(ierr);
7608   ierr = PetscSFComputeDegreeEnd(pointSF, &rootdegree);CHKERRQ(ierr);
7609 
7610   /* 1) check there are no faces in 2D, cells in 3D, in interface */
7611   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7612   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7613   for (l = 0; l < nleaves; ++l) {
7614     const PetscInt point = locals[l];
7615 
7616     if (point >= cStart && point < cEnd) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D which is a cell", point);
7617   }
7618 
7619   /* 2) if some point is in interface, then all its cone points must be also in interface (either as leaves or roots) */
7620   for (l = 0; l < nleaves; ++l) {
7621     const PetscInt  point = locals[l];
7622     const PetscInt *cone;
7623     PetscInt        coneSize, c, idx;
7624 
7625     ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
7626     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
7627     for (c = 0; c < coneSize; ++c) {
7628       if (!rootdegree[cone[c]]) {
7629         ierr = PetscFindInt(cone[c], nleaves, locals, &idx);CHKERRQ(ierr);
7630         if (idx < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D but not %D from its cone", point, cone[c]);
7631       }
7632     }
7633   }
7634   PetscFunctionReturn(0);
7635 }
7636 
7637 typedef struct cell_stats
7638 {
7639   PetscReal min, max, sum, squaresum;
7640   PetscInt  count;
7641 } cell_stats_t;
7642 
7643 static void MPIAPI cell_stats_reduce(void *a, void *b, int * len, MPI_Datatype *datatype)
7644 {
7645   PetscInt i, N = *len;
7646 
7647   for (i = 0; i < N; i++) {
7648     cell_stats_t *A = (cell_stats_t *) a;
7649     cell_stats_t *B = (cell_stats_t *) b;
7650 
7651     B->min = PetscMin(A->min,B->min);
7652     B->max = PetscMax(A->max,B->max);
7653     B->sum += A->sum;
7654     B->squaresum += A->squaresum;
7655     B->count += A->count;
7656   }
7657 }
7658 
7659 /*@
7660   DMPlexCheckCellShape - Checks the Jacobian of the mapping from reference to real cells and computes some minimal statistics.
7661 
7662   Collective on dm
7663 
7664   Input Parameters:
7665 + dm        - The DMPlex object
7666 . output    - If true, statistics will be displayed on stdout
7667 - condLimit - Display all cells above this condition number, or PETSC_DETERMINE for no cell output
7668 
7669   Notes:
7670   This is mainly intended for debugging/testing purposes.
7671 
7672   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7673 
7674   Level: developer
7675 
7676 .seealso: DMSetFromOptions()
7677 @*/
7678 PetscErrorCode DMPlexCheckCellShape(DM dm, PetscBool output, PetscReal condLimit)
7679 {
7680   DM             dmCoarse;
7681   cell_stats_t   stats, globalStats;
7682   MPI_Comm       comm = PetscObjectComm((PetscObject)dm);
7683   PetscReal      *J, *invJ, min = 0, max = 0, mean = 0, stdev = 0;
7684   PetscReal      limit = condLimit > 0 ? condLimit : PETSC_MAX_REAL;
7685   PetscInt       cdim, cStart, cEnd, c, eStart, eEnd, count = 0;
7686   PetscMPIInt    rank,size;
7687   PetscErrorCode ierr;
7688 
7689   PetscFunctionBegin;
7690   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7691   stats.min   = PETSC_MAX_REAL;
7692   stats.max   = PETSC_MIN_REAL;
7693   stats.sum   = stats.squaresum = 0.;
7694   stats.count = 0;
7695 
7696   ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
7697   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
7698   ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
7699   ierr = PetscMalloc2(PetscSqr(cdim), &J, PetscSqr(cdim), &invJ);CHKERRQ(ierr);
7700   ierr = DMPlexGetSimplexOrBoxCells(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
7701   ierr = DMPlexGetDepthStratum(dm,1,&eStart,&eEnd);CHKERRQ(ierr);
7702   for (c = cStart; c < cEnd; c++) {
7703     PetscInt  i;
7704     PetscReal frobJ = 0., frobInvJ = 0., cond2, cond, detJ;
7705 
7706     ierr = DMPlexComputeCellGeometryAffineFEM(dm,c,NULL,J,invJ,&detJ);CHKERRQ(ierr);
7707     if (detJ < 0.0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D is inverted", c);
7708     for (i = 0; i < PetscSqr(cdim); ++i) {
7709       frobJ    += J[i] * J[i];
7710       frobInvJ += invJ[i] * invJ[i];
7711     }
7712     cond2 = frobJ * frobInvJ;
7713     cond  = PetscSqrtReal(cond2);
7714 
7715     stats.min        = PetscMin(stats.min,cond);
7716     stats.max        = PetscMax(stats.max,cond);
7717     stats.sum       += cond;
7718     stats.squaresum += cond2;
7719     stats.count++;
7720     if (output && cond > limit) {
7721       PetscSection coordSection;
7722       Vec          coordsLocal;
7723       PetscScalar *coords = NULL;
7724       PetscInt     Nv, d, clSize, cl, *closure = NULL;
7725 
7726       ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
7727       ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
7728       ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7729       ierr = PetscSynchronizedPrintf(comm, "[%d] Cell %D cond %g\n", rank, c, (double) cond);CHKERRQ(ierr);
7730       for (i = 0; i < Nv/cdim; ++i) {
7731         ierr = PetscSynchronizedPrintf(comm, "  Vertex %D: (", i);CHKERRQ(ierr);
7732         for (d = 0; d < cdim; ++d) {
7733           if (d > 0) {ierr = PetscSynchronizedPrintf(comm, ", ");CHKERRQ(ierr);}
7734           ierr = PetscSynchronizedPrintf(comm, "%g", (double) PetscRealPart(coords[i*cdim+d]));CHKERRQ(ierr);
7735         }
7736         ierr = PetscSynchronizedPrintf(comm, ")\n");CHKERRQ(ierr);
7737       }
7738       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7739       for (cl = 0; cl < clSize*2; cl += 2) {
7740         const PetscInt edge = closure[cl];
7741 
7742         if ((edge >= eStart) && (edge < eEnd)) {
7743           PetscReal len;
7744 
7745           ierr = DMPlexComputeCellGeometryFVM(dm, edge, &len, NULL, NULL);CHKERRQ(ierr);
7746           ierr = PetscSynchronizedPrintf(comm, "  Edge %D: length %g\n", edge, (double) len);CHKERRQ(ierr);
7747         }
7748       }
7749       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7750       ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7751     }
7752   }
7753   if (output) {ierr = PetscSynchronizedFlush(comm, NULL);CHKERRQ(ierr);}
7754 
7755   if (size > 1) {
7756     PetscMPIInt   blockLengths[2] = {4,1};
7757     MPI_Aint      blockOffsets[2] = {offsetof(cell_stats_t,min),offsetof(cell_stats_t,count)};
7758     MPI_Datatype  blockTypes[2]   = {MPIU_REAL,MPIU_INT}, statType;
7759     MPI_Op        statReduce;
7760 
7761     ierr = MPI_Type_create_struct(2,blockLengths,blockOffsets,blockTypes,&statType);CHKERRQ(ierr);
7762     ierr = MPI_Type_commit(&statType);CHKERRQ(ierr);
7763     ierr = MPI_Op_create(cell_stats_reduce, PETSC_TRUE, &statReduce);CHKERRQ(ierr);
7764     ierr = MPI_Reduce(&stats,&globalStats,1,statType,statReduce,0,comm);CHKERRQ(ierr);
7765     ierr = MPI_Op_free(&statReduce);CHKERRQ(ierr);
7766     ierr = MPI_Type_free(&statType);CHKERRQ(ierr);
7767   } else {
7768     ierr = PetscArraycpy(&globalStats,&stats,1);CHKERRQ(ierr);
7769   }
7770   if (!rank) {
7771     count = globalStats.count;
7772     min   = globalStats.min;
7773     max   = globalStats.max;
7774     mean  = globalStats.sum / globalStats.count;
7775     stdev = globalStats.count > 1 ? PetscSqrtReal(PetscMax((globalStats.squaresum - globalStats.count * mean * mean) / (globalStats.count - 1),0)) : 0.0;
7776   }
7777 
7778   if (output) {
7779     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);
7780   }
7781   ierr = PetscFree2(J,invJ);CHKERRQ(ierr);
7782 
7783   ierr = DMGetCoarseDM(dm,&dmCoarse);CHKERRQ(ierr);
7784   if (dmCoarse) {
7785     PetscBool isplex;
7786 
7787     ierr = PetscObjectTypeCompare((PetscObject)dmCoarse,DMPLEX,&isplex);CHKERRQ(ierr);
7788     if (isplex) {
7789       ierr = DMPlexCheckCellShape(dmCoarse,output,condLimit);CHKERRQ(ierr);
7790     }
7791   }
7792   PetscFunctionReturn(0);
7793 }
7794 
7795 /* Pointwise interpolation
7796      Just code FEM for now
7797      u^f = I u^c
7798      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
7799      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
7800      I_{ij} = psi^f_i phi^c_j
7801 */
7802 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
7803 {
7804   PetscSection   gsc, gsf;
7805   PetscInt       m, n;
7806   void          *ctx;
7807   DM             cdm;
7808   PetscBool      regular, ismatis, isRefined = dmCoarse->data == dmFine->data ? PETSC_FALSE : PETSC_TRUE;
7809   PetscErrorCode ierr;
7810 
7811   PetscFunctionBegin;
7812   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
7813   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
7814   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
7815   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
7816 
7817   ierr = PetscStrcmp(dmCoarse->mattype, MATIS, &ismatis);CHKERRQ(ierr);
7818   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
7819   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
7820   ierr = MatSetType(*interpolation, ismatis ? MATAIJ : dmCoarse->mattype);CHKERRQ(ierr);
7821   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
7822 
7823   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
7824   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
7825   if (!isRefined || (regular && cdm == dmCoarse)) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, isRefined, *interpolation, ctx);CHKERRQ(ierr);}
7826   else                                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
7827   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
7828   if (scaling) {
7829     /* Use naive scaling */
7830     ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
7831   }
7832   PetscFunctionReturn(0);
7833 }
7834 
7835 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
7836 {
7837   PetscErrorCode ierr;
7838   VecScatter     ctx;
7839 
7840   PetscFunctionBegin;
7841   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
7842   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
7843   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
7844   PetscFunctionReturn(0);
7845 }
7846 
7847 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
7848 {
7849   PetscSection   gsc, gsf;
7850   PetscInt       m, n;
7851   void          *ctx;
7852   DM             cdm;
7853   PetscBool      regular;
7854   PetscErrorCode ierr;
7855 
7856   PetscFunctionBegin;
7857   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
7858   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
7859   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
7860   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
7861 
7862   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
7863   ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
7864   ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
7865   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
7866 
7867   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
7868   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
7869   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
7870   else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
7871   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
7872   PetscFunctionReturn(0);
7873 }
7874 
7875 /*@
7876   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
7877 
7878   Input Parameter:
7879 . dm - The DMPlex object
7880 
7881   Output Parameter:
7882 . regular - The flag
7883 
7884   Level: intermediate
7885 
7886 .seealso: DMPlexSetRegularRefinement()
7887 @*/
7888 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
7889 {
7890   PetscFunctionBegin;
7891   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7892   PetscValidPointer(regular, 2);
7893   *regular = ((DM_Plex *) dm->data)->regularRefinement;
7894   PetscFunctionReturn(0);
7895 }
7896 
7897 /*@
7898   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
7899 
7900   Input Parameters:
7901 + dm - The DMPlex object
7902 - regular - The flag
7903 
7904   Level: intermediate
7905 
7906 .seealso: DMPlexGetRegularRefinement()
7907 @*/
7908 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
7909 {
7910   PetscFunctionBegin;
7911   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7912   ((DM_Plex *) dm->data)->regularRefinement = regular;
7913   PetscFunctionReturn(0);
7914 }
7915 
7916 /*@
7917   DMPlexGetCellRefinerType - Get the strategy for refining a cell
7918 
7919   Input Parameter:
7920 . dm - The DMPlex object
7921 
7922   Output Parameter:
7923 . cr - The strategy number
7924 
7925   Level: intermediate
7926 
7927 .seealso: DMPlexSetCellRefinerType(), DMPlexSetRegularRefinement()
7928 @*/
7929 PetscErrorCode DMPlexGetCellRefinerType(DM dm, DMPlexCellRefinerType *cr)
7930 {
7931   PetscFunctionBegin;
7932   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7933   PetscValidPointer(cr, 2);
7934   *cr = ((DM_Plex *) dm->data)->cellRefiner;
7935   PetscFunctionReturn(0);
7936 }
7937 
7938 /*@
7939   DMPlexSetCellRefinerType - Set the strategy for refining a cell
7940 
7941   Input Parameters:
7942 + dm - The DMPlex object
7943 - cr - The strategy number
7944 
7945   Level: intermediate
7946 
7947 .seealso: DMPlexGetCellRefinerType(), DMPlexGetRegularRefinement()
7948 @*/
7949 PetscErrorCode DMPlexSetCellRefinerType(DM dm, DMPlexCellRefinerType cr)
7950 {
7951   PetscFunctionBegin;
7952   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7953   ((DM_Plex *) dm->data)->cellRefiner = cr;
7954   PetscFunctionReturn(0);
7955 }
7956 
7957 /* anchors */
7958 /*@
7959   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
7960   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
7961 
7962   not collective
7963 
7964   Input Parameters:
7965 . dm - The DMPlex object
7966 
7967   Output Parameters:
7968 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
7969 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
7970 
7971 
7972   Level: intermediate
7973 
7974 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
7975 @*/
7976 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
7977 {
7978   DM_Plex *plex = (DM_Plex *)dm->data;
7979   PetscErrorCode ierr;
7980 
7981   PetscFunctionBegin;
7982   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7983   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
7984   if (anchorSection) *anchorSection = plex->anchorSection;
7985   if (anchorIS) *anchorIS = plex->anchorIS;
7986   PetscFunctionReturn(0);
7987 }
7988 
7989 /*@
7990   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
7991   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
7992   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
7993 
7994   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
7995   DMGetConstraints() and filling in the entries in the constraint matrix.
7996 
7997   collective on dm
7998 
7999   Input Parameters:
8000 + dm - The DMPlex object
8001 . 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).
8002 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
8003 
8004   The reference counts of anchorSection and anchorIS are incremented.
8005 
8006   Level: intermediate
8007 
8008 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
8009 @*/
8010 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
8011 {
8012   DM_Plex        *plex = (DM_Plex *)dm->data;
8013   PetscMPIInt    result;
8014   PetscErrorCode ierr;
8015 
8016   PetscFunctionBegin;
8017   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8018   if (anchorSection) {
8019     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
8020     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
8021     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
8022   }
8023   if (anchorIS) {
8024     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
8025     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
8026     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
8027   }
8028 
8029   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
8030   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
8031   plex->anchorSection = anchorSection;
8032 
8033   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
8034   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
8035   plex->anchorIS = anchorIS;
8036 
8037   if (PetscUnlikelyDebug(anchorIS && anchorSection)) {
8038     PetscInt size, a, pStart, pEnd;
8039     const PetscInt *anchors;
8040 
8041     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8042     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
8043     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
8044     for (a = 0; a < size; a++) {
8045       PetscInt p;
8046 
8047       p = anchors[a];
8048       if (p >= pStart && p < pEnd) {
8049         PetscInt dof;
8050 
8051         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8052         if (dof) {
8053           PetscErrorCode ierr2;
8054 
8055           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
8056           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
8057         }
8058       }
8059     }
8060     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
8061   }
8062   /* reset the generic constraints */
8063   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
8064   PetscFunctionReturn(0);
8065 }
8066 
8067 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
8068 {
8069   PetscSection anchorSection;
8070   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
8071   PetscErrorCode ierr;
8072 
8073   PetscFunctionBegin;
8074   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8075   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8076   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
8077   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8078   if (numFields) {
8079     PetscInt f;
8080     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
8081 
8082     for (f = 0; f < numFields; f++) {
8083       PetscInt numComp;
8084 
8085       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
8086       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
8087     }
8088   }
8089   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8090   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
8091   pStart = PetscMax(pStart,sStart);
8092   pEnd   = PetscMin(pEnd,sEnd);
8093   pEnd   = PetscMax(pStart,pEnd);
8094   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
8095   for (p = pStart; p < pEnd; p++) {
8096     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8097     if (dof) {
8098       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
8099       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
8100       for (f = 0; f < numFields; f++) {
8101         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
8102         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
8103       }
8104     }
8105   }
8106   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
8107   PetscFunctionReturn(0);
8108 }
8109 
8110 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
8111 {
8112   PetscSection aSec;
8113   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
8114   const PetscInt *anchors;
8115   PetscInt numFields, f;
8116   IS aIS;
8117   PetscErrorCode ierr;
8118 
8119   PetscFunctionBegin;
8120   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8121   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
8122   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
8123   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
8124   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
8125   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
8126   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
8127   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
8128   /* cSec will be a subset of aSec and section */
8129   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
8130   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
8131   i[0] = 0;
8132   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8133   for (p = pStart; p < pEnd; p++) {
8134     PetscInt rDof, rOff, r;
8135 
8136     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8137     if (!rDof) continue;
8138     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8139     if (numFields) {
8140       for (f = 0; f < numFields; f++) {
8141         annz = 0;
8142         for (r = 0; r < rDof; r++) {
8143           a = anchors[rOff + r];
8144           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8145           annz += aDof;
8146         }
8147         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8148         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
8149         for (q = 0; q < dof; q++) {
8150           i[off + q + 1] = i[off + q] + annz;
8151         }
8152       }
8153     }
8154     else {
8155       annz = 0;
8156       for (q = 0; q < dof; q++) {
8157         a = anchors[off + q];
8158         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8159         annz += aDof;
8160       }
8161       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8162       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
8163       for (q = 0; q < dof; q++) {
8164         i[off + q + 1] = i[off + q] + annz;
8165       }
8166     }
8167   }
8168   nnz = i[m];
8169   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
8170   offset = 0;
8171   for (p = pStart; p < pEnd; p++) {
8172     if (numFields) {
8173       for (f = 0; f < numFields; f++) {
8174         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8175         for (q = 0; q < dof; q++) {
8176           PetscInt rDof, rOff, r;
8177           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8178           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8179           for (r = 0; r < rDof; r++) {
8180             PetscInt s;
8181 
8182             a = anchors[rOff + r];
8183             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8184             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
8185             for (s = 0; s < aDof; s++) {
8186               j[offset++] = aOff + s;
8187             }
8188           }
8189         }
8190       }
8191     }
8192     else {
8193       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8194       for (q = 0; q < dof; q++) {
8195         PetscInt rDof, rOff, r;
8196         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8197         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8198         for (r = 0; r < rDof; r++) {
8199           PetscInt s;
8200 
8201           a = anchors[rOff + r];
8202           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8203           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
8204           for (s = 0; s < aDof; s++) {
8205             j[offset++] = aOff + s;
8206           }
8207         }
8208       }
8209     }
8210   }
8211   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
8212   ierr = PetscFree(i);CHKERRQ(ierr);
8213   ierr = PetscFree(j);CHKERRQ(ierr);
8214   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
8215   PetscFunctionReturn(0);
8216 }
8217 
8218 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
8219 {
8220   DM_Plex        *plex = (DM_Plex *)dm->data;
8221   PetscSection   anchorSection, section, cSec;
8222   Mat            cMat;
8223   PetscErrorCode ierr;
8224 
8225   PetscFunctionBegin;
8226   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8227   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8228   if (anchorSection) {
8229     PetscInt Nf;
8230 
8231     ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
8232     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
8233     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
8234     ierr = DMGetNumFields(dm,&Nf);CHKERRQ(ierr);
8235     if (Nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
8236     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
8237     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
8238     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
8239   }
8240   PetscFunctionReturn(0);
8241 }
8242 
8243 PetscErrorCode DMCreateSubDomainDM_Plex(DM dm, DMLabel label, PetscInt value, IS *is, DM *subdm)
8244 {
8245   IS             subis;
8246   PetscSection   section, subsection;
8247   PetscErrorCode ierr;
8248 
8249   PetscFunctionBegin;
8250   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
8251   if (!section) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting subdomain");
8252   if (!subdm)   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set output subDM for splitting subdomain");
8253   /* Create subdomain */
8254   ierr = DMPlexFilter(dm, label, value, subdm);CHKERRQ(ierr);
8255   /* Create submodel */
8256   ierr = DMPlexGetSubpointIS(*subdm, &subis);CHKERRQ(ierr);
8257   ierr = PetscSectionCreateSubmeshSection(section, subis, &subsection);CHKERRQ(ierr);
8258   ierr = DMSetLocalSection(*subdm, subsection);CHKERRQ(ierr);
8259   ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
8260   ierr = DMCopyDisc(dm, *subdm);CHKERRQ(ierr);
8261   /* Create map from submodel to global model */
8262   if (is) {
8263     PetscSection    sectionGlobal, subsectionGlobal;
8264     IS              spIS;
8265     const PetscInt *spmap;
8266     PetscInt       *subIndices;
8267     PetscInt        subSize = 0, subOff = 0, pStart, pEnd, p;
8268     PetscInt        Nf, f, bs = -1, bsLocal[2], bsMinMax[2];
8269 
8270     ierr = DMPlexGetSubpointIS(*subdm, &spIS);CHKERRQ(ierr);
8271     ierr = ISGetIndices(spIS, &spmap);CHKERRQ(ierr);
8272     ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
8273     ierr = DMGetGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
8274     ierr = DMGetGlobalSection(*subdm, &subsectionGlobal);CHKERRQ(ierr);
8275     ierr = PetscSectionGetChart(subsection, &pStart, &pEnd);CHKERRQ(ierr);
8276     for (p = pStart; p < pEnd; ++p) {
8277       PetscInt gdof, pSubSize  = 0;
8278 
8279       ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
8280       if (gdof > 0) {
8281         for (f = 0; f < Nf; ++f) {
8282           PetscInt fdof, fcdof;
8283 
8284           ierr     = PetscSectionGetFieldDof(subsection, p, f, &fdof);CHKERRQ(ierr);
8285           ierr     = PetscSectionGetFieldConstraintDof(subsection, p, f, &fcdof);CHKERRQ(ierr);
8286           pSubSize += fdof-fcdof;
8287         }
8288         subSize += pSubSize;
8289         if (pSubSize) {
8290           if (bs < 0) {
8291             bs = pSubSize;
8292           } else if (bs != pSubSize) {
8293             /* Layout does not admit a pointwise block size */
8294             bs = 1;
8295           }
8296         }
8297       }
8298     }
8299     /* Must have same blocksize on all procs (some might have no points) */
8300     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
8301     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
8302     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
8303     else                            {bs = bsMinMax[0];}
8304     ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
8305     for (p = pStart; p < pEnd; ++p) {
8306       PetscInt gdof, goff;
8307 
8308       ierr = PetscSectionGetDof(subsectionGlobal, p, &gdof);CHKERRQ(ierr);
8309       if (gdof > 0) {
8310         const PetscInt point = spmap[p];
8311 
8312         ierr = PetscSectionGetOffset(sectionGlobal, point, &goff);CHKERRQ(ierr);
8313         for (f = 0; f < Nf; ++f) {
8314           PetscInt fdof, fcdof, fc, f2, poff = 0;
8315 
8316           /* Can get rid of this loop by storing field information in the global section */
8317           for (f2 = 0; f2 < f; ++f2) {
8318             ierr  = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
8319             ierr  = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
8320             poff += fdof-fcdof;
8321           }
8322           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
8323           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
8324           for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
8325             subIndices[subOff] = goff+poff+fc;
8326           }
8327         }
8328       }
8329     }
8330     ierr = ISRestoreIndices(spIS, &spmap);CHKERRQ(ierr);
8331     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
8332     if (bs > 1) {
8333       /* We need to check that the block size does not come from non-contiguous fields */
8334       PetscInt i, j, set = 1;
8335       for (i = 0; i < subSize; i += bs) {
8336         for (j = 0; j < bs; ++j) {
8337           if (subIndices[i+j] != subIndices[i]+j) {set = 0; break;}
8338         }
8339       }
8340       if (set) {ierr = ISSetBlockSize(*is, bs);CHKERRQ(ierr);}
8341     }
8342     /* Attach nullspace */
8343     for (f = 0; f < Nf; ++f) {
8344       (*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[f];
8345       if ((*subdm)->nullspaceConstructors[f]) break;
8346     }
8347     if (f < Nf) {
8348       MatNullSpace nullSpace;
8349 
8350       ierr = (*(*subdm)->nullspaceConstructors[f])(*subdm, f, &nullSpace);CHKERRQ(ierr);
8351       ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
8352       ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
8353     }
8354   }
8355   PetscFunctionReturn(0);
8356 }
8357 
8358 /*@
8359   DMPlexMonitorThroughput - Report the cell throughput of FE integration
8360 
8361   Input Parameter:
8362 - dm - The DM
8363 
8364   Level: developer
8365 
8366   Options Database Keys:
8367 . -dm_plex_monitor_throughput - Activate the monitor
8368 
8369 .seealso: DMSetFromOptions(), DMPlexCreate()
8370 @*/
8371 PetscErrorCode DMPlexMonitorThroughput(DM dm, void *dummy)
8372 {
8373 #if defined(PETSC_USE_LOG)
8374   PetscStageLog      stageLog;
8375   PetscLogEvent      event;
8376   PetscLogStage      stage;
8377   PetscEventPerfInfo eventInfo;
8378   PetscReal          cellRate, flopRate;
8379   PetscInt           cStart, cEnd, Nf, N;
8380   const char        *name;
8381   PetscErrorCode     ierr;
8382 #endif
8383 
8384   PetscFunctionBegin;
8385   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8386 #if defined(PETSC_USE_LOG)
8387   ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
8388   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
8389   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
8390   ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
8391   ierr = PetscStageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
8392   ierr = PetscLogEventGetId("DMPlexResidualFE", &event);CHKERRQ(ierr);
8393   ierr = PetscLogEventGetPerfInfo(stage, event, &eventInfo);CHKERRQ(ierr);
8394   N        = (cEnd - cStart)*Nf*eventInfo.count;
8395   flopRate = eventInfo.flops/eventInfo.time;
8396   cellRate = N/eventInfo.time;
8397   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);
8398 #else
8399   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Plex Throughput Monitor is not supported if logging is turned off. Reconfigure using --with-log.");
8400 #endif
8401   PetscFunctionReturn(0);
8402 }
8403