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