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