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