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