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