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