xref: /petsc/src/dm/impls/plex/plex.c (revision 09f0c63bbe0ed994037a5cacc9b16ee5bc7a183d)
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, DMPLEX_RebalanceSharedPoints;
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 /*@
3550   DMPlexCreateSpectralClosurePermutation - Create a permutation from the default (BFS) point ordering in the closure, to
3551   a lexicographic ordering over the cell, and set this permutation in the section provided.
3552 
3553   Input Parameters:
3554 + dm      - The DM
3555 . point   - Either a cell (highest dim point) or an edge (dim 1 point), or PETSC_DETERMINE
3556 - section - The PetscSection to reorder, or NULL for the default section
3557 
3558   Note: The point is used to determine the number of dofs/field on an edge. For SEM, this is related to the polynomial
3559   degree of the basis.
3560 
3561   Level: developer
3562 
3563 .seealso: DMGetSection(), PetscSectionSetClosurePermutation()
3564 @*/
3565 PetscErrorCode DMPlexCreateSpectralClosurePermutation(DM dm, PetscInt point, PetscSection section)
3566 {
3567   DMLabel        label;
3568   PetscInt      *perm;
3569   PetscInt       dim, depth, eStart, k, Nf, f, Nc, c, i, j, size = 0, offset = 0, foffset = 0;
3570   PetscErrorCode ierr;
3571 
3572   PetscFunctionBegin;
3573   if (point < 0) {ierr = DMPlexGetDepthStratum(dm, 1, &point, NULL);CHKERRQ(ierr);}
3574   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3575   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3576   ierr = DMLabelGetValue(label, point, &depth);CHKERRQ(ierr);
3577   if (depth == 1) {eStart = point;}
3578   else if  (depth == dim) {
3579     const PetscInt *cone;
3580 
3581     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3582     if (dim == 2) eStart = cone[0];
3583     else if (dim == 3) {
3584       const PetscInt *cone2;
3585       ierr = DMPlexGetCone(dm, cone[0], &cone2);CHKERRQ(ierr);
3586       eStart = cone2[0];
3587     } 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);
3588   } 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);
3589   if (!section) {ierr = DMGetSection(dm, &section);CHKERRQ(ierr);}
3590   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
3591   if (dim <= 1) PetscFunctionReturn(0);
3592   for (f = 0; f < Nf; ++f) {
3593     /* An order k SEM disc has k-1 dofs on an edge */
3594     ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3595     ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3596     k = k/Nc + 1;
3597     size += PetscPowInt(k+1, dim)*Nc;
3598   }
3599   ierr = PetscMalloc1(size, &perm);CHKERRQ(ierr);
3600   for (f = 0; f < Nf; ++f) {
3601     switch (dim) {
3602     case 2:
3603       /* The original quad closure is oriented clockwise, {f, e_b, e_r, e_t, e_l, v_lb, v_rb, v_tr, v_tl} */
3604       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3605       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3606       k = k/Nc + 1;
3607       /* The SEM order is
3608 
3609          v_lb, {e_b}, v_rb,
3610          e^{(k-1)-i}_l, {f^{i*(k-1)}}, e^i_r,
3611          v_lt, reverse {e_t}, v_rt
3612       */
3613       {
3614         const PetscInt of   = 0;
3615         const PetscInt oeb  = of   + PetscSqr(k-1);
3616         const PetscInt oer  = oeb  + (k-1);
3617         const PetscInt oet  = oer  + (k-1);
3618         const PetscInt oel  = oet  + (k-1);
3619         const PetscInt ovlb = oel  + (k-1);
3620         const PetscInt ovrb = ovlb + 1;
3621         const PetscInt ovrt = ovrb + 1;
3622         const PetscInt ovlt = ovrt + 1;
3623         PetscInt       o;
3624 
3625         /* bottom */
3626         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlb*Nc + c + foffset;
3627         for (o = oeb; o < oer; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3628         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrb*Nc + c + foffset;
3629         /* middle */
3630         for (i = 0; i < k-1; ++i) {
3631           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oel+(k-2)-i)*Nc + c + foffset;
3632           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;
3633           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oer+i)*Nc + c + foffset;
3634         }
3635         /* top */
3636         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlt*Nc + c + foffset;
3637         for (o = oel-1; o >= oet; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3638         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrt*Nc + c + foffset;
3639         foffset = offset;
3640       }
3641       break;
3642     case 3:
3643       /* The original hex closure is
3644 
3645          {c,
3646           f_b, f_t, f_f, f_b, f_r, f_l,
3647           e_bl, e_bb, e_br, e_bf,  e_tf, e_tr, e_tb, e_tl,  e_rf, e_lf, e_lb, e_rb,
3648           v_blf, v_blb, v_brb, v_brf, v_tlf, v_trf, v_trb, v_tlb}
3649       */
3650       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3651       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3652       k = k/Nc + 1;
3653       /* The SEM order is
3654          Bottom Slice
3655          v_blf, {e^{(k-1)-n}_bf}, v_brf,
3656          e^{i}_bl, f^{n*(k-1)+(k-1)-i}_b, e^{(k-1)-i}_br,
3657          v_blb, {e_bb}, v_brb,
3658 
3659          Middle Slice (j)
3660          {e^{(k-1)-j}_lf}, {f^{j*(k-1)+n}_f}, e^j_rf,
3661          f^{i*(k-1)+j}_l, {c^{(j*(k-1) + i)*(k-1)+n}_t}, f^{j*(k-1)+i}_r,
3662          e^j_lb, {f^{j*(k-1)+(k-1)-n}_b}, e^{(k-1)-j}_rb,
3663 
3664          Top Slice
3665          v_tlf, {e_tf}, v_trf,
3666          e^{(k-1)-i}_tl, {f^{i*(k-1)}_t}, e^{i}_tr,
3667          v_tlb, {e^{(k-1)-n}_tb}, v_trb,
3668       */
3669       {
3670         const PetscInt oc    = 0;
3671         const PetscInt ofb   = oc    + PetscSqr(k-1)*(k-1);
3672         const PetscInt oft   = ofb   + PetscSqr(k-1);
3673         const PetscInt off   = oft   + PetscSqr(k-1);
3674         const PetscInt ofk   = off   + PetscSqr(k-1);
3675         const PetscInt ofr   = ofk   + PetscSqr(k-1);
3676         const PetscInt ofl   = ofr   + PetscSqr(k-1);
3677         const PetscInt oebl  = ofl   + PetscSqr(k-1);
3678         const PetscInt oebb  = oebl  + (k-1);
3679         const PetscInt oebr  = oebb  + (k-1);
3680         const PetscInt oebf  = oebr  + (k-1);
3681         const PetscInt oetf  = oebf  + (k-1);
3682         const PetscInt oetr  = oetf  + (k-1);
3683         const PetscInt oetb  = oetr  + (k-1);
3684         const PetscInt oetl  = oetb  + (k-1);
3685         const PetscInt oerf  = oetl  + (k-1);
3686         const PetscInt oelf  = oerf  + (k-1);
3687         const PetscInt oelb  = oelf  + (k-1);
3688         const PetscInt oerb  = oelb  + (k-1);
3689         const PetscInt ovblf = oerb  + (k-1);
3690         const PetscInt ovblb = ovblf + 1;
3691         const PetscInt ovbrb = ovblb + 1;
3692         const PetscInt ovbrf = ovbrb + 1;
3693         const PetscInt ovtlf = ovbrf + 1;
3694         const PetscInt ovtrf = ovtlf + 1;
3695         const PetscInt ovtrb = ovtrf + 1;
3696         const PetscInt ovtlb = ovtrb + 1;
3697         PetscInt       o, n;
3698 
3699         /* Bottom Slice */
3700         /*   bottom */
3701         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblf*Nc + c + foffset;
3702         for (o = oetf-1; o >= oebf; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3703         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrf*Nc + c + foffset;
3704         /*   middle */
3705         for (i = 0; i < k-1; ++i) {
3706           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebl+i)*Nc + c + foffset;
3707           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;}
3708           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebr+(k-2)-i)*Nc + c + foffset;
3709         }
3710         /*   top */
3711         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblb*Nc + c + foffset;
3712         for (o = oebb; o < oebr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3713         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrb*Nc + c + foffset;
3714 
3715         /* Middle Slice */
3716         for (j = 0; j < k-1; ++j) {
3717           /*   bottom */
3718           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelf+(k-2)-j)*Nc + c + foffset;
3719           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;
3720           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerf+j)*Nc + c + foffset;
3721           /*   middle */
3722           for (i = 0; i < k-1; ++i) {
3723             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofl+i*(k-1)+j)*Nc + c + foffset;
3724             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;
3725             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofr+j*(k-1)+i)*Nc + c + foffset;
3726           }
3727           /*   top */
3728           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelb+j)*Nc + c + foffset;
3729           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;
3730           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerb+(k-2)-j)*Nc + c + foffset;
3731         }
3732 
3733         /* Top Slice */
3734         /*   bottom */
3735         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlf*Nc + c + foffset;
3736         for (o = oetf; o < oetr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3737         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrf*Nc + c + foffset;
3738         /*   middle */
3739         for (i = 0; i < k-1; ++i) {
3740           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetl+(k-2)-i)*Nc + c + foffset;
3741           for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oft+i*(k-1)+n)*Nc + c + foffset;
3742           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetr+i)*Nc + c + foffset;
3743         }
3744         /*   top */
3745         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlb*Nc + c + foffset;
3746         for (o = oetl-1; o >= oetb; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3747         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrb*Nc + c + foffset;
3748 
3749         foffset = offset;
3750       }
3751       break;
3752     default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No spectral ordering for dimension %D", dim);
3753     }
3754   }
3755   if (offset != size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Number of permutation entries %D != %D", offset, size);
3756   /* Check permutation */
3757   {
3758     PetscInt *check;
3759 
3760     ierr = PetscMalloc1(size, &check);CHKERRQ(ierr);
3761     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]);}
3762     for (i = 0; i < size; ++i) check[perm[i]] = i;
3763     for (i = 0; i < size; ++i) {if (check[i] < 0) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Missing permutation index %D", i);}
3764     ierr = PetscFree(check);CHKERRQ(ierr);
3765   }
3766   ierr = PetscSectionSetClosurePermutation_Internal(section, (PetscObject) dm, size, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
3767   PetscFunctionReturn(0);
3768 }
3769 
3770 PetscErrorCode DMPlexGetPointDualSpaceFEM(DM dm, PetscInt point, PetscInt field, PetscDualSpace *dspace)
3771 {
3772   PetscDS        prob;
3773   PetscInt       depth, Nf, h;
3774   DMLabel        label;
3775   PetscErrorCode ierr;
3776 
3777   PetscFunctionBeginHot;
3778   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3779   Nf      = prob->Nf;
3780   label   = dm->depthLabel;
3781   *dspace = NULL;
3782   if (field < Nf) {
3783     PetscObject disc = prob->disc[field];
3784 
3785     if (disc->classid == PETSCFE_CLASSID) {
3786       PetscDualSpace dsp;
3787 
3788       ierr = PetscFEGetDualSpace((PetscFE)disc,&dsp);CHKERRQ(ierr);
3789       ierr = DMLabelGetNumValues(label,&depth);CHKERRQ(ierr);
3790       ierr = DMLabelGetValue(label,point,&h);CHKERRQ(ierr);
3791       h    = depth - 1 - h;
3792       if (h) {
3793         ierr = PetscDualSpaceGetHeightSubspace(dsp,h,dspace);CHKERRQ(ierr);
3794       } else {
3795         *dspace = dsp;
3796       }
3797     }
3798   }
3799   PetscFunctionReturn(0);
3800 }
3801 
3802 
3803 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3804 {
3805   PetscScalar    *array, *vArray;
3806   const PetscInt *cone, *coneO;
3807   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
3808   PetscErrorCode  ierr;
3809 
3810   PetscFunctionBeginHot;
3811   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3812   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3813   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3814   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3815   if (!values || !*values) {
3816     if ((point >= pStart) && (point < pEnd)) {
3817       PetscInt dof;
3818 
3819       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3820       size += dof;
3821     }
3822     for (p = 0; p < numPoints; ++p) {
3823       const PetscInt cp = cone[p];
3824       PetscInt       dof;
3825 
3826       if ((cp < pStart) || (cp >= pEnd)) continue;
3827       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3828       size += dof;
3829     }
3830     if (!values) {
3831       if (csize) *csize = size;
3832       PetscFunctionReturn(0);
3833     }
3834     ierr = DMGetWorkArray(dm, size, MPIU_SCALAR, &array);CHKERRQ(ierr);
3835   } else {
3836     array = *values;
3837   }
3838   size = 0;
3839   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3840   if ((point >= pStart) && (point < pEnd)) {
3841     PetscInt     dof, off, d;
3842     PetscScalar *varr;
3843 
3844     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3845     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3846     varr = &vArray[off];
3847     for (d = 0; d < dof; ++d, ++offset) {
3848       array[offset] = varr[d];
3849     }
3850     size += dof;
3851   }
3852   for (p = 0; p < numPoints; ++p) {
3853     const PetscInt cp = cone[p];
3854     PetscInt       o  = coneO[p];
3855     PetscInt       dof, off, d;
3856     PetscScalar   *varr;
3857 
3858     if ((cp < pStart) || (cp >= pEnd)) continue;
3859     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3860     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3861     varr = &vArray[off];
3862     if (o >= 0) {
3863       for (d = 0; d < dof; ++d, ++offset) {
3864         array[offset] = varr[d];
3865       }
3866     } else {
3867       for (d = dof-1; d >= 0; --d, ++offset) {
3868         array[offset] = varr[d];
3869       }
3870     }
3871     size += dof;
3872   }
3873   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3874   if (!*values) {
3875     if (csize) *csize = size;
3876     *values = array;
3877   } else {
3878     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
3879     *csize = size;
3880   }
3881   PetscFunctionReturn(0);
3882 }
3883 
3884 static PetscErrorCode DMPlexGetCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3885 {
3886   const PetscInt *cla;
3887   PetscInt       np, *pts = NULL;
3888   PetscErrorCode ierr;
3889 
3890   PetscFunctionBeginHot;
3891   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, clSec, clPoints);CHKERRQ(ierr);
3892   if (!*clPoints) {
3893     PetscInt pStart, pEnd, p, q;
3894 
3895     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3896     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &np, &pts);CHKERRQ(ierr);
3897     /* Compress out points not in the section */
3898     for (p = 0, q = 0; p < np; p++) {
3899       PetscInt r = pts[2*p];
3900       if ((r >= pStart) && (r < pEnd)) {
3901         pts[q*2]   = r;
3902         pts[q*2+1] = pts[2*p+1];
3903         ++q;
3904       }
3905     }
3906     np = q;
3907     cla = NULL;
3908   } else {
3909     PetscInt dof, off;
3910 
3911     ierr = PetscSectionGetDof(*clSec, point, &dof);CHKERRQ(ierr);
3912     ierr = PetscSectionGetOffset(*clSec, point, &off);CHKERRQ(ierr);
3913     ierr = ISGetIndices(*clPoints, &cla);CHKERRQ(ierr);
3914     np   = dof/2;
3915     pts  = (PetscInt *) &cla[off];
3916   }
3917   *numPoints = np;
3918   *points    = pts;
3919   *clp       = cla;
3920 
3921   PetscFunctionReturn(0);
3922 }
3923 
3924 static PetscErrorCode DMPlexRestoreCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3925 {
3926   PetscErrorCode ierr;
3927 
3928   PetscFunctionBeginHot;
3929   if (!*clPoints) {
3930     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, numPoints, points);CHKERRQ(ierr);
3931   } else {
3932     ierr = ISRestoreIndices(*clPoints, clp);CHKERRQ(ierr);
3933   }
3934   *numPoints = 0;
3935   *points    = NULL;
3936   *clSec     = NULL;
3937   *clPoints  = NULL;
3938   *clp       = NULL;
3939   PetscFunctionReturn(0);
3940 }
3941 
3942 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[])
3943 {
3944   PetscInt          offset = 0, p;
3945   const PetscInt    **perms = NULL;
3946   const PetscScalar **flips = NULL;
3947   PetscErrorCode    ierr;
3948 
3949   PetscFunctionBeginHot;
3950   *size = 0;
3951   ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3952   for (p = 0; p < numPoints; p++) {
3953     const PetscInt    point = points[2*p];
3954     const PetscInt    *perm = perms ? perms[p] : NULL;
3955     const PetscScalar *flip = flips ? flips[p] : NULL;
3956     PetscInt          dof, off, d;
3957     const PetscScalar *varr;
3958 
3959     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3960     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3961     varr = &vArray[off];
3962     if (clperm) {
3963       if (perm) {
3964         for (d = 0; d < dof; d++) array[clperm[offset + perm[d]]]  = varr[d];
3965       } else {
3966         for (d = 0; d < dof; d++) array[clperm[offset +      d ]]  = varr[d];
3967       }
3968       if (flip) {
3969         for (d = 0; d < dof; d++) array[clperm[offset +      d ]] *= flip[d];
3970       }
3971     } else {
3972       if (perm) {
3973         for (d = 0; d < dof; d++) array[offset + perm[d]]  = varr[d];
3974       } else {
3975         for (d = 0; d < dof; d++) array[offset +      d ]  = varr[d];
3976       }
3977       if (flip) {
3978         for (d = 0; d < dof; d++) array[offset +      d ] *= flip[d];
3979       }
3980     }
3981     offset += dof;
3982   }
3983   ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3984   *size = offset;
3985   PetscFunctionReturn(0);
3986 }
3987 
3988 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[])
3989 {
3990   PetscInt          offset = 0, f;
3991   PetscErrorCode    ierr;
3992 
3993   PetscFunctionBeginHot;
3994   *size = 0;
3995   for (f = 0; f < numFields; ++f) {
3996     PetscInt          p;
3997     const PetscInt    **perms = NULL;
3998     const PetscScalar **flips = NULL;
3999 
4000     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4001     for (p = 0; p < numPoints; p++) {
4002       const PetscInt    point = points[2*p];
4003       PetscInt          fdof, foff, b;
4004       const PetscScalar *varr;
4005       const PetscInt    *perm = perms ? perms[p] : NULL;
4006       const PetscScalar *flip = flips ? flips[p] : NULL;
4007 
4008       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4009       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4010       varr = &vArray[foff];
4011       if (clperm) {
4012         if (perm) {for (b = 0; b < fdof; b++) {array[clperm[offset + perm[b]]]  = varr[b];}}
4013         else      {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]]  = varr[b];}}
4014         if (flip) {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]] *= flip[b];}}
4015       } else {
4016         if (perm) {for (b = 0; b < fdof; b++) {array[offset + perm[b]]  = varr[b];}}
4017         else      {for (b = 0; b < fdof; b++) {array[offset +      b ]  = varr[b];}}
4018         if (flip) {for (b = 0; b < fdof; b++) {array[offset +      b ] *= flip[b];}}
4019       }
4020       offset += fdof;
4021     }
4022     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4023   }
4024   *size = offset;
4025   PetscFunctionReturn(0);
4026 }
4027 
4028 /*@C
4029   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4030 
4031   Not collective
4032 
4033   Input Parameters:
4034 + dm - The DM
4035 . section - The section describing the layout in v, or NULL to use the default section
4036 . v - The local vector
4037 . point - The point in the DM
4038 . csize - The size of the input values array, or NULL
4039 - values - An array to use for the values, or NULL to have it allocated automatically
4040 
4041   Output Parameters:
4042 + csize - The number of values in the closure
4043 - values - The array of values. If the user provided NULL, it is a borrowed array and should not be freed
4044 
4045 $ Note that DMPlexVecGetClosure/DMPlexVecRestoreClosure only allocates the values array if it set to NULL in the
4046 $ calling function. This is because DMPlexVecGetClosure() is typically called in the inner loop of a Vec or Mat
4047 $ assembly function, and a user may already have allocated storage for this operation.
4048 $
4049 $ A typical use could be
4050 $
4051 $  values = NULL;
4052 $  ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4053 $  for (cl = 0; cl < clSize; ++cl) {
4054 $    <Compute on closure>
4055 $  }
4056 $  ierr = DMPlexVecRestoreClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4057 $
4058 $ or
4059 $
4060 $  PetscMalloc1(clMaxSize, &values);
4061 $  for (p = pStart; p < pEnd; ++p) {
4062 $    clSize = clMaxSize;
4063 $    ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4064 $    for (cl = 0; cl < clSize; ++cl) {
4065 $      <Compute on closure>
4066 $    }
4067 $  }
4068 $  PetscFree(values);
4069 
4070   Fortran Notes:
4071   Since it returns an array, this routine is only available in Fortran 90, and you must
4072   include petsc.h90 in your code.
4073 
4074   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4075 
4076   Level: intermediate
4077 
4078 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4079 @*/
4080 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4081 {
4082   PetscSection       clSection;
4083   IS                 clPoints;
4084   PetscScalar       *array;
4085   const PetscScalar *vArray;
4086   PetscInt          *points = NULL;
4087   const PetscInt    *clp, *perm;
4088   PetscInt           depth, numFields, numPoints, size;
4089   PetscErrorCode     ierr;
4090 
4091   PetscFunctionBeginHot;
4092   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4093   if (!section) {ierr = DMGetSection(dm, &section);CHKERRQ(ierr);}
4094   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4095   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4096   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4097   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4098   if (depth == 1 && numFields < 2) {
4099     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4100     PetscFunctionReturn(0);
4101   }
4102   /* Get points */
4103   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4104   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &perm);CHKERRQ(ierr);
4105   /* Get array */
4106   if (!values || !*values) {
4107     PetscInt asize = 0, dof, p;
4108 
4109     for (p = 0; p < numPoints*2; p += 2) {
4110       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4111       asize += dof;
4112     }
4113     if (!values) {
4114       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4115       if (csize) *csize = asize;
4116       PetscFunctionReturn(0);
4117     }
4118     ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, &array);CHKERRQ(ierr);
4119   } else {
4120     array = *values;
4121   }
4122   ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4123   /* Get values */
4124   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, numPoints, points, numFields, perm, vArray, &size, array);CHKERRQ(ierr);}
4125   else               {ierr = DMPlexVecGetClosure_Static(dm, section, numPoints, points, perm, vArray, &size, array);CHKERRQ(ierr);}
4126   /* Cleanup points */
4127   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4128   /* Cleanup array */
4129   ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4130   if (!*values) {
4131     if (csize) *csize = size;
4132     *values = array;
4133   } else {
4134     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4135     *csize = size;
4136   }
4137   PetscFunctionReturn(0);
4138 }
4139 
4140 /*@C
4141   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
4142 
4143   Not collective
4144 
4145   Input Parameters:
4146 + dm - The DM
4147 . section - The section describing the layout in v, or NULL to use the default section
4148 . v - The local vector
4149 . point - The point in the DM
4150 . csize - The number of values in the closure, or NULL
4151 - values - The array of values, which is a borrowed array and should not be freed
4152 
4153   Note that the array values are discarded and not copied back into v. In order to copy values back to v, use DMPlexVecSetClosure()
4154 
4155   Fortran Notes:
4156   Since it returns an array, this routine is only available in Fortran 90, and you must
4157   include petsc.h90 in your code.
4158 
4159   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4160 
4161   Level: intermediate
4162 
4163 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4164 @*/
4165 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4166 {
4167   PetscInt       size = 0;
4168   PetscErrorCode ierr;
4169 
4170   PetscFunctionBegin;
4171   /* Should work without recalculating size */
4172   ierr = DMRestoreWorkArray(dm, size, MPIU_SCALAR, (void*) values);CHKERRQ(ierr);
4173   *values = NULL;
4174   PetscFunctionReturn(0);
4175 }
4176 
4177 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
4178 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4179 
4180 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[])
4181 {
4182   PetscInt        cdof;   /* The number of constraints on this point */
4183   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4184   PetscScalar    *a;
4185   PetscInt        off, cind = 0, k;
4186   PetscErrorCode  ierr;
4187 
4188   PetscFunctionBegin;
4189   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4190   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4191   a    = &array[off];
4192   if (!cdof || setBC) {
4193     if (clperm) {
4194       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
4195       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
4196     } else {
4197       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
4198       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
4199     }
4200   } else {
4201     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4202     if (clperm) {
4203       if (perm) {for (k = 0; k < dof; ++k) {
4204           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4205           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4206         }
4207       } else {
4208         for (k = 0; k < dof; ++k) {
4209           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4210           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4211         }
4212       }
4213     } else {
4214       if (perm) {
4215         for (k = 0; k < dof; ++k) {
4216           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4217           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4218         }
4219       } else {
4220         for (k = 0; k < dof; ++k) {
4221           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4222           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4223         }
4224       }
4225     }
4226   }
4227   PetscFunctionReturn(0);
4228 }
4229 
4230 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[])
4231 {
4232   PetscInt        cdof;   /* The number of constraints on this point */
4233   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4234   PetscScalar    *a;
4235   PetscInt        off, cind = 0, k;
4236   PetscErrorCode  ierr;
4237 
4238   PetscFunctionBegin;
4239   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4240   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4241   a    = &array[off];
4242   if (cdof) {
4243     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4244     if (clperm) {
4245       if (perm) {
4246         for (k = 0; k < dof; ++k) {
4247           if ((cind < cdof) && (k == cdofs[cind])) {
4248             fuse(&a[k], values[clperm[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[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4256             cind++;
4257           }
4258         }
4259       }
4260     } else {
4261       if (perm) {
4262         for (k = 0; k < dof; ++k) {
4263           if ((cind < cdof) && (k == cdofs[cind])) {
4264             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4265             cind++;
4266           }
4267         }
4268       } else {
4269         for (k = 0; k < dof; ++k) {
4270           if ((cind < cdof) && (k == cdofs[cind])) {
4271             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4272             cind++;
4273           }
4274         }
4275       }
4276     }
4277   }
4278   PetscFunctionReturn(0);
4279 }
4280 
4281 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[])
4282 {
4283   PetscScalar    *a;
4284   PetscInt        fdof, foff, fcdof, foffset = *offset;
4285   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4286   PetscInt        cind = 0, b;
4287   PetscErrorCode  ierr;
4288 
4289   PetscFunctionBegin;
4290   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4291   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4292   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4293   a    = &array[foff];
4294   if (!fcdof || setBC) {
4295     if (clperm) {
4296       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
4297       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
4298     } else {
4299       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
4300       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
4301     }
4302   } else {
4303     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4304     if (clperm) {
4305       if (perm) {
4306         for (b = 0; b < fdof; b++) {
4307           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4308           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4309         }
4310       } else {
4311         for (b = 0; b < fdof; b++) {
4312           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4313           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4314         }
4315       }
4316     } else {
4317       if (perm) {
4318         for (b = 0; b < fdof; b++) {
4319           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4320           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4321         }
4322       } else {
4323         for (b = 0; b < fdof; b++) {
4324           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4325           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4326         }
4327       }
4328     }
4329   }
4330   *offset += fdof;
4331   PetscFunctionReturn(0);
4332 }
4333 
4334 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[])
4335 {
4336   PetscScalar    *a;
4337   PetscInt        fdof, foff, fcdof, foffset = *offset;
4338   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4339   PetscInt        cind = 0, ncind = 0, b;
4340   PetscBool       ncSet, fcSet;
4341   PetscErrorCode  ierr;
4342 
4343   PetscFunctionBegin;
4344   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4345   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4346   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4347   a    = &array[foff];
4348   if (fcdof) {
4349     /* We just override fcdof and fcdofs with Ncc and comps */
4350     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4351     if (clperm) {
4352       if (perm) {
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+perm[b]]] * (flip ? flip[perm[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+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4364               ++cind;
4365             }
4366           }
4367         }
4368       } else {
4369         if (comps) {
4370           for (b = 0; b < fdof; b++) {
4371             ncSet = fcSet = PETSC_FALSE;
4372             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4373             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4374             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}
4375           }
4376         } else {
4377           for (b = 0; b < fdof; b++) {
4378             if ((cind < fcdof) && (b == fcdofs[cind])) {
4379               fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4380               ++cind;
4381             }
4382           }
4383         }
4384       }
4385     } else {
4386       if (perm) {
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+perm[b]] * (flip ? flip[perm[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+perm[b]] * (flip ? flip[perm[b]] : 1.));
4398               ++cind;
4399             }
4400           }
4401         }
4402       } else {
4403         if (comps) {
4404           for (b = 0; b < fdof; b++) {
4405             ncSet = fcSet = PETSC_FALSE;
4406             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4407             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4408             if (ncSet && fcSet) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}
4409           }
4410         } else {
4411           for (b = 0; b < fdof; b++) {
4412             if ((cind < fcdof) && (b == fcdofs[cind])) {
4413               fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4414               ++cind;
4415             }
4416           }
4417         }
4418       }
4419     }
4420   }
4421   *offset += fdof;
4422   PetscFunctionReturn(0);
4423 }
4424 
4425 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4426 {
4427   PetscScalar    *array;
4428   const PetscInt *cone, *coneO;
4429   PetscInt        pStart, pEnd, p, numPoints, off, dof;
4430   PetscErrorCode  ierr;
4431 
4432   PetscFunctionBeginHot;
4433   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4434   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4435   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4436   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4437   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4438   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
4439     const PetscInt cp = !p ? point : cone[p-1];
4440     const PetscInt o  = !p ? 0     : coneO[p-1];
4441 
4442     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
4443     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4444     /* ADD_VALUES */
4445     {
4446       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4447       PetscScalar    *a;
4448       PetscInt        cdof, coff, cind = 0, k;
4449 
4450       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
4451       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
4452       a    = &array[coff];
4453       if (!cdof) {
4454         if (o >= 0) {
4455           for (k = 0; k < dof; ++k) {
4456             a[k] += values[off+k];
4457           }
4458         } else {
4459           for (k = 0; k < dof; ++k) {
4460             a[k] += values[off+dof-k-1];
4461           }
4462         }
4463       } else {
4464         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
4465         if (o >= 0) {
4466           for (k = 0; k < dof; ++k) {
4467             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4468             a[k] += values[off+k];
4469           }
4470         } else {
4471           for (k = 0; k < dof; ++k) {
4472             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4473             a[k] += values[off+dof-k-1];
4474           }
4475         }
4476       }
4477     }
4478   }
4479   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4480   PetscFunctionReturn(0);
4481 }
4482 
4483 /*@C
4484   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
4485 
4486   Not collective
4487 
4488   Input Parameters:
4489 + dm - The DM
4490 . section - The section describing the layout in v, or NULL to use the default section
4491 . v - The local vector
4492 . point - The point in the DM
4493 . values - The array of values
4494 - mode - The insert mode. One of INSERT_ALL_VALUES, ADD_ALL_VALUES, INSERT_VALUES, ADD_VALUES, INSERT_BC_VALUES, and ADD_BC_VALUES,
4495          where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions.
4496 
4497   Fortran Notes:
4498   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4499 
4500   Level: intermediate
4501 
4502 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
4503 @*/
4504 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4505 {
4506   PetscSection    clSection;
4507   IS              clPoints;
4508   PetscScalar    *array;
4509   PetscInt       *points = NULL;
4510   const PetscInt *clp, *clperm;
4511   PetscInt        depth, numFields, numPoints, p;
4512   PetscErrorCode  ierr;
4513 
4514   PetscFunctionBeginHot;
4515   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4516   if (!section) {ierr = DMGetSection(dm, &section);CHKERRQ(ierr);}
4517   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4518   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4519   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4520   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4521   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
4522     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
4523     PetscFunctionReturn(0);
4524   }
4525   /* Get points */
4526   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4527   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4528   /* Get array */
4529   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4530   /* Get values */
4531   if (numFields > 0) {
4532     PetscInt offset = 0, f;
4533     for (f = 0; f < numFields; ++f) {
4534       const PetscInt    **perms = NULL;
4535       const PetscScalar **flips = NULL;
4536 
4537       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4538       switch (mode) {
4539       case INSERT_VALUES:
4540         for (p = 0; p < numPoints; p++) {
4541           const PetscInt    point = points[2*p];
4542           const PetscInt    *perm = perms ? perms[p] : NULL;
4543           const PetscScalar *flip = flips ? flips[p] : NULL;
4544           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4545         } break;
4546       case INSERT_ALL_VALUES:
4547         for (p = 0; p < numPoints; p++) {
4548           const PetscInt    point = points[2*p];
4549           const PetscInt    *perm = perms ? perms[p] : NULL;
4550           const PetscScalar *flip = flips ? flips[p] : NULL;
4551           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4552         } break;
4553       case INSERT_BC_VALUES:
4554         for (p = 0; p < numPoints; p++) {
4555           const PetscInt    point = points[2*p];
4556           const PetscInt    *perm = perms ? perms[p] : NULL;
4557           const PetscScalar *flip = flips ? flips[p] : NULL;
4558           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, insert, clperm, values, &offset, array);
4559         } break;
4560       case ADD_VALUES:
4561         for (p = 0; p < numPoints; p++) {
4562           const PetscInt    point = points[2*p];
4563           const PetscInt    *perm = perms ? perms[p] : NULL;
4564           const PetscScalar *flip = flips ? flips[p] : NULL;
4565           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4566         } break;
4567       case ADD_ALL_VALUES:
4568         for (p = 0; p < numPoints; p++) {
4569           const PetscInt    point = points[2*p];
4570           const PetscInt    *perm = perms ? perms[p] : NULL;
4571           const PetscScalar *flip = flips ? flips[p] : NULL;
4572           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4573         } break;
4574       case ADD_BC_VALUES:
4575         for (p = 0; p < numPoints; p++) {
4576           const PetscInt    point = points[2*p];
4577           const PetscInt    *perm = perms ? perms[p] : NULL;
4578           const PetscScalar *flip = flips ? flips[p] : NULL;
4579           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, add, clperm, values, &offset, array);
4580         } break;
4581       default:
4582         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4583       }
4584       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4585     }
4586   } else {
4587     PetscInt dof, off;
4588     const PetscInt    **perms = NULL;
4589     const PetscScalar **flips = NULL;
4590 
4591     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4592     switch (mode) {
4593     case INSERT_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         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
4600       } break;
4601     case INSERT_ALL_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, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
4608       } break;
4609     case INSERT_BC_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         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
4616       } break;
4617     case ADD_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         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
4624       } break;
4625     case ADD_ALL_VALUES:
4626       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4627         const PetscInt    point = points[2*p];
4628         const PetscInt    *perm = perms ? perms[p] : NULL;
4629         const PetscScalar *flip = flips ? flips[p] : NULL;
4630         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4631         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
4632       } break;
4633     case ADD_BC_VALUES:
4634       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4635         const PetscInt    point = points[2*p];
4636         const PetscInt    *perm = perms ? perms[p] : NULL;
4637         const PetscScalar *flip = flips ? flips[p] : NULL;
4638         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4639         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
4640       } break;
4641     default:
4642       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4643     }
4644     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4645   }
4646   /* Cleanup points */
4647   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4648   /* Cleanup array */
4649   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4650   PetscFunctionReturn(0);
4651 }
4652 
4653 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, PetscInt Ncc, const PetscInt comps[], const PetscScalar values[], InsertMode mode)
4654 {
4655   PetscSection      clSection;
4656   IS                clPoints;
4657   PetscScalar       *array;
4658   PetscInt          *points = NULL;
4659   const PetscInt    *clp, *clperm;
4660   PetscInt          numFields, numPoints, p;
4661   PetscInt          offset = 0, f;
4662   PetscErrorCode    ierr;
4663 
4664   PetscFunctionBeginHot;
4665   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4666   if (!section) {ierr = DMGetSection(dm, &section);CHKERRQ(ierr);}
4667   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4668   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4669   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4670   /* Get points */
4671   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4672   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4673   /* Get array */
4674   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4675   /* Get values */
4676   for (f = 0; f < numFields; ++f) {
4677     const PetscInt    **perms = NULL;
4678     const PetscScalar **flips = NULL;
4679 
4680     if (!fieldActive[f]) {
4681       for (p = 0; p < numPoints*2; p += 2) {
4682         PetscInt fdof;
4683         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4684         offset += fdof;
4685       }
4686       continue;
4687     }
4688     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4689     switch (mode) {
4690     case INSERT_VALUES:
4691       for (p = 0; p < numPoints; p++) {
4692         const PetscInt    point = points[2*p];
4693         const PetscInt    *perm = perms ? perms[p] : NULL;
4694         const PetscScalar *flip = flips ? flips[p] : NULL;
4695         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4696       } break;
4697     case INSERT_ALL_VALUES:
4698       for (p = 0; p < numPoints; p++) {
4699         const PetscInt    point = points[2*p];
4700         const PetscInt    *perm = perms ? perms[p] : NULL;
4701         const PetscScalar *flip = flips ? flips[p] : NULL;
4702         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4703         } break;
4704     case INSERT_BC_VALUES:
4705       for (p = 0; p < numPoints; p++) {
4706         const PetscInt    point = points[2*p];
4707         const PetscInt    *perm = perms ? perms[p] : NULL;
4708         const PetscScalar *flip = flips ? flips[p] : NULL;
4709         updatePointFieldsBC_private(section, point, perm, flip, f, Ncc, comps, insert, clperm, values, &offset, array);
4710       } break;
4711     case ADD_VALUES:
4712       for (p = 0; p < numPoints; p++) {
4713         const PetscInt    point = points[2*p];
4714         const PetscInt    *perm = perms ? perms[p] : NULL;
4715         const PetscScalar *flip = flips ? flips[p] : NULL;
4716         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4717       } break;
4718     case ADD_ALL_VALUES:
4719       for (p = 0; p < numPoints; p++) {
4720         const PetscInt    point = points[2*p];
4721         const PetscInt    *perm = perms ? perms[p] : NULL;
4722         const PetscScalar *flip = flips ? flips[p] : NULL;
4723         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4724       } break;
4725     default:
4726       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4727     }
4728     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4729   }
4730   /* Cleanup points */
4731   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4732   /* Cleanup array */
4733   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4734   PetscFunctionReturn(0);
4735 }
4736 
4737 static PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
4738 {
4739   PetscMPIInt    rank;
4740   PetscInt       i, j;
4741   PetscErrorCode ierr;
4742 
4743   PetscFunctionBegin;
4744   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
4745   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for point %D\n", rank, point);CHKERRQ(ierr);
4746   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
4747   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
4748   numCIndices = numCIndices ? numCIndices : numRIndices;
4749   for (i = 0; i < numRIndices; i++) {
4750     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
4751     for (j = 0; j < numCIndices; j++) {
4752 #if defined(PETSC_USE_COMPLEX)
4753       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
4754 #else
4755       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
4756 #endif
4757     }
4758     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
4759   }
4760   PetscFunctionReturn(0);
4761 }
4762 
4763 /* . off - The global offset of this point */
4764 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], PetscInt indices[])
4765 {
4766   PetscInt        dof;    /* The number of unknowns on this point */
4767   PetscInt        cdof;   /* The number of constraints on this point */
4768   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4769   PetscInt        cind = 0, k;
4770   PetscErrorCode  ierr;
4771 
4772   PetscFunctionBegin;
4773   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4774   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4775   if (!cdof || setBC) {
4776     if (perm) {
4777       for (k = 0; k < dof; k++) indices[*loff+perm[k]] = off + k;
4778     } else {
4779       for (k = 0; k < dof; k++) indices[*loff+k] = off + k;
4780     }
4781   } else {
4782     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4783     if (perm) {
4784       for (k = 0; k < dof; ++k) {
4785         if ((cind < cdof) && (k == cdofs[cind])) {
4786           /* Insert check for returning constrained indices */
4787           indices[*loff+perm[k]] = -(off+k+1);
4788           ++cind;
4789         } else {
4790           indices[*loff+perm[k]] = off+k-cind;
4791         }
4792       }
4793     } else {
4794       for (k = 0; k < dof; ++k) {
4795         if ((cind < cdof) && (k == cdofs[cind])) {
4796           /* Insert check for returning constrained indices */
4797           indices[*loff+k] = -(off+k+1);
4798           ++cind;
4799         } else {
4800           indices[*loff+k] = off+k-cind;
4801         }
4802       }
4803     }
4804   }
4805   *loff += dof;
4806   PetscFunctionReturn(0);
4807 }
4808 
4809 /*
4810   This version only believes the point offset from the globalSection
4811 
4812  . off - The global offset of this point
4813 */
4814 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, PetscInt indices[])
4815 {
4816   PetscInt       numFields, foff, f;
4817   PetscErrorCode ierr;
4818 
4819   PetscFunctionBegin;
4820   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4821   for (f = 0, foff = 0; f < numFields; ++f) {
4822     PetscInt        fdof, cfdof;
4823     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4824     PetscInt        cind = 0, b;
4825     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
4826 
4827     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4828     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4829     if (!cfdof || setBC) {
4830       if (perm) {for (b = 0; b < fdof; b++) {indices[foffs[f]+perm[b]] = off+foff+b;}}
4831       else      {for (b = 0; b < fdof; b++) {indices[foffs[f]+     b ] = off+foff+b;}}
4832     } else {
4833       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4834       if (perm) {
4835         for (b = 0; b < fdof; b++) {
4836           if ((cind < cfdof) && (b == fcdofs[cind])) {
4837             indices[foffs[f]+perm[b]] = -(off+foff+b+1);
4838             ++cind;
4839           } else {
4840             indices[foffs[f]+perm[b]] = off+foff+b-cind;
4841           }
4842         }
4843       } else {
4844         for (b = 0; b < fdof; b++) {
4845           if ((cind < cfdof) && (b == fcdofs[cind])) {
4846             indices[foffs[f]+b] = -(off+foff+b+1);
4847             ++cind;
4848           } else {
4849             indices[foffs[f]+b] = off+foff+b-cind;
4850           }
4851         }
4852       }
4853     }
4854     foff     += (setBC ? fdof : (fdof - cfdof));
4855     foffs[f] += fdof;
4856   }
4857   PetscFunctionReturn(0);
4858 }
4859 
4860 /*
4861   This version believes the globalSection offsets for each field, rather than just the point offset
4862 
4863  . foffs - The offset into 'indices' for each field, since it is segregated by field
4864 */
4865 PetscErrorCode DMPlexGetIndicesPointFieldsSplit_Internal(PetscSection section, PetscSection globalSection, PetscInt point, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, PetscInt indices[])
4866 {
4867   PetscInt       numFields, foff, f;
4868   PetscErrorCode ierr;
4869 
4870   PetscFunctionBegin;
4871   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4872   for (f = 0; f < numFields; ++f) {
4873     PetscInt        fdof, cfdof;
4874     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4875     PetscInt        cind = 0, b;
4876     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
4877 
4878     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4879     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4880     ierr = PetscSectionGetFieldOffset(globalSection, point, f, &foff);CHKERRQ(ierr);
4881     if (!cfdof || setBC) {
4882       if (perm) {for (b = 0; b < fdof; b++) {indices[foffs[f]+perm[b]] = foff+b;}}
4883       else      {for (b = 0; b < fdof; b++) {indices[foffs[f]+     b ] = foff+b;}}
4884     } else {
4885       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4886       if (perm) {
4887         for (b = 0; b < fdof; b++) {
4888           if ((cind < cfdof) && (b == fcdofs[cind])) {
4889             indices[foffs[f]+perm[b]] = -(foff+b+1);
4890             ++cind;
4891           } else {
4892             indices[foffs[f]+perm[b]] = foff+b-cind;
4893           }
4894         }
4895       } else {
4896         for (b = 0; b < fdof; b++) {
4897           if ((cind < cfdof) && (b == fcdofs[cind])) {
4898             indices[foffs[f]+b] = -(foff+b+1);
4899             ++cind;
4900           } else {
4901             indices[foffs[f]+b] = foff+b-cind;
4902           }
4903         }
4904       }
4905     }
4906     foffs[f] += fdof;
4907   }
4908   PetscFunctionReturn(0);
4909 }
4910 
4911 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)
4912 {
4913   Mat             cMat;
4914   PetscSection    aSec, cSec;
4915   IS              aIS;
4916   PetscInt        aStart = -1, aEnd = -1;
4917   const PetscInt  *anchors;
4918   PetscInt        numFields, f, p, q, newP = 0;
4919   PetscInt        newNumPoints = 0, newNumIndices = 0;
4920   PetscInt        *newPoints, *indices, *newIndices;
4921   PetscInt        maxAnchor, maxDof;
4922   PetscInt        newOffsets[32];
4923   PetscInt        *pointMatOffsets[32];
4924   PetscInt        *newPointOffsets[32];
4925   PetscScalar     *pointMat[32];
4926   PetscScalar     *newValues=NULL,*tmpValues;
4927   PetscBool       anyConstrained = PETSC_FALSE;
4928   PetscErrorCode  ierr;
4929 
4930   PetscFunctionBegin;
4931   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4932   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4933   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4934 
4935   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4936   /* if there are point-to-point constraints */
4937   if (aSec) {
4938     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4939     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4940     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4941     /* figure out how many points are going to be in the new element matrix
4942      * (we allow double counting, because it's all just going to be summed
4943      * into the global matrix anyway) */
4944     for (p = 0; p < 2*numPoints; p+=2) {
4945       PetscInt b    = points[p];
4946       PetscInt bDof = 0, bSecDof;
4947 
4948       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4949       if (!bSecDof) {
4950         continue;
4951       }
4952       if (b >= aStart && b < aEnd) {
4953         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4954       }
4955       if (bDof) {
4956         /* this point is constrained */
4957         /* it is going to be replaced by its anchors */
4958         PetscInt bOff, q;
4959 
4960         anyConstrained = PETSC_TRUE;
4961         newNumPoints  += bDof;
4962         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4963         for (q = 0; q < bDof; q++) {
4964           PetscInt a = anchors[bOff + q];
4965           PetscInt aDof;
4966 
4967           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4968           newNumIndices += aDof;
4969           for (f = 0; f < numFields; ++f) {
4970             PetscInt fDof;
4971 
4972             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4973             newOffsets[f+1] += fDof;
4974           }
4975         }
4976       }
4977       else {
4978         /* this point is not constrained */
4979         newNumPoints++;
4980         newNumIndices += bSecDof;
4981         for (f = 0; f < numFields; ++f) {
4982           PetscInt fDof;
4983 
4984           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4985           newOffsets[f+1] += fDof;
4986         }
4987       }
4988     }
4989   }
4990   if (!anyConstrained) {
4991     if (outNumPoints)  *outNumPoints  = 0;
4992     if (outNumIndices) *outNumIndices = 0;
4993     if (outPoints)     *outPoints     = NULL;
4994     if (outValues)     *outValues     = NULL;
4995     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4996     PetscFunctionReturn(0);
4997   }
4998 
4999   if (outNumPoints)  *outNumPoints  = newNumPoints;
5000   if (outNumIndices) *outNumIndices = newNumIndices;
5001 
5002   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
5003 
5004   if (!outPoints && !outValues) {
5005     if (offsets) {
5006       for (f = 0; f <= numFields; f++) {
5007         offsets[f] = newOffsets[f];
5008       }
5009     }
5010     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
5011     PetscFunctionReturn(0);
5012   }
5013 
5014   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
5015 
5016   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
5017 
5018   /* workspaces */
5019   if (numFields) {
5020     for (f = 0; f < numFields; f++) {
5021       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5022       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5023     }
5024   }
5025   else {
5026     ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5027     ierr = DMGetWorkArray(dm,numPoints,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5028   }
5029 
5030   /* get workspaces for the point-to-point matrices */
5031   if (numFields) {
5032     PetscInt totalOffset, totalMatOffset;
5033 
5034     for (p = 0; p < numPoints; p++) {
5035       PetscInt b    = points[2*p];
5036       PetscInt bDof = 0, bSecDof;
5037 
5038       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5039       if (!bSecDof) {
5040         for (f = 0; f < numFields; f++) {
5041           newPointOffsets[f][p + 1] = 0;
5042           pointMatOffsets[f][p + 1] = 0;
5043         }
5044         continue;
5045       }
5046       if (b >= aStart && b < aEnd) {
5047         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5048       }
5049       if (bDof) {
5050         for (f = 0; f < numFields; f++) {
5051           PetscInt fDof, q, bOff, allFDof = 0;
5052 
5053           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5054           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5055           for (q = 0; q < bDof; q++) {
5056             PetscInt a = anchors[bOff + q];
5057             PetscInt aFDof;
5058 
5059             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
5060             allFDof += aFDof;
5061           }
5062           newPointOffsets[f][p+1] = allFDof;
5063           pointMatOffsets[f][p+1] = fDof * allFDof;
5064         }
5065       }
5066       else {
5067         for (f = 0; f < numFields; f++) {
5068           PetscInt fDof;
5069 
5070           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5071           newPointOffsets[f][p+1] = fDof;
5072           pointMatOffsets[f][p+1] = 0;
5073         }
5074       }
5075     }
5076     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
5077       newPointOffsets[f][0] = totalOffset;
5078       pointMatOffsets[f][0] = totalMatOffset;
5079       for (p = 0; p < numPoints; p++) {
5080         newPointOffsets[f][p+1] += newPointOffsets[f][p];
5081         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
5082       }
5083       totalOffset    = newPointOffsets[f][numPoints];
5084       totalMatOffset = pointMatOffsets[f][numPoints];
5085       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5086     }
5087   }
5088   else {
5089     for (p = 0; p < numPoints; p++) {
5090       PetscInt b    = points[2*p];
5091       PetscInt bDof = 0, bSecDof;
5092 
5093       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5094       if (!bSecDof) {
5095         newPointOffsets[0][p + 1] = 0;
5096         pointMatOffsets[0][p + 1] = 0;
5097         continue;
5098       }
5099       if (b >= aStart && b < aEnd) {
5100         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5101       }
5102       if (bDof) {
5103         PetscInt bOff, q, allDof = 0;
5104 
5105         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5106         for (q = 0; q < bDof; q++) {
5107           PetscInt a = anchors[bOff + q], aDof;
5108 
5109           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5110           allDof += aDof;
5111         }
5112         newPointOffsets[0][p+1] = allDof;
5113         pointMatOffsets[0][p+1] = bSecDof * allDof;
5114       }
5115       else {
5116         newPointOffsets[0][p+1] = bSecDof;
5117         pointMatOffsets[0][p+1] = 0;
5118       }
5119     }
5120     newPointOffsets[0][0] = 0;
5121     pointMatOffsets[0][0] = 0;
5122     for (p = 0; p < numPoints; p++) {
5123       newPointOffsets[0][p+1] += newPointOffsets[0][p];
5124       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
5125     }
5126     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5127   }
5128 
5129   /* output arrays */
5130   ierr = DMGetWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5131 
5132   /* get the point-to-point matrices; construct newPoints */
5133   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
5134   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
5135   ierr = DMGetWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5136   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5137   if (numFields) {
5138     for (p = 0, newP = 0; p < numPoints; p++) {
5139       PetscInt b    = points[2*p];
5140       PetscInt o    = points[2*p+1];
5141       PetscInt bDof = 0, bSecDof;
5142 
5143       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5144       if (!bSecDof) {
5145         continue;
5146       }
5147       if (b >= aStart && b < aEnd) {
5148         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5149       }
5150       if (bDof) {
5151         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
5152 
5153         fStart[0] = 0;
5154         fEnd[0]   = 0;
5155         for (f = 0; f < numFields; f++) {
5156           PetscInt fDof;
5157 
5158           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
5159           fStart[f+1] = fStart[f] + fDof;
5160           fEnd[f+1]   = fStart[f+1];
5161         }
5162         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5163         ierr = DMPlexGetIndicesPointFields_Internal(cSec, b, bOff, fEnd, PETSC_TRUE, perms, p, indices);CHKERRQ(ierr);
5164 
5165         fAnchorStart[0] = 0;
5166         fAnchorEnd[0]   = 0;
5167         for (f = 0; f < numFields; f++) {
5168           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
5169 
5170           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
5171           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
5172         }
5173         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5174         for (q = 0; q < bDof; q++) {
5175           PetscInt a = anchors[bOff + q], aOff;
5176 
5177           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5178           newPoints[2*(newP + q)]     = a;
5179           newPoints[2*(newP + q) + 1] = 0;
5180           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5181           ierr = DMPlexGetIndicesPointFields_Internal(section, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, newIndices);CHKERRQ(ierr);
5182         }
5183         newP += bDof;
5184 
5185         if (outValues) {
5186           /* get the point-to-point submatrix */
5187           for (f = 0; f < numFields; f++) {
5188             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
5189           }
5190         }
5191       }
5192       else {
5193         newPoints[2 * newP]     = b;
5194         newPoints[2 * newP + 1] = o;
5195         newP++;
5196       }
5197     }
5198   } else {
5199     for (p = 0; p < numPoints; p++) {
5200       PetscInt b    = points[2*p];
5201       PetscInt o    = points[2*p+1];
5202       PetscInt bDof = 0, bSecDof;
5203 
5204       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5205       if (!bSecDof) {
5206         continue;
5207       }
5208       if (b >= aStart && b < aEnd) {
5209         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5210       }
5211       if (bDof) {
5212         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
5213 
5214         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5215         ierr = DMPlexGetIndicesPoint_Internal(cSec, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, indices);CHKERRQ(ierr);
5216 
5217         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
5218         for (q = 0; q < bDof; q++) {
5219           PetscInt a = anchors[bOff + q], aOff;
5220 
5221           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5222 
5223           newPoints[2*(newP + q)]     = a;
5224           newPoints[2*(newP + q) + 1] = 0;
5225           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5226           ierr = DMPlexGetIndicesPoint_Internal(section, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, newIndices);CHKERRQ(ierr);
5227         }
5228         newP += bDof;
5229 
5230         /* get the point-to-point submatrix */
5231         if (outValues) {
5232           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
5233         }
5234       }
5235       else {
5236         newPoints[2 * newP]     = b;
5237         newPoints[2 * newP + 1] = o;
5238         newP++;
5239       }
5240     }
5241   }
5242 
5243   if (outValues) {
5244     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5245     ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
5246     /* multiply constraints on the right */
5247     if (numFields) {
5248       for (f = 0; f < numFields; f++) {
5249         PetscInt oldOff = offsets[f];
5250 
5251         for (p = 0; p < numPoints; p++) {
5252           PetscInt cStart = newPointOffsets[f][p];
5253           PetscInt b      = points[2 * p];
5254           PetscInt c, r, k;
5255           PetscInt dof;
5256 
5257           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5258           if (!dof) {
5259             continue;
5260           }
5261           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5262             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
5263             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
5264 
5265             for (r = 0; r < numIndices; r++) {
5266               for (c = 0; c < nCols; c++) {
5267                 for (k = 0; k < dof; k++) {
5268                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
5269                 }
5270               }
5271             }
5272           }
5273           else {
5274             /* copy this column as is */
5275             for (r = 0; r < numIndices; r++) {
5276               for (c = 0; c < dof; c++) {
5277                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5278               }
5279             }
5280           }
5281           oldOff += dof;
5282         }
5283       }
5284     }
5285     else {
5286       PetscInt oldOff = 0;
5287       for (p = 0; p < numPoints; p++) {
5288         PetscInt cStart = newPointOffsets[0][p];
5289         PetscInt b      = points[2 * p];
5290         PetscInt c, r, k;
5291         PetscInt dof;
5292 
5293         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5294         if (!dof) {
5295           continue;
5296         }
5297         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5298           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
5299           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
5300 
5301           for (r = 0; r < numIndices; r++) {
5302             for (c = 0; c < nCols; c++) {
5303               for (k = 0; k < dof; k++) {
5304                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
5305               }
5306             }
5307           }
5308         }
5309         else {
5310           /* copy this column as is */
5311           for (r = 0; r < numIndices; r++) {
5312             for (c = 0; c < dof; c++) {
5313               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5314             }
5315           }
5316         }
5317         oldOff += dof;
5318       }
5319     }
5320 
5321     if (multiplyLeft) {
5322       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5323       ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
5324       /* multiply constraints transpose on the left */
5325       if (numFields) {
5326         for (f = 0; f < numFields; f++) {
5327           PetscInt oldOff = offsets[f];
5328 
5329           for (p = 0; p < numPoints; p++) {
5330             PetscInt rStart = newPointOffsets[f][p];
5331             PetscInt b      = points[2 * p];
5332             PetscInt c, r, k;
5333             PetscInt dof;
5334 
5335             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5336             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5337               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
5338               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
5339 
5340               for (r = 0; r < nRows; r++) {
5341                 for (c = 0; c < newNumIndices; c++) {
5342                   for (k = 0; k < dof; k++) {
5343                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5344                   }
5345                 }
5346               }
5347             }
5348             else {
5349               /* copy this row as is */
5350               for (r = 0; r < dof; r++) {
5351                 for (c = 0; c < newNumIndices; c++) {
5352                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5353                 }
5354               }
5355             }
5356             oldOff += dof;
5357           }
5358         }
5359       }
5360       else {
5361         PetscInt oldOff = 0;
5362 
5363         for (p = 0; p < numPoints; p++) {
5364           PetscInt rStart = newPointOffsets[0][p];
5365           PetscInt b      = points[2 * p];
5366           PetscInt c, r, k;
5367           PetscInt dof;
5368 
5369           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5370           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5371             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
5372             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
5373 
5374             for (r = 0; r < nRows; r++) {
5375               for (c = 0; c < newNumIndices; c++) {
5376                 for (k = 0; k < dof; k++) {
5377                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5378                 }
5379               }
5380             }
5381           }
5382           else {
5383             /* copy this row as is */
5384             for (r = 0; r < dof; r++) {
5385               for (c = 0; c < newNumIndices; c++) {
5386                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5387               }
5388             }
5389           }
5390           oldOff += dof;
5391         }
5392       }
5393 
5394       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5395     }
5396     else {
5397       newValues = tmpValues;
5398     }
5399   }
5400 
5401   /* clean up */
5402   ierr = DMRestoreWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5403   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5404 
5405   if (numFields) {
5406     for (f = 0; f < numFields; f++) {
5407       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5408       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5409       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5410     }
5411   }
5412   else {
5413     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5414     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5415     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5416   }
5417   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5418 
5419   /* output */
5420   if (outPoints) {
5421     *outPoints = newPoints;
5422   }
5423   else {
5424     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5425   }
5426   if (outValues) {
5427     *outValues = newValues;
5428   }
5429   for (f = 0; f <= numFields; f++) {
5430     offsets[f] = newOffsets[f];
5431   }
5432   PetscFunctionReturn(0);
5433 }
5434 
5435 /*@C
5436   DMPlexGetClosureIndices - Get the global indices in a vector v for all points in the closure of the given point
5437 
5438   Not collective
5439 
5440   Input Parameters:
5441 + dm - The DM
5442 . section - The section describing the layout in v, or NULL to use the default section
5443 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5444 - point - The mesh point
5445 
5446   Output parameters:
5447 + numIndices - The number of indices
5448 . indices - The indices
5449 - outOffsets - Field offset if not NULL
5450 
5451   Note: Must call DMPlexRestoreClosureIndices() to free allocated memory
5452 
5453   Level: advanced
5454 
5455 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5456 @*/
5457 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices, PetscInt *outOffsets)
5458 {
5459   PetscSection    clSection;
5460   IS              clPoints;
5461   const PetscInt *clp;
5462   const PetscInt  **perms[32] = {NULL};
5463   PetscInt       *points = NULL, *pointsNew;
5464   PetscInt        numPoints, numPointsNew;
5465   PetscInt        offsets[32];
5466   PetscInt        Nf, Nind, NindNew, off, globalOff, f, p;
5467   PetscErrorCode  ierr;
5468 
5469   PetscFunctionBegin;
5470   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5471   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5472   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5473   if (numIndices) PetscValidPointer(numIndices, 4);
5474   PetscValidPointer(indices, 5);
5475   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
5476   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
5477   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5478   /* Get points in closure */
5479   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5480   /* Get number of indices and indices per field */
5481   for (p = 0, Nind = 0; p < numPoints*2; p += 2) {
5482     PetscInt dof, fdof;
5483 
5484     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5485     for (f = 0; f < Nf; ++f) {
5486       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5487       offsets[f+1] += fdof;
5488     }
5489     Nind += dof;
5490   }
5491   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
5492   if (Nf && offsets[Nf] != Nind) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Nind);
5493   if (!Nf) offsets[1] = Nind;
5494   /* Get dual space symmetries */
5495   for (f = 0; f < PetscMax(1,Nf); f++) {
5496     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5497     else    {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5498   }
5499   /* Correct for hanging node constraints */
5500   {
5501     ierr = DMPlexAnchorsModifyMat(dm, section, numPoints, Nind, points, perms, NULL, &numPointsNew, &NindNew, &pointsNew, NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
5502     if (numPointsNew) {
5503       for (f = 0; f < PetscMax(1,Nf); f++) {
5504         if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5505         else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5506       }
5507       for (f = 0; f < PetscMax(1,Nf); f++) {
5508         if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5509         else    {ierr = PetscSectionGetPointSyms(section,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5510       }
5511       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5512       numPoints = numPointsNew;
5513       Nind      = NindNew;
5514       points    = pointsNew;
5515     }
5516   }
5517   /* Calculate indices */
5518   ierr = DMGetWorkArray(dm, Nind, MPIU_INT, indices);CHKERRQ(ierr);
5519   if (Nf) {
5520     if (outOffsets) {
5521       PetscInt f;
5522 
5523       for (f = 0; f <= Nf; f++) {
5524         outOffsets[f] = offsets[f];
5525       }
5526     }
5527     for (p = 0; p < numPoints; p++) {
5528       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5529       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, *indices);
5530     }
5531   } else {
5532     for (p = 0, off = 0; p < numPoints; p++) {
5533       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5534 
5535       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5536       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, *indices);
5537     }
5538   }
5539   /* Cleanup points */
5540   for (f = 0; f < PetscMax(1,Nf); f++) {
5541     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5542     else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5543   }
5544   if (numPointsNew) {
5545     ierr = DMRestoreWorkArray(dm, 2*numPointsNew, MPIU_INT, &pointsNew);CHKERRQ(ierr);
5546   } else {
5547     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5548   }
5549   if (numIndices) *numIndices = Nind;
5550   PetscFunctionReturn(0);
5551 }
5552 
5553 /*@C
5554   DMPlexRestoreClosureIndices - Restore the indices in a vector v for all points in the closure of the given point
5555 
5556   Not collective
5557 
5558   Input Parameters:
5559 + dm - The DM
5560 . section - The section describing the layout in v, or NULL to use the default section
5561 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5562 . point - The mesh point
5563 . numIndices - The number of indices
5564 . indices - The indices
5565 - outOffsets - Field offset if not NULL
5566 
5567   Level: advanced
5568 
5569 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5570 @*/
5571 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices,PetscInt *outOffsets)
5572 {
5573   PetscErrorCode ierr;
5574 
5575   PetscFunctionBegin;
5576   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5577   PetscValidPointer(indices, 5);
5578   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
5579   PetscFunctionReturn(0);
5580 }
5581 
5582 /*@C
5583   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5584 
5585   Not collective
5586 
5587   Input Parameters:
5588 + dm - The DM
5589 . section - The section describing the layout in v, or NULL to use the default section
5590 . globalSection - The section describing the layout in v, or NULL to use the default global section
5591 . A - The matrix
5592 . point - The point in the DM
5593 . values - The array of values
5594 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5595 
5596   Fortran Notes:
5597   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5598 
5599   Level: intermediate
5600 
5601 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5602 @*/
5603 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5604 {
5605   DM_Plex            *mesh   = (DM_Plex*) dm->data;
5606   PetscSection        clSection;
5607   IS                  clPoints;
5608   PetscInt           *points = NULL, *newPoints;
5609   const PetscInt     *clp;
5610   PetscInt           *indices;
5611   PetscInt            offsets[32];
5612   const PetscInt    **perms[32] = {NULL};
5613   const PetscScalar **flips[32] = {NULL};
5614   PetscInt            numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, p, f;
5615   PetscScalar        *valCopy = NULL;
5616   PetscScalar        *newValues;
5617   PetscErrorCode      ierr;
5618 
5619   PetscFunctionBegin;
5620   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5621   if (!section) {ierr = DMGetSection(dm, &section);CHKERRQ(ierr);}
5622   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5623   if (!globalSection) {ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5624   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5625   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5626   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5627   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5628   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5629   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5630   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5631     PetscInt fdof;
5632 
5633     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5634     for (f = 0; f < numFields; ++f) {
5635       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5636       offsets[f+1] += fdof;
5637     }
5638     numIndices += dof;
5639   }
5640   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5641 
5642   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[numFields], numIndices);
5643   /* Get symmetries */
5644   for (f = 0; f < PetscMax(1,numFields); f++) {
5645     if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5646     else           {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5647     if (values && flips[f]) { /* may need to apply sign changes to the element matrix */
5648       PetscInt foffset = offsets[f];
5649 
5650       for (p = 0; p < numPoints; p++) {
5651         PetscInt point          = points[2*p], fdof;
5652         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
5653 
5654         if (!numFields) {
5655           ierr = PetscSectionGetDof(section,point,&fdof);CHKERRQ(ierr);
5656         } else {
5657           ierr = PetscSectionGetFieldDof(section,point,f,&fdof);CHKERRQ(ierr);
5658         }
5659         if (flip) {
5660           PetscInt i, j, k;
5661 
5662           if (!valCopy) {
5663             ierr = DMGetWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5664             for (j = 0; j < numIndices * numIndices; j++) valCopy[j] = values[j];
5665             values = valCopy;
5666           }
5667           for (i = 0; i < fdof; i++) {
5668             PetscScalar fval = flip[i];
5669 
5670             for (k = 0; k < numIndices; k++) {
5671               valCopy[numIndices * (foffset + i) + k] *= fval;
5672               valCopy[numIndices * k + (foffset + i)] *= fval;
5673             }
5674           }
5675         }
5676         foffset += fdof;
5677       }
5678     }
5679   }
5680   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,perms,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets,PETSC_TRUE);CHKERRQ(ierr);
5681   if (newNumPoints) {
5682     if (valCopy) {
5683       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5684     }
5685     for (f = 0; f < PetscMax(1,numFields); f++) {
5686       if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5687       else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5688     }
5689     for (f = 0; f < PetscMax(1,numFields); f++) {
5690       if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5691       else           {ierr = PetscSectionGetPointSyms(section,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5692     }
5693     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5694     numPoints  = newNumPoints;
5695     numIndices = newNumIndices;
5696     points     = newPoints;
5697     values     = newValues;
5698   }
5699   ierr = DMGetWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5700   if (numFields) {
5701     PetscBool useFieldOffsets;
5702 
5703     ierr = PetscSectionGetUseFieldOffsets(globalSection, &useFieldOffsets);CHKERRQ(ierr);
5704     if (useFieldOffsets) {
5705       for (p = 0; p < numPoints; p++) {
5706         DMPlexGetIndicesPointFieldsSplit_Internal(section, globalSection, points[2*p], offsets, PETSC_FALSE, perms, p, indices);
5707       }
5708     } else {
5709       for (p = 0; p < numPoints; p++) {
5710         ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5711         DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, indices);
5712       }
5713     }
5714   } else {
5715     for (p = 0, off = 0; p < numPoints; p++) {
5716       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5717       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5718       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, indices);
5719     }
5720   }
5721   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5722   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5723   if (mesh->printFEM > 1) {
5724     PetscInt i;
5725     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
5726     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
5727     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5728   }
5729   if (ierr) {
5730     PetscMPIInt    rank;
5731     PetscErrorCode ierr2;
5732 
5733     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5734     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5735     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5736     ierr2 = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr2);
5737     CHKERRQ(ierr);
5738   }
5739   for (f = 0; f < PetscMax(1,numFields); f++) {
5740     if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5741     else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5742   }
5743   if (newNumPoints) {
5744     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5745     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5746   }
5747   else {
5748     if (valCopy) {
5749       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5750     }
5751     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5752   }
5753   ierr = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5754   PetscFunctionReturn(0);
5755 }
5756 
5757 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5758 {
5759   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5760   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5761   PetscInt       *cpoints = NULL;
5762   PetscInt       *findices, *cindices;
5763   PetscInt        foffsets[32], coffsets[32];
5764   CellRefiner     cellRefiner;
5765   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5766   PetscErrorCode  ierr;
5767 
5768   PetscFunctionBegin;
5769   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5770   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5771   if (!fsection) {ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);}
5772   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5773   if (!csection) {ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);}
5774   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5775   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5776   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5777   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5778   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5779   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5780   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5781   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5782   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5783   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5784   /* Column indices */
5785   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5786   maxFPoints = numCPoints;
5787   /* Compress out points not in the section */
5788   /*   TODO: Squeeze out points with 0 dof as well */
5789   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5790   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5791     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5792       cpoints[q*2]   = cpoints[p];
5793       cpoints[q*2+1] = cpoints[p+1];
5794       ++q;
5795     }
5796   }
5797   numCPoints = q;
5798   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5799     PetscInt fdof;
5800 
5801     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5802     if (!dof) continue;
5803     for (f = 0; f < numFields; ++f) {
5804       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5805       coffsets[f+1] += fdof;
5806     }
5807     numCIndices += dof;
5808   }
5809   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5810   /* Row indices */
5811   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5812   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5813   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5814   for (r = 0, q = 0; r < numSubcells; ++r) {
5815     /* TODO Map from coarse to fine cells */
5816     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5817     /* Compress out points not in the section */
5818     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5819     for (p = 0; p < numFPoints*2; p += 2) {
5820       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5821         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5822         if (!dof) continue;
5823         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5824         if (s < q) continue;
5825         ftotpoints[q*2]   = fpoints[p];
5826         ftotpoints[q*2+1] = fpoints[p+1];
5827         ++q;
5828       }
5829     }
5830     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5831   }
5832   numFPoints = q;
5833   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5834     PetscInt fdof;
5835 
5836     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5837     if (!dof) continue;
5838     for (f = 0; f < numFields; ++f) {
5839       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5840       foffsets[f+1] += fdof;
5841     }
5842     numFIndices += dof;
5843   }
5844   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5845 
5846   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5847   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5848   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5849   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5850   if (numFields) {
5851     const PetscInt **permsF[32] = {NULL};
5852     const PetscInt **permsC[32] = {NULL};
5853 
5854     for (f = 0; f < numFields; f++) {
5855       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5856       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5857     }
5858     for (p = 0; p < numFPoints; p++) {
5859       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5860       ierr = DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);CHKERRQ(ierr);
5861     }
5862     for (p = 0; p < numCPoints; p++) {
5863       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5864       ierr = DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);CHKERRQ(ierr);
5865     }
5866     for (f = 0; f < numFields; f++) {
5867       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5868       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5869     }
5870   } else {
5871     const PetscInt **permsF = NULL;
5872     const PetscInt **permsC = NULL;
5873 
5874     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5875     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5876     for (p = 0, off = 0; p < numFPoints; p++) {
5877       const PetscInt *perm = permsF ? permsF[p] : NULL;
5878 
5879       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5880       ierr = DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);CHKERRQ(ierr);
5881     }
5882     for (p = 0, off = 0; p < numCPoints; p++) {
5883       const PetscInt *perm = permsC ? permsC[p] : NULL;
5884 
5885       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5886       ierr = DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);CHKERRQ(ierr);
5887     }
5888     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5889     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5890   }
5891   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5892   /* TODO: flips */
5893   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5894   if (ierr) {
5895     PetscMPIInt    rank;
5896     PetscErrorCode ierr2;
5897 
5898     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5899     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5900     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5901     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
5902     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
5903     CHKERRQ(ierr);
5904   }
5905   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5906   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5907   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5908   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5909   PetscFunctionReturn(0);
5910 }
5911 
5912 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
5913 {
5914   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
5915   PetscInt      *cpoints = NULL;
5916   PetscInt       foffsets[32], coffsets[32];
5917   CellRefiner    cellRefiner;
5918   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5919   PetscErrorCode ierr;
5920 
5921   PetscFunctionBegin;
5922   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5923   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5924   if (!fsection) {ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr);}
5925   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5926   if (!csection) {ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr);}
5927   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5928   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5929   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5930   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5931   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5932   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5933   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5934   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5935   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5936   /* Column indices */
5937   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5938   maxFPoints = numCPoints;
5939   /* Compress out points not in the section */
5940   /*   TODO: Squeeze out points with 0 dof as well */
5941   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5942   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5943     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5944       cpoints[q*2]   = cpoints[p];
5945       cpoints[q*2+1] = cpoints[p+1];
5946       ++q;
5947     }
5948   }
5949   numCPoints = q;
5950   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5951     PetscInt fdof;
5952 
5953     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5954     if (!dof) continue;
5955     for (f = 0; f < numFields; ++f) {
5956       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5957       coffsets[f+1] += fdof;
5958     }
5959     numCIndices += dof;
5960   }
5961   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5962   /* Row indices */
5963   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5964   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5965   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5966   for (r = 0, q = 0; r < numSubcells; ++r) {
5967     /* TODO Map from coarse to fine cells */
5968     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5969     /* Compress out points not in the section */
5970     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5971     for (p = 0; p < numFPoints*2; p += 2) {
5972       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5973         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5974         if (!dof) continue;
5975         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5976         if (s < q) continue;
5977         ftotpoints[q*2]   = fpoints[p];
5978         ftotpoints[q*2+1] = fpoints[p+1];
5979         ++q;
5980       }
5981     }
5982     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5983   }
5984   numFPoints = q;
5985   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5986     PetscInt fdof;
5987 
5988     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5989     if (!dof) continue;
5990     for (f = 0; f < numFields; ++f) {
5991       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5992       foffsets[f+1] += fdof;
5993     }
5994     numFIndices += dof;
5995   }
5996   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5997 
5998   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5999   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6000   if (numFields) {
6001     const PetscInt **permsF[32] = {NULL};
6002     const PetscInt **permsC[32] = {NULL};
6003 
6004     for (f = 0; f < numFields; f++) {
6005       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6006       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6007     }
6008     for (p = 0; p < numFPoints; p++) {
6009       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6010       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
6011     }
6012     for (p = 0; p < numCPoints; p++) {
6013       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6014       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
6015     }
6016     for (f = 0; f < numFields; f++) {
6017       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6018       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6019     }
6020   } else {
6021     const PetscInt **permsF = NULL;
6022     const PetscInt **permsC = NULL;
6023 
6024     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6025     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6026     for (p = 0, off = 0; p < numFPoints; p++) {
6027       const PetscInt *perm = permsF ? permsF[p] : NULL;
6028 
6029       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6030       DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);
6031     }
6032     for (p = 0, off = 0; p < numCPoints; p++) {
6033       const PetscInt *perm = permsC ? permsC[p] : NULL;
6034 
6035       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6036       DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);
6037     }
6038     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6039     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6040   }
6041   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6042   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6043   PetscFunctionReturn(0);
6044 }
6045 
6046 /*@
6047   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
6048 
6049   Input Parameter:
6050 . dm - The DMPlex object
6051 
6052   Output Parameters:
6053 + cMax - The first hybrid cell
6054 . fMax - The first hybrid face
6055 . eMax - The first hybrid edge
6056 - vMax - The first hybrid vertex
6057 
6058   Level: developer
6059 
6060 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
6061 @*/
6062 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
6063 {
6064   DM_Plex       *mesh = (DM_Plex*) dm->data;
6065   PetscInt       dim;
6066   PetscErrorCode ierr;
6067 
6068   PetscFunctionBegin;
6069   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6070   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6071   if (dim < 0) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "DM dimension not yet set");
6072   if (cMax) *cMax = mesh->hybridPointMax[dim];
6073   if (fMax) *fMax = mesh->hybridPointMax[PetscMax(dim-1,0)];
6074   if (eMax) *eMax = mesh->hybridPointMax[1];
6075   if (vMax) *vMax = mesh->hybridPointMax[0];
6076   PetscFunctionReturn(0);
6077 }
6078 
6079 static PetscErrorCode DMPlexCreateDimStratum(DM dm, DMLabel depthLabel, DMLabel dimLabel, PetscInt d, PetscInt dMax)
6080 {
6081   IS             is, his;
6082   PetscInt       first = 0, stride;
6083   PetscBool      isStride;
6084   PetscErrorCode ierr;
6085 
6086   PetscFunctionBegin;
6087   ierr = DMLabelGetStratumIS(depthLabel, d, &is);CHKERRQ(ierr);
6088   ierr = PetscObjectTypeCompare((PetscObject) is, ISSTRIDE, &isStride);CHKERRQ(ierr);
6089   if (isStride) {
6090     ierr = ISStrideGetInfo(is, &first, &stride);CHKERRQ(ierr);
6091   }
6092   if (is && (!isStride || stride != 1)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "DM is not stratified: depth %D IS is not contiguous", d);
6093   ierr = ISCreateStride(PETSC_COMM_SELF, (dMax - first), first, 1, &his);CHKERRQ(ierr);
6094   ierr = DMLabelSetStratumIS(dimLabel, d, his);CHKERRQ(ierr);
6095   ierr = ISDestroy(&his);CHKERRQ(ierr);
6096   ierr = ISDestroy(&is);CHKERRQ(ierr);
6097   PetscFunctionReturn(0);
6098 }
6099 
6100 /*@
6101   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
6102 
6103   Input Parameters:
6104 . dm   - The DMPlex object
6105 . cMax - The first hybrid cell
6106 . fMax - The first hybrid face
6107 . eMax - The first hybrid edge
6108 - vMax - The first hybrid vertex
6109 
6110   Level: developer
6111 
6112 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
6113 @*/
6114 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6115 {
6116   DM_Plex       *mesh = (DM_Plex*) dm->data;
6117   PetscInt       dim;
6118   PetscErrorCode ierr;
6119 
6120   PetscFunctionBegin;
6121   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6122   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6123   if (dim < 0) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "DM dimension not yet set");
6124   if (cMax >= 0) mesh->hybridPointMax[dim]               = cMax;
6125   if (fMax >= 0) mesh->hybridPointMax[PetscMax(dim-1,0)] = fMax;
6126   if (eMax >= 0) mesh->hybridPointMax[1]                 = eMax;
6127   if (vMax >= 0) mesh->hybridPointMax[0]                 = vMax;
6128   PetscFunctionReturn(0);
6129 }
6130 
6131 /*@C
6132   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6133 
6134   Input Parameter:
6135 . dm   - The DMPlex object
6136 
6137   Output Parameter:
6138 . cellHeight - The height of a cell
6139 
6140   Level: developer
6141 
6142 .seealso DMPlexSetVTKCellHeight()
6143 @*/
6144 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6145 {
6146   DM_Plex *mesh = (DM_Plex*) dm->data;
6147 
6148   PetscFunctionBegin;
6149   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6150   PetscValidPointer(cellHeight, 2);
6151   *cellHeight = mesh->vtkCellHeight;
6152   PetscFunctionReturn(0);
6153 }
6154 
6155 /*@C
6156   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
6157 
6158   Input Parameters:
6159 + dm   - The DMPlex object
6160 - cellHeight - The height of a cell
6161 
6162   Level: developer
6163 
6164 .seealso DMPlexGetVTKCellHeight()
6165 @*/
6166 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6167 {
6168   DM_Plex *mesh = (DM_Plex*) dm->data;
6169 
6170   PetscFunctionBegin;
6171   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6172   mesh->vtkCellHeight = cellHeight;
6173   PetscFunctionReturn(0);
6174 }
6175 
6176 /* We can easily have a form that takes an IS instead */
6177 PetscErrorCode DMPlexCreateNumbering_Internal(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
6178 {
6179   PetscSection   section, globalSection;
6180   PetscInt      *numbers, p;
6181   PetscErrorCode ierr;
6182 
6183   PetscFunctionBegin;
6184   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6185   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6186   for (p = pStart; p < pEnd; ++p) {
6187     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6188   }
6189   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6190   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6191   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
6192   for (p = pStart; p < pEnd; ++p) {
6193     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6194     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
6195     else                       numbers[p-pStart] += shift;
6196   }
6197   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6198   if (globalSize) {
6199     PetscLayout layout;
6200     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
6201     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
6202     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
6203   }
6204   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6205   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6206   PetscFunctionReturn(0);
6207 }
6208 
6209 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
6210 {
6211   PetscInt       cellHeight, cStart, cEnd, cMax;
6212   PetscErrorCode ierr;
6213 
6214   PetscFunctionBegin;
6215   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6216   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6217   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6218   if (cMax >= 0 && !includeHybrid) cEnd = PetscMin(cEnd, cMax);
6219   ierr = DMPlexCreateNumbering_Internal(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
6220   PetscFunctionReturn(0);
6221 }
6222 
6223 /*@
6224   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
6225 
6226   Input Parameter:
6227 . dm   - The DMPlex object
6228 
6229   Output Parameter:
6230 . globalCellNumbers - Global cell numbers for all cells on this process
6231 
6232   Level: developer
6233 
6234 .seealso DMPlexGetVertexNumbering()
6235 @*/
6236 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6237 {
6238   DM_Plex       *mesh = (DM_Plex*) dm->data;
6239   PetscErrorCode ierr;
6240 
6241   PetscFunctionBegin;
6242   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6243   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
6244   *globalCellNumbers = mesh->globalCellNumbers;
6245   PetscFunctionReturn(0);
6246 }
6247 
6248 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
6249 {
6250   PetscInt       vStart, vEnd, vMax;
6251   PetscErrorCode ierr;
6252 
6253   PetscFunctionBegin;
6254   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6255   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6256   ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6257   if (vMax >= 0 && !includeHybrid) vEnd = PetscMin(vEnd, vMax);
6258   ierr = DMPlexCreateNumbering_Internal(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
6259   PetscFunctionReturn(0);
6260 }
6261 
6262 /*@
6263   DMPlexGetVertexNumbering - Get a global certex numbering for all vertices on this process
6264 
6265   Input Parameter:
6266 . dm   - The DMPlex object
6267 
6268   Output Parameter:
6269 . globalVertexNumbers - Global vertex numbers for all vertices on this process
6270 
6271   Level: developer
6272 
6273 .seealso DMPlexGetCellNumbering()
6274 @*/
6275 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6276 {
6277   DM_Plex       *mesh = (DM_Plex*) dm->data;
6278   PetscErrorCode ierr;
6279 
6280   PetscFunctionBegin;
6281   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6282   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
6283   *globalVertexNumbers = mesh->globalVertexNumbers;
6284   PetscFunctionReturn(0);
6285 }
6286 
6287 /*@
6288   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
6289 
6290   Input Parameter:
6291 . dm   - The DMPlex object
6292 
6293   Output Parameter:
6294 . globalPointNumbers - Global numbers for all points on this process
6295 
6296   Level: developer
6297 
6298 .seealso DMPlexGetCellNumbering()
6299 @*/
6300 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
6301 {
6302   IS             nums[4];
6303   PetscInt       depths[4], gdepths[4], starts[4];
6304   PetscInt       depth, d, shift = 0;
6305   PetscErrorCode ierr;
6306 
6307   PetscFunctionBegin;
6308   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6309   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6310   /* For unstratified meshes use dim instead of depth */
6311   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
6312   for (d = 0; d <= depth; ++d) {
6313     PetscInt end;
6314 
6315     depths[d] = depth-d;
6316     ierr = DMPlexGetDepthStratum(dm, depths[d], &starts[d], &end);CHKERRQ(ierr);
6317     if (!(starts[d]-end)) { starts[d] = depths[d] = -1; }
6318   }
6319   ierr = PetscSortIntWithArray(depth+1, starts, depths);CHKERRQ(ierr);
6320   ierr = MPIU_Allreduce(depths, gdepths, depth+1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
6321   for (d = 0; d <= depth; ++d) {
6322     if (starts[d] >= 0 && depths[d] != gdepths[d]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected depth %D, found %D",depths[d],gdepths[d]);
6323   }
6324   for (d = 0; d <= depth; ++d) {
6325     PetscInt pStart, pEnd, gsize;
6326 
6327     ierr = DMPlexGetDepthStratum(dm, gdepths[d], &pStart, &pEnd);CHKERRQ(ierr);
6328     ierr = DMPlexCreateNumbering_Internal(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
6329     shift += gsize;
6330   }
6331   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
6332   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
6333   PetscFunctionReturn(0);
6334 }
6335 
6336 
6337 /*@
6338   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
6339 
6340   Input Parameter:
6341 . dm - The DMPlex object
6342 
6343   Output Parameter:
6344 . ranks - The rank field
6345 
6346   Options Database Keys:
6347 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
6348 
6349   Level: intermediate
6350 
6351 .seealso: DMView()
6352 @*/
6353 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
6354 {
6355   DM             rdm;
6356   PetscFE        fe;
6357   PetscScalar   *r;
6358   PetscMPIInt    rank;
6359   PetscInt       dim, cStart, cEnd, c;
6360   PetscErrorCode ierr;
6361 
6362   PetscFunctionBeginUser;
6363   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6364   PetscValidPointer(ranks, 2);
6365   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
6366   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
6367   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
6368   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___rank_", -1, &fe);CHKERRQ(ierr);
6369   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
6370   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
6371   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
6372   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
6373   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6374   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
6375   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
6376   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
6377   for (c = cStart; c < cEnd; ++c) {
6378     PetscScalar *lr;
6379 
6380     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
6381     *lr = rank;
6382   }
6383   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
6384   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
6385   PetscFunctionReturn(0);
6386 }
6387 
6388 /*@
6389   DMPlexCreateLabelField - Create a cell field whose value is the label value for that cell
6390 
6391   Input Parameters:
6392 + dm    - The DMPlex
6393 - label - The DMLabel
6394 
6395   Output Parameter:
6396 . val - The label value field
6397 
6398   Options Database Keys:
6399 . -dm_label_view - Adds the label value field into the DM output from -dm_view using the same viewer
6400 
6401   Level: intermediate
6402 
6403 .seealso: DMView()
6404 @*/
6405 PetscErrorCode DMPlexCreateLabelField(DM dm, DMLabel label, Vec *val)
6406 {
6407   DM             rdm;
6408   PetscFE        fe;
6409   PetscScalar   *v;
6410   PetscInt       dim, cStart, cEnd, c;
6411   PetscErrorCode ierr;
6412 
6413   PetscFunctionBeginUser;
6414   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6415   PetscValidPointer(label, 2);
6416   PetscValidPointer(val, 3);
6417   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
6418   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
6419   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___label_value_", -1, &fe);CHKERRQ(ierr);
6420   ierr = PetscObjectSetName((PetscObject) fe, "label_value");CHKERRQ(ierr);
6421   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
6422   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
6423   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
6424   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6425   ierr = DMCreateGlobalVector(rdm, val);CHKERRQ(ierr);
6426   ierr = PetscObjectSetName((PetscObject) *val, "label_value");CHKERRQ(ierr);
6427   ierr = VecGetArray(*val, &v);CHKERRQ(ierr);
6428   for (c = cStart; c < cEnd; ++c) {
6429     PetscScalar *lv;
6430     PetscInt     cval;
6431 
6432     ierr = DMPlexPointGlobalRef(rdm, c, v, &lv);CHKERRQ(ierr);
6433     ierr = DMLabelGetValue(label, c, &cval);CHKERRQ(ierr);
6434     *lv = cval;
6435   }
6436   ierr = VecRestoreArray(*val, &v);CHKERRQ(ierr);
6437   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
6438   PetscFunctionReturn(0);
6439 }
6440 
6441 /*@
6442   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6443 
6444   Input Parameter:
6445 . dm - The DMPlex object
6446 
6447   Note: This is a useful diagnostic when creating meshes programmatically.
6448 
6449   Level: developer
6450 
6451 .seealso: DMCreate(), DMPlexCheckSkeleton(), DMPlexCheckFaces()
6452 @*/
6453 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6454 {
6455   PetscSection    coneSection, supportSection;
6456   const PetscInt *cone, *support;
6457   PetscInt        coneSize, c, supportSize, s;
6458   PetscInt        pStart, pEnd, p, pp, csize, ssize;
6459   PetscBool       storagecheck = PETSC_TRUE;
6460   PetscErrorCode  ierr;
6461 
6462   PetscFunctionBegin;
6463   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6464   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6465   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6466   /* Check that point p is found in the support of its cone points, and vice versa */
6467   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6468   for (p = pStart; p < pEnd; ++p) {
6469     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6470     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6471     for (c = 0; c < coneSize; ++c) {
6472       PetscBool dup = PETSC_FALSE;
6473       PetscInt  d;
6474       for (d = c-1; d >= 0; --d) {
6475         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
6476       }
6477       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6478       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6479       for (s = 0; s < supportSize; ++s) {
6480         if (support[s] == p) break;
6481       }
6482       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
6483         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
6484         for (s = 0; s < coneSize; ++s) {
6485           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
6486         }
6487         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6488         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
6489         for (s = 0; s < supportSize; ++s) {
6490           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
6491         }
6492         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6493         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
6494         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
6495       }
6496     }
6497     ierr = DMPlexGetTreeParent(dm, p, &pp, NULL);CHKERRQ(ierr);
6498     if (p != pp) { storagecheck = PETSC_FALSE; continue; }
6499     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6500     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6501     for (s = 0; s < supportSize; ++s) {
6502       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6503       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6504       for (c = 0; c < coneSize; ++c) {
6505         ierr = DMPlexGetTreeParent(dm, cone[c], &pp, NULL);CHKERRQ(ierr);
6506         if (cone[c] != pp) { c = 0; break; }
6507         if (cone[c] == p) break;
6508       }
6509       if (c >= coneSize) {
6510         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
6511         for (c = 0; c < supportSize; ++c) {
6512           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
6513         }
6514         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6515         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
6516         for (c = 0; c < coneSize; ++c) {
6517           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
6518         }
6519         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6520         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
6521       }
6522     }
6523   }
6524   if (storagecheck) {
6525     ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6526     ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6527     if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
6528   }
6529   PetscFunctionReturn(0);
6530 }
6531 
6532 /*@
6533   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6534 
6535   Input Parameters:
6536 + dm - The DMPlex object
6537 - cellHeight - Normally 0
6538 
6539   Note: This is a useful diagnostic when creating meshes programmatically.
6540   Currently applicable only to homogeneous simplex or tensor meshes.
6541 
6542   Level: developer
6543 
6544 .seealso: DMCreate(), DMPlexCheckSymmetry(), DMPlexCheckFaces()
6545 @*/
6546 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscInt cellHeight)
6547 {
6548   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6549   PetscBool      isSimplex = PETSC_FALSE;
6550   PetscErrorCode ierr;
6551 
6552   PetscFunctionBegin;
6553   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6554   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6555   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6556   if (cStart < cEnd) {
6557     ierr = DMPlexGetConeSize(dm, cStart, &c);CHKERRQ(ierr);
6558     isSimplex = c == dim+1 ? PETSC_TRUE : PETSC_FALSE;
6559   }
6560   switch (dim) {
6561   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6562   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6563   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6564   default:
6565     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %D", dim);
6566   }
6567   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6568   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6569   cMax = cMax >= 0 ? cMax : cEnd;
6570   for (c = cStart; c < cMax; ++c) {
6571     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6572 
6573     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6574     for (cl = 0; cl < closureSize*2; cl += 2) {
6575       const PetscInt p = closure[cl];
6576       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6577     }
6578     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6579     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has  %D vertices != %D", c, coneSize, numCorners);
6580   }
6581   for (c = cMax; c < cEnd; ++c) {
6582     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6583 
6584     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6585     for (cl = 0; cl < closureSize*2; cl += 2) {
6586       const PetscInt p = closure[cl];
6587       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6588     }
6589     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6590     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %D has  %D vertices > %D", c, coneSize, numHybridCorners);
6591   }
6592   PetscFunctionReturn(0);
6593 }
6594 
6595 /*@
6596   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6597 
6598   Input Parameters:
6599 + dm - The DMPlex object
6600 - cellHeight - Normally 0
6601 
6602   Note: This is a useful diagnostic when creating meshes programmatically.
6603 
6604   Level: developer
6605 
6606 .seealso: DMCreate(), DMPlexCheckSymmetry(), DMPlexCheckSkeleton()
6607 @*/
6608 PetscErrorCode DMPlexCheckFaces(DM dm, PetscInt cellHeight)
6609 {
6610   PetscInt       pMax[4];
6611   PetscInt       dim, depth, vStart, vEnd, cStart, cEnd, c, h;
6612   PetscErrorCode ierr;
6613 
6614   PetscFunctionBegin;
6615   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6616   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6617   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6618   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6619   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6620   for (h = cellHeight; h < PetscMin(depth, dim); ++h) {
6621     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6622     for (c = cStart; c < cEnd; ++c) {
6623       const PetscInt *cone, *ornt, *faces;
6624       PetscInt        numFaces, faceSize, coneSize,f;
6625       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6626 
6627       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6628       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6629       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6630       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6631       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6632       for (cl = 0; cl < closureSize*2; cl += 2) {
6633         const PetscInt p = closure[cl];
6634         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6635       }
6636       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6637       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D faces but should have %D", c, coneSize, numFaces);
6638       for (f = 0; f < numFaces; ++f) {
6639         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6640 
6641         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6642         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6643           const PetscInt p = fclosure[cl];
6644           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6645         }
6646         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);
6647         for (v = 0; v < fnumCorners; ++v) {
6648           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]);
6649         }
6650         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6651       }
6652       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6653       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6654     }
6655   }
6656   PetscFunctionReturn(0);
6657 }
6658 
6659 /*@
6660   DMPlexCheckGeometry - Check the geometry of mesh cells
6661 
6662   Input Parameter:
6663 . dm - The DMPlex object
6664 
6665   Note: This is a useful diagnostic when creating meshes programmatically.
6666 
6667   Level: developer
6668 
6669 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton(), DMCheckFaces()
6670 @*/
6671 PetscErrorCode DMPlexCheckGeometry(DM dm)
6672 {
6673   PetscReal      detJ, J[9], refVol = 1.0;
6674   PetscReal      vol;
6675   PetscInt       dim, depth, d, cStart, cEnd, c;
6676   PetscErrorCode ierr;
6677 
6678   PetscFunctionBegin;
6679   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6680   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6681   for (d = 0; d < dim; ++d) refVol *= 2.0;
6682   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6683   for (c = cStart; c < cEnd; ++c) {
6684     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, NULL, J, NULL, &detJ);CHKERRQ(ierr);
6685     if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D is inverted, |J| = %g", c, (double) detJ);
6686     ierr = PetscInfo2(dm, "Cell %D FEM Volume %g\n", c, (double) detJ*refVol);CHKERRQ(ierr);
6687     if (depth > 1) {
6688       ierr = DMPlexComputeCellGeometryFVM(dm, c, &vol, NULL, NULL);CHKERRQ(ierr);
6689       if (vol <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %d is inverted, vol = %g", c, (double) vol);
6690       ierr = PetscInfo2(dm, "Cell %D FVM Volume %g\n", c, (double) vol);CHKERRQ(ierr);
6691     }
6692   }
6693   PetscFunctionReturn(0);
6694 }
6695 
6696 static PetscErrorCode DMPlexAreAllConePointsInArray_Private(DM dm, PetscInt p, PetscInt npoints, const PetscInt *points, PetscInt *missingPoint)
6697 {
6698   PetscInt i,l,n;
6699   const PetscInt *cone;
6700   PetscErrorCode ierr;
6701 
6702   PetscFunctionBegin;
6703   *missingPoint = -1;
6704   ierr = DMPlexGetConeSize(dm, p, &n);CHKERRQ(ierr);
6705   ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6706   for (i=0; i<n; i++) {
6707     ierr = PetscFindInt(cone[i], npoints, points, &l);CHKERRQ(ierr);
6708     if (l < 0) {
6709       *missingPoint = cone[i];
6710       break;
6711     }
6712   }
6713   PetscFunctionReturn(0);
6714 }
6715 
6716 /*@
6717   DMPlexCheckPointSF - Check that several sufficient conditions are met for the point SF of this plex.
6718 
6719   Input Parameters:
6720 . dm - The DMPlex object
6721 
6722   Note: This is mainly intended for debugging/testing purposes.
6723 
6724   Level: developer
6725 
6726 .seealso: DMGetPointSF(), DMPlexCheckSymmetry(), DMPlexCheckSkeleton(), DMPlexCheckFaces()
6727 @*/
6728 PetscErrorCode DMPlexCheckPointSF(DM dm)
6729 {
6730   PetscSF sf;
6731   PetscInt d,depth,i,nleaves,p,plo,phi,missingPoint;
6732   const PetscInt *locals;
6733   PetscErrorCode ierr;
6734 
6735   PetscFunctionBegin;
6736   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6737   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6738   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
6739   ierr = PetscSFGetGraph(sf, NULL, &nleaves, &locals, NULL);CHKERRQ(ierr);
6740 
6741   /* 1) check there are no faces in 2D, cells in 3D, in interface */
6742   ierr = DMPlexGetVTKCellHeight(dm, &d);CHKERRQ(ierr);
6743   ierr = DMPlexGetHeightStratum(dm, d, &plo, &phi);CHKERRQ(ierr);
6744   for (i=0; i<nleaves; i++) {
6745     p = locals[i];
6746     if (p >= plo && p < phi) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point SF contains %d which is a cell",p);
6747   }
6748 
6749   /* 2) if some point is in interface, then all its cone points must be also in interface  */
6750   for (i=0; i<nleaves; i++) {
6751     p = locals[i];
6752     ierr = DMPlexAreAllConePointsInArray_Private(dm, p, nleaves, locals, &missingPoint);CHKERRQ(ierr);
6753     if (missingPoint >= 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point SF contains %d but not %d from its cone",p,missingPoint);
6754   }
6755   PetscFunctionReturn(0);
6756 }
6757 
6758 typedef struct cell_stats
6759 {
6760   PetscReal min, max, sum, squaresum;
6761   PetscInt  count;
6762 } cell_stats_t;
6763 
6764 static void cell_stats_reduce(void *a, void *b, int * len, MPI_Datatype *datatype)
6765 {
6766   PetscInt i, N = *len;
6767 
6768   for (i = 0; i < N; i++) {
6769     cell_stats_t *A = (cell_stats_t *) a;
6770     cell_stats_t *B = (cell_stats_t *) b;
6771 
6772     B->min = PetscMin(A->min,B->min);
6773     B->max = PetscMax(A->max,B->max);
6774     B->sum += A->sum;
6775     B->squaresum += A->squaresum;
6776     B->count += A->count;
6777   }
6778 }
6779 
6780 /*@
6781   DMPlexCheckCellShape - Checks the Jacobian of the mapping and computes some minimal statistics.
6782 
6783   Input Parameters:
6784 + dm - The DMPlex object
6785 - output - If true, statistics will be displayed on stdout
6786 
6787   Note: This is mainly intended for debugging/testing purposes.
6788 
6789   Level: developer
6790 
6791 .seealso: DMPlexCheckSymmetry(), DMPlexCheckSkeleton(), DMPlexCheckFaces()
6792 @*/
6793 PetscErrorCode DMPlexCheckCellShape(DM dm, PetscBool output)
6794 {
6795   PetscMPIInt    rank,size;
6796   PetscInt       dim, c, cStart, cEnd, cMax, count = 0;
6797   cell_stats_t   stats, globalStats;
6798   PetscReal      *J, *invJ, min = 0, max = 0, mean = 0, stdev = 0;
6799   MPI_Comm       comm = PetscObjectComm((PetscObject)dm);
6800   DM             dmCoarse;
6801   PetscErrorCode ierr;
6802 
6803   PetscFunctionBegin;
6804   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6805   stats.min   = PETSC_MAX_REAL;
6806   stats.max   = PETSC_MIN_REAL;
6807   stats.sum   = stats.squaresum = 0.;
6808   stats.count = 0;
6809 
6810   ierr = DMGetCoordinateDim(dm,&dim);CHKERRQ(ierr);
6811   ierr = PetscMalloc2(dim * dim, &J, dim * dim, &invJ);CHKERRQ(ierr);
6812   ierr = DMPlexGetHeightStratum(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
6813   ierr = DMPlexGetHybridBounds(dm,&cMax,NULL,NULL,NULL);CHKERRQ(ierr);
6814   cMax = cMax < 0 ? cEnd : cMax;
6815   for (c = cStart; c < cMax; c++) {
6816     PetscInt  i;
6817     PetscReal frobJ = 0., frobInvJ = 0., cond2, cond, detJ;
6818 
6819     ierr = DMPlexComputeCellGeometryAffineFEM(dm,c,NULL,J,invJ,&detJ);CHKERRQ(ierr);
6820     if (detJ < 0.0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D is inverted", c);
6821     for (i = 0; i < dim * dim; i++) {
6822       frobJ    += J[i] * J[i];
6823       frobInvJ += invJ[i] * invJ[i];
6824     }
6825     cond2 = frobJ * frobInvJ;
6826     cond  = PetscSqrtReal(cond2);
6827 
6828     stats.min        = PetscMin(stats.min,cond);
6829     stats.max        = PetscMax(stats.max,cond);
6830     stats.sum       += cond;
6831     stats.squaresum += cond2;
6832     stats.count++;
6833   }
6834 
6835   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
6836   if (size > 1) {
6837     PetscMPIInt   blockLengths[2] = {4,1};
6838     MPI_Aint      blockOffsets[2] = {offsetof(cell_stats_t,min),offsetof(cell_stats_t,count)};
6839     MPI_Datatype  blockTypes[2]   = {MPIU_REAL,MPIU_INT}, statType;
6840     MPI_Op        statReduce;
6841 
6842     ierr = MPI_Type_create_struct(2,blockLengths,blockOffsets,blockTypes,&statType);CHKERRQ(ierr);
6843     ierr = MPI_Type_commit(&statType);CHKERRQ(ierr);
6844     ierr = MPI_Op_create(cell_stats_reduce, PETSC_TRUE, &statReduce);CHKERRQ(ierr);
6845     ierr = MPI_Reduce(&stats,&globalStats,1,statType,statReduce,0,comm);CHKERRQ(ierr);
6846     ierr = MPI_Op_free(&statReduce);CHKERRQ(ierr);
6847     ierr = MPI_Type_free(&statType);CHKERRQ(ierr);
6848   } else {
6849     ierr = PetscMemcpy(&globalStats,&stats,sizeof(stats));CHKERRQ(ierr);
6850   }
6851 
6852   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6853   if (!rank) {
6854     count = globalStats.count;
6855     min   = globalStats.min;
6856     max   = globalStats.max;
6857     mean  = globalStats.sum / globalStats.count;
6858     stdev = globalStats.count > 1 ? PetscSqrtReal(PetscMax((globalStats.squaresum - globalStats.count * mean * mean) / (globalStats.count - 1),0)) : 0.0;
6859   }
6860 
6861   if (output) {
6862     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);
6863   }
6864   ierr = PetscFree2(J,invJ);CHKERRQ(ierr);
6865 
6866   ierr = DMGetCoarseDM(dm,&dmCoarse);CHKERRQ(ierr);
6867   if (dmCoarse) {
6868     PetscBool isplex;
6869 
6870     ierr = PetscObjectTypeCompare((PetscObject)dmCoarse,DMPLEX,&isplex);CHKERRQ(ierr);
6871     if (isplex) {
6872       ierr = DMPlexCheckCellShape(dmCoarse,output);CHKERRQ(ierr);
6873     }
6874   }
6875   PetscFunctionReturn(0);
6876 }
6877 
6878 /* Pointwise interpolation
6879      Just code FEM for now
6880      u^f = I u^c
6881      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6882      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6883      I_{ij} = psi^f_i phi^c_j
6884 */
6885 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6886 {
6887   PetscSection   gsc, gsf;
6888   PetscInt       m, n;
6889   void          *ctx;
6890   DM             cdm;
6891   PetscBool      regular, ismatis;
6892   PetscErrorCode ierr;
6893 
6894   PetscFunctionBegin;
6895   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6896   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6897   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6898   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6899 
6900   ierr = PetscStrcmp(dmCoarse->mattype, MATIS, &ismatis);CHKERRQ(ierr);
6901   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6902   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6903   ierr = MatSetType(*interpolation, ismatis ? MATAIJ : dmCoarse->mattype);CHKERRQ(ierr);
6904   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6905 
6906   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6907   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6908   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6909   else                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6910   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
6911   if (scaling) {
6912     /* Use naive scaling */
6913     ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6914   }
6915   PetscFunctionReturn(0);
6916 }
6917 
6918 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
6919 {
6920   PetscErrorCode ierr;
6921   VecScatter     ctx;
6922 
6923   PetscFunctionBegin;
6924   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
6925   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
6926   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
6927   PetscFunctionReturn(0);
6928 }
6929 
6930 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
6931 {
6932   PetscSection   gsc, gsf;
6933   PetscInt       m, n;
6934   void          *ctx;
6935   DM             cdm;
6936   PetscBool      regular;
6937   PetscErrorCode ierr;
6938 
6939   PetscFunctionBegin;
6940   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6941   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6942   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6943   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6944 
6945   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
6946   ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6947   ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
6948   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6949 
6950   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6951   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6952   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6953   else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6954   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
6955   PetscFunctionReturn(0);
6956 }
6957 
6958 /*@
6959   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6960 
6961   Input Parameter:
6962 . dm - The DMPlex object
6963 
6964   Output Parameter:
6965 . regular - The flag
6966 
6967   Level: intermediate
6968 
6969 .seealso: DMPlexSetRegularRefinement()
6970 @*/
6971 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
6972 {
6973   PetscFunctionBegin;
6974   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6975   PetscValidPointer(regular, 2);
6976   *regular = ((DM_Plex *) dm->data)->regularRefinement;
6977   PetscFunctionReturn(0);
6978 }
6979 
6980 /*@
6981   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6982 
6983   Input Parameters:
6984 + dm - The DMPlex object
6985 - regular - The flag
6986 
6987   Level: intermediate
6988 
6989 .seealso: DMPlexGetRegularRefinement()
6990 @*/
6991 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
6992 {
6993   PetscFunctionBegin;
6994   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6995   ((DM_Plex *) dm->data)->regularRefinement = regular;
6996   PetscFunctionReturn(0);
6997 }
6998 
6999 /* anchors */
7000 /*@
7001   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
7002   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
7003 
7004   not collective
7005 
7006   Input Parameters:
7007 . dm - The DMPlex object
7008 
7009   Output Parameters:
7010 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
7011 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
7012 
7013 
7014   Level: intermediate
7015 
7016 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
7017 @*/
7018 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
7019 {
7020   DM_Plex *plex = (DM_Plex *)dm->data;
7021   PetscErrorCode ierr;
7022 
7023   PetscFunctionBegin;
7024   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7025   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
7026   if (anchorSection) *anchorSection = plex->anchorSection;
7027   if (anchorIS) *anchorIS = plex->anchorIS;
7028   PetscFunctionReturn(0);
7029 }
7030 
7031 /*@
7032   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
7033   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
7034   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
7035 
7036   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
7037   DMGetConstraints() and filling in the entries in the constraint matrix.
7038 
7039   collective on dm
7040 
7041   Input Parameters:
7042 + dm - The DMPlex object
7043 . 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).
7044 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
7045 
7046   The reference counts of anchorSection and anchorIS are incremented.
7047 
7048   Level: intermediate
7049 
7050 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
7051 @*/
7052 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
7053 {
7054   DM_Plex        *plex = (DM_Plex *)dm->data;
7055   PetscMPIInt    result;
7056   PetscErrorCode ierr;
7057 
7058   PetscFunctionBegin;
7059   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7060   if (anchorSection) {
7061     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
7062     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
7063     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
7064   }
7065   if (anchorIS) {
7066     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
7067     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
7068     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
7069   }
7070 
7071   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
7072   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
7073   plex->anchorSection = anchorSection;
7074 
7075   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
7076   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
7077   plex->anchorIS = anchorIS;
7078 
7079 #if defined(PETSC_USE_DEBUG)
7080   if (anchorIS && anchorSection) {
7081     PetscInt size, a, pStart, pEnd;
7082     const PetscInt *anchors;
7083 
7084     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
7085     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
7086     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
7087     for (a = 0; a < size; a++) {
7088       PetscInt p;
7089 
7090       p = anchors[a];
7091       if (p >= pStart && p < pEnd) {
7092         PetscInt dof;
7093 
7094         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
7095         if (dof) {
7096           PetscErrorCode ierr2;
7097 
7098           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
7099           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
7100         }
7101       }
7102     }
7103     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
7104   }
7105 #endif
7106   /* reset the generic constraints */
7107   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
7108   PetscFunctionReturn(0);
7109 }
7110 
7111 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
7112 {
7113   PetscSection anchorSection;
7114   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
7115   PetscErrorCode ierr;
7116 
7117   PetscFunctionBegin;
7118   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7119   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
7120   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
7121   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
7122   if (numFields) {
7123     PetscInt f;
7124     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
7125 
7126     for (f = 0; f < numFields; f++) {
7127       PetscInt numComp;
7128 
7129       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
7130       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
7131     }
7132   }
7133   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
7134   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
7135   pStart = PetscMax(pStart,sStart);
7136   pEnd   = PetscMin(pEnd,sEnd);
7137   pEnd   = PetscMax(pStart,pEnd);
7138   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
7139   for (p = pStart; p < pEnd; p++) {
7140     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
7141     if (dof) {
7142       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
7143       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
7144       for (f = 0; f < numFields; f++) {
7145         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
7146         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
7147       }
7148     }
7149   }
7150   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
7151   PetscFunctionReturn(0);
7152 }
7153 
7154 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
7155 {
7156   PetscSection aSec;
7157   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
7158   const PetscInt *anchors;
7159   PetscInt numFields, f;
7160   IS aIS;
7161   PetscErrorCode ierr;
7162 
7163   PetscFunctionBegin;
7164   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7165   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
7166   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
7167   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
7168   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
7169   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
7170   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
7171   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
7172   /* cSec will be a subset of aSec and section */
7173   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
7174   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
7175   i[0] = 0;
7176   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
7177   for (p = pStart; p < pEnd; p++) {
7178     PetscInt rDof, rOff, r;
7179 
7180     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
7181     if (!rDof) continue;
7182     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
7183     if (numFields) {
7184       for (f = 0; f < numFields; f++) {
7185         annz = 0;
7186         for (r = 0; r < rDof; r++) {
7187           a = anchors[rOff + r];
7188           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
7189           annz += aDof;
7190         }
7191         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
7192         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
7193         for (q = 0; q < dof; q++) {
7194           i[off + q + 1] = i[off + q] + annz;
7195         }
7196       }
7197     }
7198     else {
7199       annz = 0;
7200       for (q = 0; q < dof; q++) {
7201         a = anchors[off + q];
7202         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7203         annz += aDof;
7204       }
7205       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
7206       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
7207       for (q = 0; q < dof; q++) {
7208         i[off + q + 1] = i[off + q] + annz;
7209       }
7210     }
7211   }
7212   nnz = i[m];
7213   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
7214   offset = 0;
7215   for (p = pStart; p < pEnd; p++) {
7216     if (numFields) {
7217       for (f = 0; f < numFields; f++) {
7218         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
7219         for (q = 0; q < dof; q++) {
7220           PetscInt rDof, rOff, r;
7221           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
7222           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
7223           for (r = 0; r < rDof; r++) {
7224             PetscInt s;
7225 
7226             a = anchors[rOff + r];
7227             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
7228             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
7229             for (s = 0; s < aDof; s++) {
7230               j[offset++] = aOff + s;
7231             }
7232           }
7233         }
7234       }
7235     }
7236     else {
7237       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
7238       for (q = 0; q < dof; q++) {
7239         PetscInt rDof, rOff, r;
7240         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
7241         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
7242         for (r = 0; r < rDof; r++) {
7243           PetscInt s;
7244 
7245           a = anchors[rOff + r];
7246           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7247           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
7248           for (s = 0; s < aDof; s++) {
7249             j[offset++] = aOff + s;
7250           }
7251         }
7252       }
7253     }
7254   }
7255   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
7256   ierr = PetscFree(i);CHKERRQ(ierr);
7257   ierr = PetscFree(j);CHKERRQ(ierr);
7258   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
7259   PetscFunctionReturn(0);
7260 }
7261 
7262 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
7263 {
7264   DM_Plex        *plex = (DM_Plex *)dm->data;
7265   PetscSection   anchorSection, section, cSec;
7266   Mat            cMat;
7267   PetscErrorCode ierr;
7268 
7269   PetscFunctionBegin;
7270   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7271   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
7272   if (anchorSection) {
7273     PetscInt Nf;
7274 
7275     ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
7276     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
7277     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
7278     ierr = DMGetNumFields(dm,&Nf);CHKERRQ(ierr);
7279     if (Nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
7280     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
7281     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
7282     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
7283   }
7284   PetscFunctionReturn(0);
7285 }
7286 
7287 PetscErrorCode DMCreateSubDomainDM_Plex(DM dm, DMLabel label, PetscInt value, IS *is, DM *subdm)
7288 {
7289   IS             subis;
7290   PetscSection   section, subsection;
7291   PetscErrorCode ierr;
7292 
7293   PetscFunctionBegin;
7294   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7295   if (!section) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting subdomain");
7296   if (!subdm)   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set output subDM for splitting subdomain");
7297   /* Create subdomain */
7298   ierr = DMPlexFilter(dm, label, value, subdm);CHKERRQ(ierr);
7299   /* Create submodel */
7300   ierr = DMPlexCreateSubpointIS(*subdm, &subis);CHKERRQ(ierr);
7301   ierr = PetscSectionCreateSubmeshSection(section, subis, &subsection);CHKERRQ(ierr);
7302   ierr = ISDestroy(&subis);CHKERRQ(ierr);
7303   ierr = DMSetDefaultSection(*subdm, subsection);CHKERRQ(ierr);
7304   ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
7305   ierr = DMCopyDisc(dm, *subdm);CHKERRQ(ierr);
7306   /* Create map from submodel to global model */
7307   if (is) {
7308     PetscSection    sectionGlobal, subsectionGlobal;
7309     IS              spIS;
7310     const PetscInt *spmap;
7311     PetscInt       *subIndices;
7312     PetscInt        subSize = 0, subOff = 0, pStart, pEnd, p;
7313     PetscInt        Nf, f, bs = -1, bsLocal[2], bsMinMax[2];
7314 
7315     ierr = DMPlexCreateSubpointIS(*subdm, &spIS);CHKERRQ(ierr);
7316     ierr = ISGetIndices(spIS, &spmap);CHKERRQ(ierr);
7317     ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
7318     ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
7319     ierr = DMGetDefaultGlobalSection(*subdm, &subsectionGlobal);CHKERRQ(ierr);
7320     ierr = PetscSectionGetChart(subsection, &pStart, &pEnd);CHKERRQ(ierr);
7321     for (p = pStart; p < pEnd; ++p) {
7322       PetscInt gdof, pSubSize  = 0;
7323 
7324       ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
7325       if (gdof > 0) {
7326         for (f = 0; f < Nf; ++f) {
7327           PetscInt fdof, fcdof;
7328 
7329           ierr     = PetscSectionGetFieldDof(subsection, p, f, &fdof);CHKERRQ(ierr);
7330           ierr     = PetscSectionGetFieldConstraintDof(subsection, p, f, &fcdof);CHKERRQ(ierr);
7331           pSubSize += fdof-fcdof;
7332         }
7333         subSize += pSubSize;
7334         if (pSubSize) {
7335           if (bs < 0) {
7336             bs = pSubSize;
7337           } else if (bs != pSubSize) {
7338             /* Layout does not admit a pointwise block size */
7339             bs = 1;
7340           }
7341         }
7342       }
7343     }
7344     /* Must have same blocksize on all procs (some might have no points) */
7345     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
7346     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
7347     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
7348     else                            {bs = bsMinMax[0];}
7349     ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
7350     for (p = pStart; p < pEnd; ++p) {
7351       PetscInt gdof, goff;
7352 
7353       ierr = PetscSectionGetDof(subsectionGlobal, p, &gdof);CHKERRQ(ierr);
7354       if (gdof > 0) {
7355         const PetscInt point = spmap[p];
7356 
7357         ierr = PetscSectionGetOffset(sectionGlobal, point, &goff);CHKERRQ(ierr);
7358         for (f = 0; f < Nf; ++f) {
7359           PetscInt fdof, fcdof, fc, f2, poff = 0;
7360 
7361           /* Can get rid of this loop by storing field information in the global section */
7362           for (f2 = 0; f2 < f; ++f2) {
7363             ierr  = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
7364             ierr  = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
7365             poff += fdof-fcdof;
7366           }
7367           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
7368           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
7369           for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
7370             subIndices[subOff] = goff+poff+fc;
7371           }
7372         }
7373       }
7374     }
7375     ierr = ISRestoreIndices(spIS, &spmap);CHKERRQ(ierr);
7376     ierr = ISDestroy(&spIS);CHKERRQ(ierr);
7377     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
7378     if (bs > 1) {
7379       /* We need to check that the block size does not come from non-contiguous fields */
7380       PetscInt i, j, set = 1;
7381       for (i = 0; i < subSize; i += bs) {
7382         for (j = 0; j < bs; ++j) {
7383           if (subIndices[i+j] != subIndices[i]+j) {set = 0; break;}
7384         }
7385       }
7386       if (set) {ierr = ISSetBlockSize(*is, bs);CHKERRQ(ierr);}
7387     }
7388     /* Attach nullspace */
7389     for (f = 0; f < Nf; ++f) {
7390       (*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[f];
7391       if ((*subdm)->nullspaceConstructors[f]) break;
7392     }
7393     if (f < Nf) {
7394       MatNullSpace nullSpace;
7395 
7396       ierr = (*(*subdm)->nullspaceConstructors[f])(*subdm, f, &nullSpace);CHKERRQ(ierr);
7397       ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
7398       ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
7399     }
7400   }
7401   PetscFunctionReturn(0);
7402 }
7403