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