xref: /petsc/src/dm/impls/plex/plex.c (revision c9fdaa059acd92b4bc060e2735e3194d56820ba8)
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   *values = NULL;
4145   PetscFunctionReturn(0);
4146 }
4147 
4148 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
4149 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4150 
4151 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[])
4152 {
4153   PetscInt        cdof;   /* The number of constraints on this point */
4154   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4155   PetscScalar    *a;
4156   PetscInt        off, cind = 0, k;
4157   PetscErrorCode  ierr;
4158 
4159   PetscFunctionBegin;
4160   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4161   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4162   a    = &array[off];
4163   if (!cdof || setBC) {
4164     if (clperm) {
4165       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
4166       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
4167     } else {
4168       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
4169       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
4170     }
4171   } else {
4172     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4173     if (clperm) {
4174       if (perm) {for (k = 0; k < dof; ++k) {
4175           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4176           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4177         }
4178       } else {
4179         for (k = 0; k < dof; ++k) {
4180           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4181           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4182         }
4183       }
4184     } else {
4185       if (perm) {
4186         for (k = 0; k < dof; ++k) {
4187           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4188           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4189         }
4190       } else {
4191         for (k = 0; k < dof; ++k) {
4192           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4193           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4194         }
4195       }
4196     }
4197   }
4198   PetscFunctionReturn(0);
4199 }
4200 
4201 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[])
4202 {
4203   PetscInt        cdof;   /* The number of constraints on this point */
4204   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4205   PetscScalar    *a;
4206   PetscInt        off, cind = 0, k;
4207   PetscErrorCode  ierr;
4208 
4209   PetscFunctionBegin;
4210   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4211   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4212   a    = &array[off];
4213   if (cdof) {
4214     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4215     if (clperm) {
4216       if (perm) {
4217         for (k = 0; k < dof; ++k) {
4218           if ((cind < cdof) && (k == cdofs[cind])) {
4219             fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4220             cind++;
4221           }
4222         }
4223       } else {
4224         for (k = 0; k < dof; ++k) {
4225           if ((cind < cdof) && (k == cdofs[cind])) {
4226             fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4227             cind++;
4228           }
4229         }
4230       }
4231     } else {
4232       if (perm) {
4233         for (k = 0; k < dof; ++k) {
4234           if ((cind < cdof) && (k == cdofs[cind])) {
4235             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4236             cind++;
4237           }
4238         }
4239       } else {
4240         for (k = 0; k < dof; ++k) {
4241           if ((cind < cdof) && (k == cdofs[cind])) {
4242             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4243             cind++;
4244           }
4245         }
4246       }
4247     }
4248   }
4249   PetscFunctionReturn(0);
4250 }
4251 
4252 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[])
4253 {
4254   PetscScalar    *a;
4255   PetscInt        fdof, foff, fcdof, foffset = *offset;
4256   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4257   PetscInt        cind = 0, b;
4258   PetscErrorCode  ierr;
4259 
4260   PetscFunctionBegin;
4261   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4262   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4263   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4264   a    = &array[foff];
4265   if (!fcdof || setBC) {
4266     if (clperm) {
4267       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
4268       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
4269     } else {
4270       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
4271       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
4272     }
4273   } else {
4274     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4275     if (clperm) {
4276       if (perm) {
4277         for (b = 0; b < fdof; b++) {
4278           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4279           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4280         }
4281       } else {
4282         for (b = 0; b < fdof; b++) {
4283           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4284           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4285         }
4286       }
4287     } else {
4288       if (perm) {
4289         for (b = 0; b < fdof; b++) {
4290           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4291           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4292         }
4293       } else {
4294         for (b = 0; b < fdof; b++) {
4295           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4296           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4297         }
4298       }
4299     }
4300   }
4301   *offset += fdof;
4302   PetscFunctionReturn(0);
4303 }
4304 
4305 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[])
4306 {
4307   PetscScalar    *a;
4308   PetscInt        fdof, foff, fcdof, foffset = *offset;
4309   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4310   PetscInt        cind = 0, ncind = 0, b;
4311   PetscBool       ncSet, fcSet;
4312   PetscErrorCode  ierr;
4313 
4314   PetscFunctionBegin;
4315   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4316   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4317   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4318   a    = &array[foff];
4319   if (fcdof) {
4320     /* We just override fcdof and fcdofs with Ncc and comps */
4321     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4322     if (clperm) {
4323       if (perm) {
4324         if (comps) {
4325           for (b = 0; b < fdof; b++) {
4326             ncSet = fcSet = PETSC_FALSE;
4327             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4328             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4329             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}
4330           }
4331         } else {
4332           for (b = 0; b < fdof; b++) {
4333             if ((cind < fcdof) && (b == fcdofs[cind])) {
4334               fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4335               ++cind;
4336             }
4337           }
4338         }
4339       } else {
4340         if (comps) {
4341           for (b = 0; b < fdof; b++) {
4342             ncSet = fcSet = PETSC_FALSE;
4343             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4344             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4345             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}
4346           }
4347         } else {
4348           for (b = 0; b < fdof; b++) {
4349             if ((cind < fcdof) && (b == fcdofs[cind])) {
4350               fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4351               ++cind;
4352             }
4353           }
4354         }
4355       }
4356     } else {
4357       if (perm) {
4358         if (comps) {
4359           for (b = 0; b < fdof; b++) {
4360             ncSet = fcSet = PETSC_FALSE;
4361             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4362             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4363             if (ncSet && fcSet) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}
4364           }
4365         } else {
4366           for (b = 0; b < fdof; b++) {
4367             if ((cind < fcdof) && (b == fcdofs[cind])) {
4368               fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4369               ++cind;
4370             }
4371           }
4372         }
4373       } else {
4374         if (comps) {
4375           for (b = 0; b < fdof; b++) {
4376             ncSet = fcSet = PETSC_FALSE;
4377             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4378             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4379             if (ncSet && fcSet) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}
4380           }
4381         } else {
4382           for (b = 0; b < fdof; b++) {
4383             if ((cind < fcdof) && (b == fcdofs[cind])) {
4384               fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4385               ++cind;
4386             }
4387           }
4388         }
4389       }
4390     }
4391   }
4392   *offset += fdof;
4393   PetscFunctionReturn(0);
4394 }
4395 
4396 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4397 {
4398   PetscScalar    *array;
4399   const PetscInt *cone, *coneO;
4400   PetscInt        pStart, pEnd, p, numPoints, off, dof;
4401   PetscErrorCode  ierr;
4402 
4403   PetscFunctionBeginHot;
4404   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4405   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4406   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4407   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4408   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4409   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
4410     const PetscInt cp = !p ? point : cone[p-1];
4411     const PetscInt o  = !p ? 0     : coneO[p-1];
4412 
4413     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
4414     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4415     /* ADD_VALUES */
4416     {
4417       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4418       PetscScalar    *a;
4419       PetscInt        cdof, coff, cind = 0, k;
4420 
4421       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
4422       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
4423       a    = &array[coff];
4424       if (!cdof) {
4425         if (o >= 0) {
4426           for (k = 0; k < dof; ++k) {
4427             a[k] += values[off+k];
4428           }
4429         } else {
4430           for (k = 0; k < dof; ++k) {
4431             a[k] += values[off+dof-k-1];
4432           }
4433         }
4434       } else {
4435         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
4436         if (o >= 0) {
4437           for (k = 0; k < dof; ++k) {
4438             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4439             a[k] += values[off+k];
4440           }
4441         } else {
4442           for (k = 0; k < dof; ++k) {
4443             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4444             a[k] += values[off+dof-k-1];
4445           }
4446         }
4447       }
4448     }
4449   }
4450   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4451   PetscFunctionReturn(0);
4452 }
4453 
4454 /*@C
4455   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
4456 
4457   Not collective
4458 
4459   Input Parameters:
4460 + dm - The DM
4461 . section - The section describing the layout in v, or NULL to use the default section
4462 . v - The local vector
4463 . point - The point in the DM
4464 . values - The array of values
4465 - mode - The insert mode. One of INSERT_ALL_VALUES, ADD_ALL_VALUES, INSERT_VALUES, ADD_VALUES, INSERT_BC_VALUES, and ADD_BC_VALUES,
4466          where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions.
4467 
4468   Fortran Notes:
4469   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4470 
4471   Level: intermediate
4472 
4473 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
4474 @*/
4475 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4476 {
4477   PetscSection    clSection;
4478   IS              clPoints;
4479   PetscScalar    *array;
4480   PetscInt       *points = NULL;
4481   const PetscInt *clp, *clperm;
4482   PetscInt        depth, numFields, numPoints, p;
4483   PetscErrorCode  ierr;
4484 
4485   PetscFunctionBeginHot;
4486   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4487   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4488   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4489   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4490   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4491   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4492   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
4493     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
4494     PetscFunctionReturn(0);
4495   }
4496   /* Get points */
4497   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4498   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4499   /* Get array */
4500   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4501   /* Get values */
4502   if (numFields > 0) {
4503     PetscInt offset = 0, f;
4504     for (f = 0; f < numFields; ++f) {
4505       const PetscInt    **perms = NULL;
4506       const PetscScalar **flips = NULL;
4507 
4508       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4509       switch (mode) {
4510       case INSERT_VALUES:
4511         for (p = 0; p < numPoints; p++) {
4512           const PetscInt    point = points[2*p];
4513           const PetscInt    *perm = perms ? perms[p] : NULL;
4514           const PetscScalar *flip = flips ? flips[p] : NULL;
4515           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4516         } break;
4517       case INSERT_ALL_VALUES:
4518         for (p = 0; p < numPoints; p++) {
4519           const PetscInt    point = points[2*p];
4520           const PetscInt    *perm = perms ? perms[p] : NULL;
4521           const PetscScalar *flip = flips ? flips[p] : NULL;
4522           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4523         } break;
4524       case INSERT_BC_VALUES:
4525         for (p = 0; p < numPoints; p++) {
4526           const PetscInt    point = points[2*p];
4527           const PetscInt    *perm = perms ? perms[p] : NULL;
4528           const PetscScalar *flip = flips ? flips[p] : NULL;
4529           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, insert, clperm, values, &offset, array);
4530         } break;
4531       case ADD_VALUES:
4532         for (p = 0; p < numPoints; p++) {
4533           const PetscInt    point = points[2*p];
4534           const PetscInt    *perm = perms ? perms[p] : NULL;
4535           const PetscScalar *flip = flips ? flips[p] : NULL;
4536           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4537         } break;
4538       case ADD_ALL_VALUES:
4539         for (p = 0; p < numPoints; p++) {
4540           const PetscInt    point = points[2*p];
4541           const PetscInt    *perm = perms ? perms[p] : NULL;
4542           const PetscScalar *flip = flips ? flips[p] : NULL;
4543           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4544         } break;
4545       case ADD_BC_VALUES:
4546         for (p = 0; p < numPoints; p++) {
4547           const PetscInt    point = points[2*p];
4548           const PetscInt    *perm = perms ? perms[p] : NULL;
4549           const PetscScalar *flip = flips ? flips[p] : NULL;
4550           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, add, clperm, values, &offset, array);
4551         } break;
4552       default:
4553         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4554       }
4555       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4556     }
4557   } else {
4558     PetscInt dof, off;
4559     const PetscInt    **perms = NULL;
4560     const PetscScalar **flips = NULL;
4561 
4562     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4563     switch (mode) {
4564     case INSERT_VALUES:
4565       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4566         const PetscInt    point = points[2*p];
4567         const PetscInt    *perm = perms ? perms[p] : NULL;
4568         const PetscScalar *flip = flips ? flips[p] : NULL;
4569         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4570         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
4571       } break;
4572     case INSERT_ALL_VALUES:
4573       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4574         const PetscInt    point = points[2*p];
4575         const PetscInt    *perm = perms ? perms[p] : NULL;
4576         const PetscScalar *flip = flips ? flips[p] : NULL;
4577         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4578         updatePoint_private(section, point, dof, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
4579       } break;
4580     case INSERT_BC_VALUES:
4581       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4582         const PetscInt    point = points[2*p];
4583         const PetscInt    *perm = perms ? perms[p] : NULL;
4584         const PetscScalar *flip = flips ? flips[p] : NULL;
4585         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4586         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
4587       } break;
4588     case ADD_VALUES:
4589       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4590         const PetscInt    point = points[2*p];
4591         const PetscInt    *perm = perms ? perms[p] : NULL;
4592         const PetscScalar *flip = flips ? flips[p] : NULL;
4593         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4594         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
4595       } break;
4596     case ADD_ALL_VALUES:
4597       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4598         const PetscInt    point = points[2*p];
4599         const PetscInt    *perm = perms ? perms[p] : NULL;
4600         const PetscScalar *flip = flips ? flips[p] : NULL;
4601         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4602         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
4603       } break;
4604     case ADD_BC_VALUES:
4605       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4606         const PetscInt    point = points[2*p];
4607         const PetscInt    *perm = perms ? perms[p] : NULL;
4608         const PetscScalar *flip = flips ? flips[p] : NULL;
4609         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4610         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
4611       } break;
4612     default:
4613       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4614     }
4615     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4616   }
4617   /* Cleanup points */
4618   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4619   /* Cleanup array */
4620   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4621   PetscFunctionReturn(0);
4622 }
4623 
4624 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, PetscInt Ncc, const PetscInt comps[], const PetscScalar values[], InsertMode mode)
4625 {
4626   PetscSection      clSection;
4627   IS                clPoints;
4628   PetscScalar       *array;
4629   PetscInt          *points = NULL;
4630   const PetscInt    *clp, *clperm;
4631   PetscInt          numFields, numPoints, p;
4632   PetscInt          offset = 0, f;
4633   PetscErrorCode    ierr;
4634 
4635   PetscFunctionBeginHot;
4636   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4637   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4638   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4639   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4640   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4641   /* Get points */
4642   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4643   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4644   /* Get array */
4645   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4646   /* Get values */
4647   for (f = 0; f < numFields; ++f) {
4648     const PetscInt    **perms = NULL;
4649     const PetscScalar **flips = NULL;
4650 
4651     if (!fieldActive[f]) {
4652       for (p = 0; p < numPoints*2; p += 2) {
4653         PetscInt fdof;
4654         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4655         offset += fdof;
4656       }
4657       continue;
4658     }
4659     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4660     switch (mode) {
4661     case INSERT_VALUES:
4662       for (p = 0; p < numPoints; p++) {
4663         const PetscInt    point = points[2*p];
4664         const PetscInt    *perm = perms ? perms[p] : NULL;
4665         const PetscScalar *flip = flips ? flips[p] : NULL;
4666         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4667       } break;
4668     case INSERT_ALL_VALUES:
4669       for (p = 0; p < numPoints; p++) {
4670         const PetscInt    point = points[2*p];
4671         const PetscInt    *perm = perms ? perms[p] : NULL;
4672         const PetscScalar *flip = flips ? flips[p] : NULL;
4673         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4674         } break;
4675     case INSERT_BC_VALUES:
4676       for (p = 0; p < numPoints; p++) {
4677         const PetscInt    point = points[2*p];
4678         const PetscInt    *perm = perms ? perms[p] : NULL;
4679         const PetscScalar *flip = flips ? flips[p] : NULL;
4680         updatePointFieldsBC_private(section, point, perm, flip, f, Ncc, comps, insert, clperm, values, &offset, array);
4681       } break;
4682     case ADD_VALUES:
4683       for (p = 0; p < numPoints; p++) {
4684         const PetscInt    point = points[2*p];
4685         const PetscInt    *perm = perms ? perms[p] : NULL;
4686         const PetscScalar *flip = flips ? flips[p] : NULL;
4687         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4688       } break;
4689     case ADD_ALL_VALUES:
4690       for (p = 0; p < numPoints; p++) {
4691         const PetscInt    point = points[2*p];
4692         const PetscInt    *perm = perms ? perms[p] : NULL;
4693         const PetscScalar *flip = flips ? flips[p] : NULL;
4694         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4695       } break;
4696     default:
4697       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4698     }
4699     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4700   }
4701   /* Cleanup points */
4702   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4703   /* Cleanup array */
4704   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4705   PetscFunctionReturn(0);
4706 }
4707 
4708 static PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
4709 {
4710   PetscMPIInt    rank;
4711   PetscInt       i, j;
4712   PetscErrorCode ierr;
4713 
4714   PetscFunctionBegin;
4715   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
4716   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for point %D\n", rank, point);CHKERRQ(ierr);
4717   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
4718   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
4719   numCIndices = numCIndices ? numCIndices : numRIndices;
4720   for (i = 0; i < numRIndices; i++) {
4721     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
4722     for (j = 0; j < numCIndices; j++) {
4723 #if defined(PETSC_USE_COMPLEX)
4724       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
4725 #else
4726       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
4727 #endif
4728     }
4729     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
4730   }
4731   PetscFunctionReturn(0);
4732 }
4733 
4734 /* . off - The global offset of this point */
4735 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], PetscInt indices[])
4736 {
4737   PetscInt        dof;    /* The number of unknowns on this point */
4738   PetscInt        cdof;   /* The number of constraints on this point */
4739   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4740   PetscInt        cind = 0, k;
4741   PetscErrorCode  ierr;
4742 
4743   PetscFunctionBegin;
4744   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4745   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4746   if (!cdof || setBC) {
4747     if (perm) {
4748       for (k = 0; k < dof; k++) indices[*loff+perm[k]] = off + k;
4749     } else {
4750       for (k = 0; k < dof; k++) indices[*loff+k] = off + k;
4751     }
4752   } else {
4753     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4754     if (perm) {
4755       for (k = 0; k < dof; ++k) {
4756         if ((cind < cdof) && (k == cdofs[cind])) {
4757           /* Insert check for returning constrained indices */
4758           indices[*loff+perm[k]] = -(off+k+1);
4759           ++cind;
4760         } else {
4761           indices[*loff+perm[k]] = off+k-cind;
4762         }
4763       }
4764     } else {
4765       for (k = 0; k < dof; ++k) {
4766         if ((cind < cdof) && (k == cdofs[cind])) {
4767           /* Insert check for returning constrained indices */
4768           indices[*loff+k] = -(off+k+1);
4769           ++cind;
4770         } else {
4771           indices[*loff+k] = off+k-cind;
4772         }
4773       }
4774     }
4775   }
4776   *loff += dof;
4777   PetscFunctionReturn(0);
4778 }
4779 
4780 /* . off - The global offset of this point */
4781 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, PetscInt indices[])
4782 {
4783   PetscInt       numFields, foff, f;
4784   PetscErrorCode ierr;
4785 
4786   PetscFunctionBegin;
4787   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4788   for (f = 0, foff = 0; f < numFields; ++f) {
4789     PetscInt        fdof, cfdof;
4790     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4791     PetscInt        cind = 0, b;
4792     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
4793 
4794     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4795     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4796     if (!cfdof || setBC) {
4797       if (perm) {for (b = 0; b < fdof; b++) {indices[foffs[f]+perm[b]] = off+foff+b;}}
4798       else      {for (b = 0; b < fdof; b++) {indices[foffs[f]+     b ] = off+foff+b;}}
4799     } else {
4800       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4801       if (perm) {
4802         for (b = 0; b < fdof; b++) {
4803           if ((cind < cfdof) && (b == fcdofs[cind])) {
4804             indices[foffs[f]+perm[b]] = -(off+foff+b+1);
4805             ++cind;
4806           } else {
4807             indices[foffs[f]+perm[b]] = off+foff+b-cind;
4808           }
4809         }
4810       } else {
4811         for (b = 0; b < fdof; b++) {
4812           if ((cind < cfdof) && (b == fcdofs[cind])) {
4813             indices[foffs[f]+b] = -(off+foff+b+1);
4814             ++cind;
4815           } else {
4816             indices[foffs[f]+b] = off+foff+b-cind;
4817           }
4818         }
4819       }
4820     }
4821     foff     += (setBC ? fdof : (fdof - cfdof));
4822     foffs[f] += fdof;
4823   }
4824   PetscFunctionReturn(0);
4825 }
4826 
4827 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)
4828 {
4829   Mat             cMat;
4830   PetscSection    aSec, cSec;
4831   IS              aIS;
4832   PetscInt        aStart = -1, aEnd = -1;
4833   const PetscInt  *anchors;
4834   PetscInt        numFields, f, p, q, newP = 0;
4835   PetscInt        newNumPoints = 0, newNumIndices = 0;
4836   PetscInt        *newPoints, *indices, *newIndices;
4837   PetscInt        maxAnchor, maxDof;
4838   PetscInt        newOffsets[32];
4839   PetscInt        *pointMatOffsets[32];
4840   PetscInt        *newPointOffsets[32];
4841   PetscScalar     *pointMat[32];
4842   PetscScalar     *newValues=NULL,*tmpValues;
4843   PetscBool       anyConstrained = PETSC_FALSE;
4844   PetscErrorCode  ierr;
4845 
4846   PetscFunctionBegin;
4847   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4848   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4849   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4850 
4851   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4852   /* if there are point-to-point constraints */
4853   if (aSec) {
4854     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4855     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4856     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4857     /* figure out how many points are going to be in the new element matrix
4858      * (we allow double counting, because it's all just going to be summed
4859      * into the global matrix anyway) */
4860     for (p = 0; p < 2*numPoints; p+=2) {
4861       PetscInt b    = points[p];
4862       PetscInt bDof = 0, bSecDof;
4863 
4864       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4865       if (!bSecDof) {
4866         continue;
4867       }
4868       if (b >= aStart && b < aEnd) {
4869         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4870       }
4871       if (bDof) {
4872         /* this point is constrained */
4873         /* it is going to be replaced by its anchors */
4874         PetscInt bOff, q;
4875 
4876         anyConstrained = PETSC_TRUE;
4877         newNumPoints  += bDof;
4878         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4879         for (q = 0; q < bDof; q++) {
4880           PetscInt a = anchors[bOff + q];
4881           PetscInt aDof;
4882 
4883           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4884           newNumIndices += aDof;
4885           for (f = 0; f < numFields; ++f) {
4886             PetscInt fDof;
4887 
4888             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4889             newOffsets[f+1] += fDof;
4890           }
4891         }
4892       }
4893       else {
4894         /* this point is not constrained */
4895         newNumPoints++;
4896         newNumIndices += bSecDof;
4897         for (f = 0; f < numFields; ++f) {
4898           PetscInt fDof;
4899 
4900           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4901           newOffsets[f+1] += fDof;
4902         }
4903       }
4904     }
4905   }
4906   if (!anyConstrained) {
4907     if (outNumPoints)  *outNumPoints  = 0;
4908     if (outNumIndices) *outNumIndices = 0;
4909     if (outPoints)     *outPoints     = NULL;
4910     if (outValues)     *outValues     = NULL;
4911     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4912     PetscFunctionReturn(0);
4913   }
4914 
4915   if (outNumPoints)  *outNumPoints  = newNumPoints;
4916   if (outNumIndices) *outNumIndices = newNumIndices;
4917 
4918   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
4919 
4920   if (!outPoints && !outValues) {
4921     if (offsets) {
4922       for (f = 0; f <= numFields; f++) {
4923         offsets[f] = newOffsets[f];
4924       }
4925     }
4926     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4927     PetscFunctionReturn(0);
4928   }
4929 
4930   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
4931 
4932   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
4933 
4934   /* workspaces */
4935   if (numFields) {
4936     for (f = 0; f < numFields; f++) {
4937       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4938       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4939     }
4940   }
4941   else {
4942     ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4943     ierr = DMGetWorkArray(dm,numPoints,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4944   }
4945 
4946   /* get workspaces for the point-to-point matrices */
4947   if (numFields) {
4948     PetscInt totalOffset, totalMatOffset;
4949 
4950     for (p = 0; p < numPoints; p++) {
4951       PetscInt b    = points[2*p];
4952       PetscInt bDof = 0, bSecDof;
4953 
4954       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4955       if (!bSecDof) {
4956         for (f = 0; f < numFields; f++) {
4957           newPointOffsets[f][p + 1] = 0;
4958           pointMatOffsets[f][p + 1] = 0;
4959         }
4960         continue;
4961       }
4962       if (b >= aStart && b < aEnd) {
4963         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4964       }
4965       if (bDof) {
4966         for (f = 0; f < numFields; f++) {
4967           PetscInt fDof, q, bOff, allFDof = 0;
4968 
4969           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4970           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4971           for (q = 0; q < bDof; q++) {
4972             PetscInt a = anchors[bOff + q];
4973             PetscInt aFDof;
4974 
4975             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4976             allFDof += aFDof;
4977           }
4978           newPointOffsets[f][p+1] = allFDof;
4979           pointMatOffsets[f][p+1] = fDof * allFDof;
4980         }
4981       }
4982       else {
4983         for (f = 0; f < numFields; f++) {
4984           PetscInt fDof;
4985 
4986           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4987           newPointOffsets[f][p+1] = fDof;
4988           pointMatOffsets[f][p+1] = 0;
4989         }
4990       }
4991     }
4992     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
4993       newPointOffsets[f][0] = totalOffset;
4994       pointMatOffsets[f][0] = totalMatOffset;
4995       for (p = 0; p < numPoints; p++) {
4996         newPointOffsets[f][p+1] += newPointOffsets[f][p];
4997         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
4998       }
4999       totalOffset    = newPointOffsets[f][numPoints];
5000       totalMatOffset = pointMatOffsets[f][numPoints];
5001       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5002     }
5003   }
5004   else {
5005     for (p = 0; p < numPoints; p++) {
5006       PetscInt b    = points[2*p];
5007       PetscInt bDof = 0, bSecDof;
5008 
5009       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5010       if (!bSecDof) {
5011         newPointOffsets[0][p + 1] = 0;
5012         pointMatOffsets[0][p + 1] = 0;
5013         continue;
5014       }
5015       if (b >= aStart && b < aEnd) {
5016         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5017       }
5018       if (bDof) {
5019         PetscInt bOff, q, allDof = 0;
5020 
5021         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5022         for (q = 0; q < bDof; q++) {
5023           PetscInt a = anchors[bOff + q], aDof;
5024 
5025           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5026           allDof += aDof;
5027         }
5028         newPointOffsets[0][p+1] = allDof;
5029         pointMatOffsets[0][p+1] = bSecDof * allDof;
5030       }
5031       else {
5032         newPointOffsets[0][p+1] = bSecDof;
5033         pointMatOffsets[0][p+1] = 0;
5034       }
5035     }
5036     newPointOffsets[0][0] = 0;
5037     pointMatOffsets[0][0] = 0;
5038     for (p = 0; p < numPoints; p++) {
5039       newPointOffsets[0][p+1] += newPointOffsets[0][p];
5040       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
5041     }
5042     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5043   }
5044 
5045   /* output arrays */
5046   ierr = DMGetWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5047 
5048   /* get the point-to-point matrices; construct newPoints */
5049   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
5050   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
5051   ierr = DMGetWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5052   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5053   if (numFields) {
5054     for (p = 0, newP = 0; p < numPoints; p++) {
5055       PetscInt b    = points[2*p];
5056       PetscInt o    = points[2*p+1];
5057       PetscInt bDof = 0, bSecDof;
5058 
5059       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5060       if (!bSecDof) {
5061         continue;
5062       }
5063       if (b >= aStart && b < aEnd) {
5064         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5065       }
5066       if (bDof) {
5067         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
5068 
5069         fStart[0] = 0;
5070         fEnd[0]   = 0;
5071         for (f = 0; f < numFields; f++) {
5072           PetscInt fDof;
5073 
5074           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
5075           fStart[f+1] = fStart[f] + fDof;
5076           fEnd[f+1]   = fStart[f+1];
5077         }
5078         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5079         ierr = DMPlexGetIndicesPointFields_Internal(cSec, b, bOff, fEnd, PETSC_TRUE, perms, p, indices);CHKERRQ(ierr);
5080 
5081         fAnchorStart[0] = 0;
5082         fAnchorEnd[0]   = 0;
5083         for (f = 0; f < numFields; f++) {
5084           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
5085 
5086           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
5087           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
5088         }
5089         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5090         for (q = 0; q < bDof; q++) {
5091           PetscInt a = anchors[bOff + q], aOff;
5092 
5093           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5094           newPoints[2*(newP + q)]     = a;
5095           newPoints[2*(newP + q) + 1] = 0;
5096           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5097           ierr = DMPlexGetIndicesPointFields_Internal(section, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, newIndices);CHKERRQ(ierr);
5098         }
5099         newP += bDof;
5100 
5101         if (outValues) {
5102           /* get the point-to-point submatrix */
5103           for (f = 0; f < numFields; f++) {
5104             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
5105           }
5106         }
5107       }
5108       else {
5109         newPoints[2 * newP]     = b;
5110         newPoints[2 * newP + 1] = o;
5111         newP++;
5112       }
5113     }
5114   } else {
5115     for (p = 0; p < numPoints; p++) {
5116       PetscInt b    = points[2*p];
5117       PetscInt o    = points[2*p+1];
5118       PetscInt bDof = 0, bSecDof;
5119 
5120       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5121       if (!bSecDof) {
5122         continue;
5123       }
5124       if (b >= aStart && b < aEnd) {
5125         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5126       }
5127       if (bDof) {
5128         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
5129 
5130         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5131         ierr = DMPlexGetIndicesPoint_Internal(cSec, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, indices);CHKERRQ(ierr);
5132 
5133         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
5134         for (q = 0; q < bDof; q++) {
5135           PetscInt a = anchors[bOff + q], aOff;
5136 
5137           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5138 
5139           newPoints[2*(newP + q)]     = a;
5140           newPoints[2*(newP + q) + 1] = 0;
5141           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5142           ierr = DMPlexGetIndicesPoint_Internal(section, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, newIndices);CHKERRQ(ierr);
5143         }
5144         newP += bDof;
5145 
5146         /* get the point-to-point submatrix */
5147         if (outValues) {
5148           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
5149         }
5150       }
5151       else {
5152         newPoints[2 * newP]     = b;
5153         newPoints[2 * newP + 1] = o;
5154         newP++;
5155       }
5156     }
5157   }
5158 
5159   if (outValues) {
5160     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5161     ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
5162     /* multiply constraints on the right */
5163     if (numFields) {
5164       for (f = 0; f < numFields; f++) {
5165         PetscInt oldOff = offsets[f];
5166 
5167         for (p = 0; p < numPoints; p++) {
5168           PetscInt cStart = newPointOffsets[f][p];
5169           PetscInt b      = points[2 * p];
5170           PetscInt c, r, k;
5171           PetscInt dof;
5172 
5173           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5174           if (!dof) {
5175             continue;
5176           }
5177           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5178             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
5179             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
5180 
5181             for (r = 0; r < numIndices; r++) {
5182               for (c = 0; c < nCols; c++) {
5183                 for (k = 0; k < dof; k++) {
5184                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
5185                 }
5186               }
5187             }
5188           }
5189           else {
5190             /* copy this column as is */
5191             for (r = 0; r < numIndices; r++) {
5192               for (c = 0; c < dof; c++) {
5193                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5194               }
5195             }
5196           }
5197           oldOff += dof;
5198         }
5199       }
5200     }
5201     else {
5202       PetscInt oldOff = 0;
5203       for (p = 0; p < numPoints; p++) {
5204         PetscInt cStart = newPointOffsets[0][p];
5205         PetscInt b      = points[2 * p];
5206         PetscInt c, r, k;
5207         PetscInt dof;
5208 
5209         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5210         if (!dof) {
5211           continue;
5212         }
5213         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5214           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
5215           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
5216 
5217           for (r = 0; r < numIndices; r++) {
5218             for (c = 0; c < nCols; c++) {
5219               for (k = 0; k < dof; k++) {
5220                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
5221               }
5222             }
5223           }
5224         }
5225         else {
5226           /* copy this column as is */
5227           for (r = 0; r < numIndices; r++) {
5228             for (c = 0; c < dof; c++) {
5229               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5230             }
5231           }
5232         }
5233         oldOff += dof;
5234       }
5235     }
5236 
5237     if (multiplyLeft) {
5238       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5239       ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
5240       /* multiply constraints transpose on the left */
5241       if (numFields) {
5242         for (f = 0; f < numFields; f++) {
5243           PetscInt oldOff = offsets[f];
5244 
5245           for (p = 0; p < numPoints; p++) {
5246             PetscInt rStart = newPointOffsets[f][p];
5247             PetscInt b      = points[2 * p];
5248             PetscInt c, r, k;
5249             PetscInt dof;
5250 
5251             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5252             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5253               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
5254               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
5255 
5256               for (r = 0; r < nRows; r++) {
5257                 for (c = 0; c < newNumIndices; c++) {
5258                   for (k = 0; k < dof; k++) {
5259                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5260                   }
5261                 }
5262               }
5263             }
5264             else {
5265               /* copy this row as is */
5266               for (r = 0; r < dof; r++) {
5267                 for (c = 0; c < newNumIndices; c++) {
5268                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5269                 }
5270               }
5271             }
5272             oldOff += dof;
5273           }
5274         }
5275       }
5276       else {
5277         PetscInt oldOff = 0;
5278 
5279         for (p = 0; p < numPoints; p++) {
5280           PetscInt rStart = newPointOffsets[0][p];
5281           PetscInt b      = points[2 * p];
5282           PetscInt c, r, k;
5283           PetscInt dof;
5284 
5285           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5286           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5287             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
5288             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
5289 
5290             for (r = 0; r < nRows; r++) {
5291               for (c = 0; c < newNumIndices; c++) {
5292                 for (k = 0; k < dof; k++) {
5293                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5294                 }
5295               }
5296             }
5297           }
5298           else {
5299             /* copy this row as is */
5300             for (r = 0; r < dof; r++) {
5301               for (c = 0; c < newNumIndices; c++) {
5302                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5303               }
5304             }
5305           }
5306           oldOff += dof;
5307         }
5308       }
5309 
5310       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5311     }
5312     else {
5313       newValues = tmpValues;
5314     }
5315   }
5316 
5317   /* clean up */
5318   ierr = DMRestoreWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5319   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5320 
5321   if (numFields) {
5322     for (f = 0; f < numFields; f++) {
5323       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5324       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5325       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5326     }
5327   }
5328   else {
5329     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5330     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5331     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5332   }
5333   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5334 
5335   /* output */
5336   if (outPoints) {
5337     *outPoints = newPoints;
5338   }
5339   else {
5340     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5341   }
5342   if (outValues) {
5343     *outValues = newValues;
5344   }
5345   for (f = 0; f <= numFields; f++) {
5346     offsets[f] = newOffsets[f];
5347   }
5348   PetscFunctionReturn(0);
5349 }
5350 
5351 /*@C
5352   DMPlexGetClosureIndices - Get the global indices in a vector v for all points in the closure of the given point
5353 
5354   Not collective
5355 
5356   Input Parameters:
5357 + dm - The DM
5358 . section - The section describing the layout in v, or NULL to use the default section
5359 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5360 - point - The mesh point
5361 
5362   Output parameters:
5363 + numIndices - The number of indices
5364 . indices - The indices
5365 - outOffsets - Field offset if not NULL
5366 
5367   Note: Must call DMPlexRestoreClosureIndices() to free allocated memory
5368 
5369   Level: advanced
5370 
5371 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5372 @*/
5373 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices, PetscInt *outOffsets)
5374 {
5375   PetscSection    clSection;
5376   IS              clPoints;
5377   const PetscInt *clp;
5378   const PetscInt  **perms[32] = {NULL};
5379   PetscInt       *points = NULL, *pointsNew;
5380   PetscInt        numPoints, numPointsNew;
5381   PetscInt        offsets[32];
5382   PetscInt        Nf, Nind, NindNew, off, globalOff, f, p;
5383   PetscErrorCode  ierr;
5384 
5385   PetscFunctionBegin;
5386   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5387   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5388   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5389   if (numIndices) PetscValidPointer(numIndices, 4);
5390   PetscValidPointer(indices, 5);
5391   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
5392   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
5393   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5394   /* Get points in closure */
5395   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5396   /* Get number of indices and indices per field */
5397   for (p = 0, Nind = 0; p < numPoints*2; p += 2) {
5398     PetscInt dof, fdof;
5399 
5400     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5401     for (f = 0; f < Nf; ++f) {
5402       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5403       offsets[f+1] += fdof;
5404     }
5405     Nind += dof;
5406   }
5407   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
5408   if (Nf && offsets[Nf] != Nind) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Nind);
5409   if (!Nf) offsets[1] = Nind;
5410   /* Get dual space symmetries */
5411   for (f = 0; f < PetscMax(1,Nf); f++) {
5412     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5413     else    {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5414   }
5415   /* Correct for hanging node constraints */
5416   {
5417     ierr = DMPlexAnchorsModifyMat(dm, section, numPoints, Nind, points, perms, NULL, &numPointsNew, &NindNew, &pointsNew, NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
5418     if (numPointsNew) {
5419       for (f = 0; f < PetscMax(1,Nf); f++) {
5420         if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5421         else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5422       }
5423       for (f = 0; f < PetscMax(1,Nf); f++) {
5424         if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5425         else    {ierr = PetscSectionGetPointSyms(section,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5426       }
5427       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5428       numPoints = numPointsNew;
5429       Nind      = NindNew;
5430       points    = pointsNew;
5431     }
5432   }
5433   /* Calculate indices */
5434   ierr = DMGetWorkArray(dm, Nind, MPIU_INT, indices);CHKERRQ(ierr);
5435   if (Nf) {
5436     if (outOffsets) {
5437       PetscInt f;
5438 
5439       for (f = 0; f <= Nf; f++) {
5440         outOffsets[f] = offsets[f];
5441       }
5442     }
5443     for (p = 0; p < numPoints; p++) {
5444       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5445       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, *indices);
5446     }
5447   } else {
5448     for (p = 0, off = 0; p < numPoints; p++) {
5449       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5450 
5451       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5452       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, *indices);
5453     }
5454   }
5455   /* Cleanup points */
5456   for (f = 0; f < PetscMax(1,Nf); f++) {
5457     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5458     else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5459   }
5460   if (numPointsNew) {
5461     ierr = DMRestoreWorkArray(dm, 2*numPointsNew, MPIU_INT, &pointsNew);CHKERRQ(ierr);
5462   } else {
5463     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5464   }
5465   if (numIndices) *numIndices = Nind;
5466   PetscFunctionReturn(0);
5467 }
5468 
5469 /*@C
5470   DMPlexRestoreClosureIndices - Restore the indices in a vector v for all points in the closure of the given point
5471 
5472   Not collective
5473 
5474   Input Parameters:
5475 + dm - The DM
5476 . section - The section describing the layout in v, or NULL to use the default section
5477 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5478 . point - The mesh point
5479 . numIndices - The number of indices
5480 . indices - The indices
5481 - outOffsets - Field offset if not NULL
5482 
5483   Level: advanced
5484 
5485 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5486 @*/
5487 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices,PetscInt *outOffsets)
5488 {
5489   PetscErrorCode ierr;
5490 
5491   PetscFunctionBegin;
5492   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5493   PetscValidPointer(indices, 5);
5494   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
5495   PetscFunctionReturn(0);
5496 }
5497 
5498 /*@C
5499   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5500 
5501   Not collective
5502 
5503   Input Parameters:
5504 + dm - The DM
5505 . section - The section describing the layout in v, or NULL to use the default section
5506 . globalSection - The section describing the layout in v, or NULL to use the default global section
5507 . A - The matrix
5508 . point - The point in the DM
5509 . values - The array of values
5510 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5511 
5512   Fortran Notes:
5513   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5514 
5515   Level: intermediate
5516 
5517 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5518 @*/
5519 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5520 {
5521   DM_Plex            *mesh   = (DM_Plex*) dm->data;
5522   PetscSection        clSection;
5523   IS                  clPoints;
5524   PetscInt           *points = NULL, *newPoints;
5525   const PetscInt     *clp;
5526   PetscInt           *indices;
5527   PetscInt            offsets[32];
5528   const PetscInt    **perms[32] = {NULL};
5529   const PetscScalar **flips[32] = {NULL};
5530   PetscInt            numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, p, f;
5531   PetscScalar        *valCopy = NULL;
5532   PetscScalar        *newValues;
5533   PetscErrorCode      ierr;
5534 
5535   PetscFunctionBegin;
5536   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5537   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5538   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5539   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5540   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5541   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5542   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5543   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5544   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5545   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5546   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5547     PetscInt fdof;
5548 
5549     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5550     for (f = 0; f < numFields; ++f) {
5551       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5552       offsets[f+1] += fdof;
5553     }
5554     numIndices += dof;
5555   }
5556   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5557 
5558   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[numFields], numIndices);
5559   /* Get symmetries */
5560   for (f = 0; f < PetscMax(1,numFields); f++) {
5561     if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5562     else           {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5563     if (values && flips[f]) { /* may need to apply sign changes to the element matrix */
5564       PetscInt foffset = offsets[f];
5565 
5566       for (p = 0; p < numPoints; p++) {
5567         PetscInt point          = points[2*p], fdof;
5568         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
5569 
5570         if (!numFields) {
5571           ierr = PetscSectionGetDof(section,point,&fdof);CHKERRQ(ierr);
5572         } else {
5573           ierr = PetscSectionGetFieldDof(section,point,f,&fdof);CHKERRQ(ierr);
5574         }
5575         if (flip) {
5576           PetscInt i, j, k;
5577 
5578           if (!valCopy) {
5579             ierr = DMGetWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5580             for (j = 0; j < numIndices * numIndices; j++) valCopy[j] = values[j];
5581             values = valCopy;
5582           }
5583           for (i = 0; i < fdof; i++) {
5584             PetscScalar fval = flip[i];
5585 
5586             for (k = 0; k < numIndices; k++) {
5587               valCopy[numIndices * (foffset + i) + k] *= fval;
5588               valCopy[numIndices * k + (foffset + i)] *= fval;
5589             }
5590           }
5591         }
5592         foffset += fdof;
5593       }
5594     }
5595   }
5596   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,perms,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets,PETSC_TRUE);CHKERRQ(ierr);
5597   if (newNumPoints) {
5598     if (valCopy) {
5599       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5600     }
5601     for (f = 0; f < PetscMax(1,numFields); f++) {
5602       if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5603       else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5604     }
5605     for (f = 0; f < PetscMax(1,numFields); f++) {
5606       if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5607       else           {ierr = PetscSectionGetPointSyms(section,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5608     }
5609     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5610     numPoints  = newNumPoints;
5611     numIndices = newNumIndices;
5612     points     = newPoints;
5613     values     = newValues;
5614   }
5615   ierr = DMGetWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5616   if (numFields) {
5617     for (p = 0; p < numPoints; p++) {
5618       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5619       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, indices);
5620     }
5621   } else {
5622     for (p = 0, off = 0; p < numPoints; p++) {
5623       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5624       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5625       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, indices);
5626     }
5627   }
5628   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5629   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5630   if (mesh->printFEM > 1) {
5631     PetscInt i;
5632     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
5633     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
5634     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5635   }
5636   if (ierr) {
5637     PetscMPIInt    rank;
5638     PetscErrorCode ierr2;
5639 
5640     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5641     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5642     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5643     ierr2 = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr2);
5644     CHKERRQ(ierr);
5645   }
5646   for (f = 0; f < PetscMax(1,numFields); f++) {
5647     if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5648     else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5649   }
5650   if (newNumPoints) {
5651     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5652     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5653   }
5654   else {
5655     if (valCopy) {
5656       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5657     }
5658     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5659   }
5660   ierr = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5661   PetscFunctionReturn(0);
5662 }
5663 
5664 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5665 {
5666   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5667   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5668   PetscInt       *cpoints = NULL;
5669   PetscInt       *findices, *cindices;
5670   PetscInt        foffsets[32], coffsets[32];
5671   CellRefiner     cellRefiner;
5672   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5673   PetscErrorCode  ierr;
5674 
5675   PetscFunctionBegin;
5676   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5677   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5678   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5679   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5680   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5681   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5682   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5683   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5684   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5685   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5686   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5687   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5688   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5689   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5690   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5691   /* Column indices */
5692   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5693   maxFPoints = numCPoints;
5694   /* Compress out points not in the section */
5695   /*   TODO: Squeeze out points with 0 dof as well */
5696   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5697   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5698     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5699       cpoints[q*2]   = cpoints[p];
5700       cpoints[q*2+1] = cpoints[p+1];
5701       ++q;
5702     }
5703   }
5704   numCPoints = q;
5705   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5706     PetscInt fdof;
5707 
5708     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5709     if (!dof) continue;
5710     for (f = 0; f < numFields; ++f) {
5711       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5712       coffsets[f+1] += fdof;
5713     }
5714     numCIndices += dof;
5715   }
5716   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5717   /* Row indices */
5718   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5719   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5720   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5721   for (r = 0, q = 0; r < numSubcells; ++r) {
5722     /* TODO Map from coarse to fine cells */
5723     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5724     /* Compress out points not in the section */
5725     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5726     for (p = 0; p < numFPoints*2; p += 2) {
5727       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5728         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5729         if (!dof) continue;
5730         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5731         if (s < q) continue;
5732         ftotpoints[q*2]   = fpoints[p];
5733         ftotpoints[q*2+1] = fpoints[p+1];
5734         ++q;
5735       }
5736     }
5737     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5738   }
5739   numFPoints = q;
5740   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5741     PetscInt fdof;
5742 
5743     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5744     if (!dof) continue;
5745     for (f = 0; f < numFields; ++f) {
5746       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5747       foffsets[f+1] += fdof;
5748     }
5749     numFIndices += dof;
5750   }
5751   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5752 
5753   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5754   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5755   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5756   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5757   if (numFields) {
5758     const PetscInt **permsF[32] = {NULL};
5759     const PetscInt **permsC[32] = {NULL};
5760 
5761     for (f = 0; f < numFields; f++) {
5762       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5763       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5764     }
5765     for (p = 0; p < numFPoints; p++) {
5766       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5767       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5768     }
5769     for (p = 0; p < numCPoints; p++) {
5770       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5771       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5772     }
5773     for (f = 0; f < numFields; f++) {
5774       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5775       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5776     }
5777   } else {
5778     const PetscInt **permsF = NULL;
5779     const PetscInt **permsC = NULL;
5780 
5781     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5782     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5783     for (p = 0, off = 0; p < numFPoints; p++) {
5784       const PetscInt *perm = permsF ? permsF[p] : NULL;
5785 
5786       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5787       ierr = DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);CHKERRQ(ierr);
5788     }
5789     for (p = 0, off = 0; p < numCPoints; p++) {
5790       const PetscInt *perm = permsC ? permsC[p] : NULL;
5791 
5792       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5793       ierr = DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);CHKERRQ(ierr);
5794     }
5795     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5796     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5797   }
5798   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5799   /* TODO: flips */
5800   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5801   if (ierr) {
5802     PetscMPIInt    rank;
5803     PetscErrorCode ierr2;
5804 
5805     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5806     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5807     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5808     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
5809     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
5810     CHKERRQ(ierr);
5811   }
5812   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5813   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5814   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5815   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5816   PetscFunctionReturn(0);
5817 }
5818 
5819 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
5820 {
5821   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
5822   PetscInt      *cpoints = NULL;
5823   PetscInt       foffsets[32], coffsets[32];
5824   CellRefiner    cellRefiner;
5825   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5826   PetscErrorCode ierr;
5827 
5828   PetscFunctionBegin;
5829   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5830   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5831   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5832   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5833   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5834   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5835   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5836   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5837   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5838   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5839   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5840   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5841   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5842   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5843   /* Column indices */
5844   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5845   maxFPoints = numCPoints;
5846   /* Compress out points not in the section */
5847   /*   TODO: Squeeze out points with 0 dof as well */
5848   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5849   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5850     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5851       cpoints[q*2]   = cpoints[p];
5852       cpoints[q*2+1] = cpoints[p+1];
5853       ++q;
5854     }
5855   }
5856   numCPoints = q;
5857   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5858     PetscInt fdof;
5859 
5860     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5861     if (!dof) continue;
5862     for (f = 0; f < numFields; ++f) {
5863       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5864       coffsets[f+1] += fdof;
5865     }
5866     numCIndices += dof;
5867   }
5868   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5869   /* Row indices */
5870   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5871   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5872   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5873   for (r = 0, q = 0; r < numSubcells; ++r) {
5874     /* TODO Map from coarse to fine cells */
5875     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5876     /* Compress out points not in the section */
5877     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5878     for (p = 0; p < numFPoints*2; p += 2) {
5879       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5880         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5881         if (!dof) continue;
5882         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5883         if (s < q) continue;
5884         ftotpoints[q*2]   = fpoints[p];
5885         ftotpoints[q*2+1] = fpoints[p+1];
5886         ++q;
5887       }
5888     }
5889     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5890   }
5891   numFPoints = q;
5892   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5893     PetscInt fdof;
5894 
5895     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5896     if (!dof) continue;
5897     for (f = 0; f < numFields; ++f) {
5898       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5899       foffsets[f+1] += fdof;
5900     }
5901     numFIndices += dof;
5902   }
5903   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5904 
5905   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5906   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5907   if (numFields) {
5908     const PetscInt **permsF[32] = {NULL};
5909     const PetscInt **permsC[32] = {NULL};
5910 
5911     for (f = 0; f < numFields; f++) {
5912       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5913       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5914     }
5915     for (p = 0; p < numFPoints; p++) {
5916       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5917       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5918     }
5919     for (p = 0; p < numCPoints; p++) {
5920       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5921       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5922     }
5923     for (f = 0; f < numFields; f++) {
5924       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5925       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5926     }
5927   } else {
5928     const PetscInt **permsF = NULL;
5929     const PetscInt **permsC = NULL;
5930 
5931     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5932     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5933     for (p = 0, off = 0; p < numFPoints; p++) {
5934       const PetscInt *perm = permsF ? permsF[p] : NULL;
5935 
5936       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5937       DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);
5938     }
5939     for (p = 0, off = 0; p < numCPoints; p++) {
5940       const PetscInt *perm = permsC ? permsC[p] : NULL;
5941 
5942       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5943       DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);
5944     }
5945     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5946     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5947   }
5948   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5949   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5950   PetscFunctionReturn(0);
5951 }
5952 
5953 /*@
5954   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5955 
5956   Input Parameter:
5957 . dm - The DMPlex object
5958 
5959   Output Parameters:
5960 + cMax - The first hybrid cell
5961 . fMax - The first hybrid face
5962 . eMax - The first hybrid edge
5963 - vMax - The first hybrid vertex
5964 
5965   Level: developer
5966 
5967 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
5968 @*/
5969 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5970 {
5971   DM_Plex       *mesh = (DM_Plex*) dm->data;
5972   PetscInt       dim;
5973   PetscErrorCode ierr;
5974 
5975   PetscFunctionBegin;
5976   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5977   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5978   if (cMax) *cMax = mesh->hybridPointMax[dim];
5979   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5980   if (eMax) *eMax = mesh->hybridPointMax[1];
5981   if (vMax) *vMax = mesh->hybridPointMax[0];
5982   PetscFunctionReturn(0);
5983 }
5984 
5985 /*@
5986   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
5987 
5988   Input Parameters:
5989 . dm   - The DMPlex object
5990 . cMax - The first hybrid cell
5991 . fMax - The first hybrid face
5992 . eMax - The first hybrid edge
5993 - vMax - The first hybrid vertex
5994 
5995   Level: developer
5996 
5997 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
5998 @*/
5999 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6000 {
6001   DM_Plex       *mesh = (DM_Plex*) dm->data;
6002   PetscInt       dim;
6003   PetscErrorCode ierr;
6004 
6005   PetscFunctionBegin;
6006   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6007   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6008   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
6009   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
6010   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
6011   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
6012   PetscFunctionReturn(0);
6013 }
6014 
6015 /*@C
6016   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6017 
6018   Input Parameter:
6019 . dm   - The DMPlex object
6020 
6021   Output Parameter:
6022 . cellHeight - The height of a cell
6023 
6024   Level: developer
6025 
6026 .seealso DMPlexSetVTKCellHeight()
6027 @*/
6028 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6029 {
6030   DM_Plex *mesh = (DM_Plex*) dm->data;
6031 
6032   PetscFunctionBegin;
6033   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6034   PetscValidPointer(cellHeight, 2);
6035   *cellHeight = mesh->vtkCellHeight;
6036   PetscFunctionReturn(0);
6037 }
6038 
6039 /*@C
6040   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
6041 
6042   Input Parameters:
6043 + dm   - The DMPlex object
6044 - cellHeight - The height of a cell
6045 
6046   Level: developer
6047 
6048 .seealso DMPlexGetVTKCellHeight()
6049 @*/
6050 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6051 {
6052   DM_Plex *mesh = (DM_Plex*) dm->data;
6053 
6054   PetscFunctionBegin;
6055   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6056   mesh->vtkCellHeight = cellHeight;
6057   PetscFunctionReturn(0);
6058 }
6059 
6060 /* We can easily have a form that takes an IS instead */
6061 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
6062 {
6063   PetscSection   section, globalSection;
6064   PetscInt      *numbers, p;
6065   PetscErrorCode ierr;
6066 
6067   PetscFunctionBegin;
6068   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6069   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6070   for (p = pStart; p < pEnd; ++p) {
6071     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6072   }
6073   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6074   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6075   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
6076   for (p = pStart; p < pEnd; ++p) {
6077     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6078     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
6079     else                       numbers[p-pStart] += shift;
6080   }
6081   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6082   if (globalSize) {
6083     PetscLayout layout;
6084     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
6085     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
6086     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
6087   }
6088   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6089   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6090   PetscFunctionReturn(0);
6091 }
6092 
6093 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
6094 {
6095   PetscInt       cellHeight, cStart, cEnd, cMax;
6096   PetscErrorCode ierr;
6097 
6098   PetscFunctionBegin;
6099   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6100   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6101   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6102   if (cMax >= 0 && !includeHybrid) cEnd = PetscMin(cEnd, cMax);
6103   ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
6104   PetscFunctionReturn(0);
6105 }
6106 
6107 /*@C
6108   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
6109 
6110   Input Parameter:
6111 . dm   - The DMPlex object
6112 
6113   Output Parameter:
6114 . globalCellNumbers - Global cell numbers for all cells on this process
6115 
6116   Level: developer
6117 
6118 .seealso DMPlexGetVertexNumbering()
6119 @*/
6120 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6121 {
6122   DM_Plex       *mesh = (DM_Plex*) dm->data;
6123   PetscErrorCode ierr;
6124 
6125   PetscFunctionBegin;
6126   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6127   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
6128   *globalCellNumbers = mesh->globalCellNumbers;
6129   PetscFunctionReturn(0);
6130 }
6131 
6132 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
6133 {
6134   PetscInt       vStart, vEnd, vMax;
6135   PetscErrorCode ierr;
6136 
6137   PetscFunctionBegin;
6138   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6139   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6140   ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6141   if (vMax >= 0 && !includeHybrid) vEnd = PetscMin(vEnd, vMax);
6142   ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
6143   PetscFunctionReturn(0);
6144 }
6145 
6146 /*@C
6147   DMPlexGetVertexNumbering - Get a global certex numbering for all vertices on this process
6148 
6149   Input Parameter:
6150 . dm   - The DMPlex object
6151 
6152   Output Parameter:
6153 . globalVertexNumbers - Global vertex numbers for all vertices on this process
6154 
6155   Level: developer
6156 
6157 .seealso DMPlexGetCellNumbering()
6158 @*/
6159 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6160 {
6161   DM_Plex       *mesh = (DM_Plex*) dm->data;
6162   PetscErrorCode ierr;
6163 
6164   PetscFunctionBegin;
6165   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6166   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
6167   *globalVertexNumbers = mesh->globalVertexNumbers;
6168   PetscFunctionReturn(0);
6169 }
6170 
6171 /*@C
6172   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
6173 
6174   Input Parameter:
6175 . dm   - The DMPlex object
6176 
6177   Output Parameter:
6178 . globalPointNumbers - Global numbers for all points on this process
6179 
6180   Level: developer
6181 
6182 .seealso DMPlexGetCellNumbering()
6183 @*/
6184 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
6185 {
6186   IS             nums[4];
6187   PetscInt       depths[4];
6188   PetscInt       depth, d, shift = 0;
6189   PetscErrorCode ierr;
6190 
6191   PetscFunctionBegin;
6192   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6193   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6194   /* For unstratified meshes use dim instead of depth */
6195   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
6196   depths[0] = depth; depths[1] = 0;
6197   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
6198   for (d = 0; d <= depth; ++d) {
6199     PetscInt pStart, pEnd, gsize;
6200 
6201     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
6202     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
6203     shift += gsize;
6204   }
6205   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
6206   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
6207   PetscFunctionReturn(0);
6208 }
6209 
6210 
6211 /*@
6212   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
6213 
6214   Input Parameter:
6215 . dm - The DMPlex object
6216 
6217   Output Parameter:
6218 . ranks - The rank field
6219 
6220   Options Database Keys:
6221 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
6222 
6223   Level: intermediate
6224 
6225 .seealso: DMView()
6226 @*/
6227 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
6228 {
6229   DM             rdm;
6230   PetscDS        prob;
6231   PetscFE        fe;
6232   PetscScalar   *r;
6233   PetscMPIInt    rank;
6234   PetscInt       dim, cStart, cEnd, c;
6235   PetscErrorCode ierr;
6236 
6237   PetscFunctionBeginUser;
6238   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
6239   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
6240   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
6241   ierr = PetscFECreateDefault(rdm, dim, 1, PETSC_TRUE, NULL, -1, &fe);CHKERRQ(ierr);
6242   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
6243   ierr = DMGetDS(rdm, &prob);CHKERRQ(ierr);
6244   ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
6245   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
6246   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6247   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
6248   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
6249   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
6250   for (c = cStart; c < cEnd; ++c) {
6251     PetscScalar *lr;
6252 
6253     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
6254     *lr = rank;
6255   }
6256   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
6257   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
6258   PetscFunctionReturn(0);
6259 }
6260 
6261 /*@
6262   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6263 
6264   Input Parameter:
6265 . dm - The DMPlex object
6266 
6267   Note: This is a useful diagnostic when creating meshes programmatically.
6268 
6269   Level: developer
6270 
6271 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6272 @*/
6273 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6274 {
6275   PetscSection    coneSection, supportSection;
6276   const PetscInt *cone, *support;
6277   PetscInt        coneSize, c, supportSize, s;
6278   PetscInt        pStart, pEnd, p, csize, ssize;
6279   PetscErrorCode  ierr;
6280 
6281   PetscFunctionBegin;
6282   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6283   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6284   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6285   /* Check that point p is found in the support of its cone points, and vice versa */
6286   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6287   for (p = pStart; p < pEnd; ++p) {
6288     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6289     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6290     for (c = 0; c < coneSize; ++c) {
6291       PetscBool dup = PETSC_FALSE;
6292       PetscInt  d;
6293       for (d = c-1; d >= 0; --d) {
6294         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
6295       }
6296       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6297       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6298       for (s = 0; s < supportSize; ++s) {
6299         if (support[s] == p) break;
6300       }
6301       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
6302         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
6303         for (s = 0; s < coneSize; ++s) {
6304           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
6305         }
6306         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6307         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
6308         for (s = 0; s < supportSize; ++s) {
6309           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
6310         }
6311         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6312         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
6313         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
6314       }
6315     }
6316     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6317     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6318     for (s = 0; s < supportSize; ++s) {
6319       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6320       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6321       for (c = 0; c < coneSize; ++c) {
6322         if (cone[c] == p) break;
6323       }
6324       if (c >= coneSize) {
6325         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
6326         for (c = 0; c < supportSize; ++c) {
6327           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
6328         }
6329         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6330         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
6331         for (c = 0; c < coneSize; ++c) {
6332           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
6333         }
6334         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6335         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
6336       }
6337     }
6338   }
6339   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6340   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6341   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
6342   PetscFunctionReturn(0);
6343 }
6344 
6345 /*@
6346   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6347 
6348   Input Parameters:
6349 + dm - The DMPlex object
6350 . isSimplex - Are the cells simplices or tensor products
6351 - cellHeight - Normally 0
6352 
6353   Note: This is a useful diagnostic when creating meshes programmatically.
6354 
6355   Level: developer
6356 
6357 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6358 @*/
6359 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6360 {
6361   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6362   PetscErrorCode ierr;
6363 
6364   PetscFunctionBegin;
6365   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6366   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6367   switch (dim) {
6368   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6369   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6370   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6371   default:
6372     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %D", dim);
6373   }
6374   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6375   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6376   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6377   cMax = cMax >= 0 ? cMax : cEnd;
6378   for (c = cStart; c < cMax; ++c) {
6379     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6380 
6381     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6382     for (cl = 0; cl < closureSize*2; cl += 2) {
6383       const PetscInt p = closure[cl];
6384       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6385     }
6386     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6387     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has  %D vertices != %D", c, coneSize, numCorners);
6388   }
6389   for (c = cMax; c < cEnd; ++c) {
6390     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6391 
6392     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6393     for (cl = 0; cl < closureSize*2; cl += 2) {
6394       const PetscInt p = closure[cl];
6395       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6396     }
6397     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6398     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %D has  %D vertices > %D", c, coneSize, numHybridCorners);
6399   }
6400   PetscFunctionReturn(0);
6401 }
6402 
6403 /*@
6404   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6405 
6406   Input Parameters:
6407 + dm - The DMPlex object
6408 . isSimplex - Are the cells simplices or tensor products
6409 - cellHeight - Normally 0
6410 
6411   Note: This is a useful diagnostic when creating meshes programmatically.
6412 
6413   Level: developer
6414 
6415 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6416 @*/
6417 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6418 {
6419   PetscInt       pMax[4];
6420   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6421   PetscErrorCode ierr;
6422 
6423   PetscFunctionBegin;
6424   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6425   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6426   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6427   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6428   for (h = cellHeight; h < dim; ++h) {
6429     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6430     for (c = cStart; c < cEnd; ++c) {
6431       const PetscInt *cone, *ornt, *faces;
6432       PetscInt        numFaces, faceSize, coneSize,f;
6433       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6434 
6435       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6436       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6437       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6438       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6439       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6440       for (cl = 0; cl < closureSize*2; cl += 2) {
6441         const PetscInt p = closure[cl];
6442         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6443       }
6444       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6445       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D faces but should have %D", c, coneSize, numFaces);
6446       for (f = 0; f < numFaces; ++f) {
6447         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6448 
6449         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6450         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6451           const PetscInt p = fclosure[cl];
6452           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6453         }
6454         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);
6455         for (v = 0; v < fnumCorners; ++v) {
6456           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]);
6457         }
6458         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6459       }
6460       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6461       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6462     }
6463   }
6464   PetscFunctionReturn(0);
6465 }
6466 
6467 /* Pointwise interpolation
6468      Just code FEM for now
6469      u^f = I u^c
6470      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6471      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6472      I_{ij} = psi^f_i phi^c_j
6473 */
6474 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6475 {
6476   PetscSection   gsc, gsf;
6477   PetscInt       m, n;
6478   void          *ctx;
6479   DM             cdm;
6480   PetscBool      regular;
6481   PetscErrorCode ierr;
6482 
6483   PetscFunctionBegin;
6484   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6485   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6486   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6487   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6488 
6489   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6490   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6491   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6492   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6493 
6494   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6495   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6496   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6497   else                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6498   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
6499   /* Use naive scaling */
6500   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6501   PetscFunctionReturn(0);
6502 }
6503 
6504 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
6505 {
6506   PetscErrorCode ierr;
6507   VecScatter     ctx;
6508 
6509   PetscFunctionBegin;
6510   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
6511   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
6512   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
6513   PetscFunctionReturn(0);
6514 }
6515 
6516 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
6517 {
6518   PetscSection   gsc, gsf;
6519   PetscInt       m, n;
6520   void          *ctx;
6521   DM             cdm;
6522   PetscBool      regular;
6523   PetscErrorCode ierr;
6524 
6525   PetscFunctionBegin;
6526   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6527   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6528   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6529   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6530 
6531   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
6532   ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6533   ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
6534   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6535 
6536   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6537   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6538   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6539   else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6540   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
6541   PetscFunctionReturn(0);
6542 }
6543 
6544 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6545 {
6546   PetscSection   section;
6547   IS            *bcPoints, *bcComps;
6548   PetscBool     *isFE;
6549   PetscInt      *bcFields, *numComp, *numDof;
6550   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
6551   PetscInt       cStart, cEnd, cEndInterior;
6552   PetscErrorCode ierr;
6553 
6554   PetscFunctionBegin;
6555   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6556   if (!numFields) PetscFunctionReturn(0);
6557   /* FE and FV boundary conditions are handled slightly differently */
6558   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
6559   for (f = 0; f < numFields; ++f) {
6560     PetscObject  obj;
6561     PetscClassId id;
6562 
6563     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6564     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
6565     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
6566     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
6567     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
6568   }
6569   /* Allocate boundary point storage for FEM boundaries */
6570   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6571   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6572   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6573   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
6574   ierr = PetscDSGetNumBoundary(dm->prob, &numBd);CHKERRQ(ierr);
6575   for (bd = 0; bd < numBd; ++bd) {
6576     PetscInt                field;
6577     DMBoundaryConditionType type;
6578     const char             *labelName;
6579     DMLabel                 label;
6580 
6581     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &labelName, &field, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6582     ierr = DMGetLabel(dm,labelName,&label);CHKERRQ(ierr);
6583     if (label && isFE[field] && (type & DM_BC_ESSENTIAL)) ++numBC;
6584   }
6585   /* Add ghost cell boundaries for FVM */
6586   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
6587   ierr = PetscCalloc3(numBC,&bcFields,numBC,&bcPoints,numBC,&bcComps);CHKERRQ(ierr);
6588   /* Constrain ghost cells for FV */
6589   for (f = 0; f < numFields; ++f) {
6590     PetscInt *newidx, c;
6591 
6592     if (isFE[f] || cEndInterior < 0) continue;
6593     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
6594     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
6595     bcFields[bc] = f;
6596     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6597   }
6598   /* Handle FEM Dirichlet boundaries */
6599   for (bd = 0; bd < numBd; ++bd) {
6600     const char             *bdLabel;
6601     DMLabel                 label;
6602     const PetscInt         *comps;
6603     const PetscInt         *values;
6604     PetscInt                bd2, field, numComps, numValues;
6605     DMBoundaryConditionType type;
6606     PetscBool               duplicate = PETSC_FALSE;
6607 
6608     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &bdLabel, &field, &numComps, &comps, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6609     ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6610     if (!isFE[field] || !label) continue;
6611     /* Only want to modify label once */
6612     for (bd2 = 0; bd2 < bd; ++bd2) {
6613       const char *bdname;
6614       ierr = PetscDSGetBoundary(dm->prob, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6615       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
6616       if (duplicate) break;
6617     }
6618     if (!duplicate && (isFE[field])) {
6619       /* don't complete cells, which are just present to give orientation to the boundary */
6620       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6621     }
6622     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
6623     if (type & DM_BC_ESSENTIAL) {
6624       PetscInt       *newidx;
6625       PetscInt        n, newn = 0, p, v;
6626 
6627       bcFields[bc] = field;
6628       if (numComps) {ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), numComps, comps, PETSC_COPY_VALUES, &bcComps[bc]);CHKERRQ(ierr);}
6629       for (v = 0; v < numValues; ++v) {
6630         IS              tmp;
6631         const PetscInt *idx;
6632 
6633         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6634         if (!tmp) continue;
6635         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6636         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6637         if (isFE[field]) {
6638           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
6639         } else {
6640           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
6641         }
6642         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6643         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6644       }
6645       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
6646       newn = 0;
6647       for (v = 0; v < numValues; ++v) {
6648         IS              tmp;
6649         const PetscInt *idx;
6650 
6651         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6652         if (!tmp) continue;
6653         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6654         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6655         if (isFE[field]) {
6656           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
6657         } else {
6658           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
6659         }
6660         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6661         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6662       }
6663       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6664     }
6665   }
6666   /* Handle discretization */
6667   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6668   for (f = 0; f < numFields; ++f) {
6669     PetscObject obj;
6670 
6671     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6672     if (isFE[f]) {
6673       PetscFE         fe = (PetscFE) obj;
6674       const PetscInt *numFieldDof;
6675       PetscInt        d;
6676 
6677       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6678       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6679       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6680     } else {
6681       PetscFV fv = (PetscFV) obj;
6682 
6683       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
6684       numDof[f*(dim+1)+dim] = numComp[f];
6685     }
6686   }
6687   for (f = 0; f < numFields; ++f) {
6688     PetscInt d;
6689     for (d = 1; d < dim; ++d) {
6690       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.");
6691     }
6692   }
6693   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcComps, bcPoints, NULL, &section);CHKERRQ(ierr);
6694   for (f = 0; f < numFields; ++f) {
6695     PetscFE     fe;
6696     const char *name;
6697 
6698     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6699     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6700     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6701   }
6702   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6703   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6704   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);ierr = ISDestroy(&bcComps[bc]);CHKERRQ(ierr);}
6705   ierr = PetscFree3(bcFields,bcPoints,bcComps);CHKERRQ(ierr);
6706   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6707   ierr = PetscFree(isFE);CHKERRQ(ierr);
6708   PetscFunctionReturn(0);
6709 }
6710 
6711 /*@
6712   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6713 
6714   Input Parameter:
6715 . dm - The DMPlex object
6716 
6717   Output Parameter:
6718 . regular - The flag
6719 
6720   Level: intermediate
6721 
6722 .seealso: DMPlexSetRegularRefinement()
6723 @*/
6724 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
6725 {
6726   PetscFunctionBegin;
6727   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6728   PetscValidPointer(regular, 2);
6729   *regular = ((DM_Plex *) dm->data)->regularRefinement;
6730   PetscFunctionReturn(0);
6731 }
6732 
6733 /*@
6734   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6735 
6736   Input Parameters:
6737 + dm - The DMPlex object
6738 - regular - The flag
6739 
6740   Level: intermediate
6741 
6742 .seealso: DMPlexGetRegularRefinement()
6743 @*/
6744 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
6745 {
6746   PetscFunctionBegin;
6747   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6748   ((DM_Plex *) dm->data)->regularRefinement = regular;
6749   PetscFunctionReturn(0);
6750 }
6751 
6752 /* anchors */
6753 /*@
6754   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
6755   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
6756 
6757   not collective
6758 
6759   Input Parameters:
6760 . dm - The DMPlex object
6761 
6762   Output Parameters:
6763 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
6764 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
6765 
6766 
6767   Level: intermediate
6768 
6769 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
6770 @*/
6771 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
6772 {
6773   DM_Plex *plex = (DM_Plex *)dm->data;
6774   PetscErrorCode ierr;
6775 
6776   PetscFunctionBegin;
6777   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6778   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
6779   if (anchorSection) *anchorSection = plex->anchorSection;
6780   if (anchorIS) *anchorIS = plex->anchorIS;
6781   PetscFunctionReturn(0);
6782 }
6783 
6784 /*@
6785   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
6786   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
6787   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
6788 
6789   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
6790   DMGetConstraints() and filling in the entries in the constraint matrix.
6791 
6792   collective on dm
6793 
6794   Input Parameters:
6795 + dm - The DMPlex object
6796 . 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).
6797 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
6798 
6799   The reference counts of anchorSection and anchorIS are incremented.
6800 
6801   Level: intermediate
6802 
6803 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
6804 @*/
6805 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
6806 {
6807   DM_Plex        *plex = (DM_Plex *)dm->data;
6808   PetscMPIInt    result;
6809   PetscErrorCode ierr;
6810 
6811   PetscFunctionBegin;
6812   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6813   if (anchorSection) {
6814     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
6815     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
6816     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
6817   }
6818   if (anchorIS) {
6819     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
6820     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
6821     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
6822   }
6823 
6824   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
6825   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
6826   plex->anchorSection = anchorSection;
6827 
6828   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
6829   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
6830   plex->anchorIS = anchorIS;
6831 
6832 #if defined(PETSC_USE_DEBUG)
6833   if (anchorIS && anchorSection) {
6834     PetscInt size, a, pStart, pEnd;
6835     const PetscInt *anchors;
6836 
6837     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6838     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
6839     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
6840     for (a = 0; a < size; a++) {
6841       PetscInt p;
6842 
6843       p = anchors[a];
6844       if (p >= pStart && p < pEnd) {
6845         PetscInt dof;
6846 
6847         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6848         if (dof) {
6849           PetscErrorCode ierr2;
6850 
6851           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
6852           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
6853         }
6854       }
6855     }
6856     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
6857   }
6858 #endif
6859   /* reset the generic constraints */
6860   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
6861   PetscFunctionReturn(0);
6862 }
6863 
6864 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
6865 {
6866   PetscSection anchorSection;
6867   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
6868   PetscErrorCode ierr;
6869 
6870   PetscFunctionBegin;
6871   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6872   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
6873   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
6874   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6875   if (numFields) {
6876     PetscInt f;
6877     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
6878 
6879     for (f = 0; f < numFields; f++) {
6880       PetscInt numComp;
6881 
6882       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
6883       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
6884     }
6885   }
6886   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6887   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
6888   pStart = PetscMax(pStart,sStart);
6889   pEnd   = PetscMin(pEnd,sEnd);
6890   pEnd   = PetscMax(pStart,pEnd);
6891   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
6892   for (p = pStart; p < pEnd; p++) {
6893     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6894     if (dof) {
6895       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
6896       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
6897       for (f = 0; f < numFields; f++) {
6898         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
6899         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
6900       }
6901     }
6902   }
6903   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
6904   PetscFunctionReturn(0);
6905 }
6906 
6907 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
6908 {
6909   PetscSection aSec;
6910   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
6911   const PetscInt *anchors;
6912   PetscInt numFields, f;
6913   IS aIS;
6914   PetscErrorCode ierr;
6915 
6916   PetscFunctionBegin;
6917   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6918   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
6919   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
6920   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
6921   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
6922   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
6923   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
6924   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
6925   /* cSec will be a subset of aSec and section */
6926   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
6927   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
6928   i[0] = 0;
6929   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6930   for (p = pStart; p < pEnd; p++) {
6931     PetscInt rDof, rOff, r;
6932 
6933     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6934     if (!rDof) continue;
6935     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6936     if (numFields) {
6937       for (f = 0; f < numFields; f++) {
6938         annz = 0;
6939         for (r = 0; r < rDof; r++) {
6940           a = anchors[rOff + r];
6941           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6942           annz += aDof;
6943         }
6944         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6945         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
6946         for (q = 0; q < dof; q++) {
6947           i[off + q + 1] = i[off + q] + annz;
6948         }
6949       }
6950     }
6951     else {
6952       annz = 0;
6953       for (q = 0; q < dof; q++) {
6954         a = anchors[off + q];
6955         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6956         annz += aDof;
6957       }
6958       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6959       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
6960       for (q = 0; q < dof; q++) {
6961         i[off + q + 1] = i[off + q] + annz;
6962       }
6963     }
6964   }
6965   nnz = i[m];
6966   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
6967   offset = 0;
6968   for (p = pStart; p < pEnd; p++) {
6969     if (numFields) {
6970       for (f = 0; f < numFields; f++) {
6971         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6972         for (q = 0; q < dof; q++) {
6973           PetscInt rDof, rOff, r;
6974           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6975           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6976           for (r = 0; r < rDof; r++) {
6977             PetscInt s;
6978 
6979             a = anchors[rOff + r];
6980             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6981             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
6982             for (s = 0; s < aDof; s++) {
6983               j[offset++] = aOff + s;
6984             }
6985           }
6986         }
6987       }
6988     }
6989     else {
6990       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6991       for (q = 0; q < dof; q++) {
6992         PetscInt rDof, rOff, r;
6993         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6994         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6995         for (r = 0; r < rDof; r++) {
6996           PetscInt s;
6997 
6998           a = anchors[rOff + r];
6999           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7000           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
7001           for (s = 0; s < aDof; s++) {
7002             j[offset++] = aOff + s;
7003           }
7004         }
7005       }
7006     }
7007   }
7008   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
7009   ierr = PetscFree(i);CHKERRQ(ierr);
7010   ierr = PetscFree(j);CHKERRQ(ierr);
7011   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
7012   PetscFunctionReturn(0);
7013 }
7014 
7015 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
7016 {
7017   DM_Plex        *plex = (DM_Plex *)dm->data;
7018   PetscSection   anchorSection, section, cSec;
7019   Mat            cMat;
7020   PetscErrorCode ierr;
7021 
7022   PetscFunctionBegin;
7023   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7024   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
7025   if (anchorSection) {
7026     PetscDS  ds;
7027     PetscInt nf;
7028 
7029     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
7030     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
7031     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
7032     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
7033     ierr = PetscDSGetNumFields(ds,&nf);CHKERRQ(ierr);
7034     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
7035     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
7036     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
7037     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
7038   }
7039   PetscFunctionReturn(0);
7040 }
7041