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