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