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