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