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