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