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