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