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