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