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