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