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