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