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