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