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