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