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