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