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