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