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