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