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