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