xref: /petsc/src/dm/impls/plex/plex.c (revision f94b4a023f1c697a53e49ac853a9031583ab9737)
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->sfMigration) {
2139     (*subdm)->sfMigration = dm->sfMigration;
2140     if (dm->useNatural) {
2141       PetscSF        sfMigrationInv,sfNatural;
2142       PetscSection   section, sectionSeq;
2143 
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   }
2155   PetscFunctionReturn(0);
2156 }
2157 
2158 PetscErrorCode DMCreateSuperDM_Plex(DM dms[], PetscInt len, IS **is, DM *superdm)
2159 {
2160   PetscErrorCode ierr;
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   PetscFunctionReturn(0);
2166 }
2167 
2168 /*@
2169   DMPlexSymmetrize - Create support (out-edge) information from cone (in-edge) information
2170 
2171   Not collective
2172 
2173   Input Parameter:
2174 . mesh - The DMPlex
2175 
2176   Output Parameter:
2177 
2178   Note:
2179   This should be called after all calls to DMPlexSetCone()
2180 
2181   Level: beginner
2182 
2183 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
2184 @*/
2185 PetscErrorCode DMPlexSymmetrize(DM dm)
2186 {
2187   DM_Plex       *mesh = (DM_Plex*) dm->data;
2188   PetscInt      *offsets;
2189   PetscInt       supportSize;
2190   PetscInt       pStart, pEnd, p;
2191   PetscErrorCode ierr;
2192 
2193   PetscFunctionBegin;
2194   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2195   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
2196   /* Calculate support sizes */
2197   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2198   for (p = pStart; p < pEnd; ++p) {
2199     PetscInt dof, off, c;
2200 
2201     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2202     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2203     for (c = off; c < off+dof; ++c) {
2204       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
2205     }
2206   }
2207   for (p = pStart; p < pEnd; ++p) {
2208     PetscInt dof;
2209 
2210     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2211 
2212     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
2213   }
2214   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2215   /* Calculate supports */
2216   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
2217   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
2218   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
2219   for (p = pStart; p < pEnd; ++p) {
2220     PetscInt dof, off, c;
2221 
2222     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2223     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2224     for (c = off; c < off+dof; ++c) {
2225       const PetscInt q = mesh->cones[c];
2226       PetscInt       offS;
2227 
2228       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
2229 
2230       mesh->supports[offS+offsets[q]] = p;
2231       ++offsets[q];
2232     }
2233   }
2234   ierr = PetscFree(offsets);CHKERRQ(ierr);
2235   PetscFunctionReturn(0);
2236 }
2237 
2238 /*@
2239   DMPlexStratify - The DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
2240   can be illustrated by a Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
2241   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
2242   the DAG.
2243 
2244   Collective on dm
2245 
2246   Input Parameter:
2247 . mesh - The DMPlex
2248 
2249   Output Parameter:
2250 
2251   Notes:
2252   Concretely, DMPlexStratify() creates a new label named "depth" containing the dimension of each element: 0 for vertices,
2253   1 for edges, and so on.  The depth label can be accessed through DMPlexGetDepthLabel() or DMPlexGetDepthStratum(), or
2254   manually via DMGetLabel().  The height is defined implicitly by height = maxDimension - depth, and can be accessed
2255   via DMPlexGetHeightStratum().  For example, cells have height 0 and faces have height 1.
2256 
2257   DMPlexStratify() should be called after all calls to DMPlexSymmetrize()
2258 
2259   Level: beginner
2260 
2261 .seealso: DMPlexCreate(), DMPlexSymmetrize()
2262 @*/
2263 PetscErrorCode DMPlexStratify(DM dm)
2264 {
2265   DM_Plex       *mesh = (DM_Plex*) dm->data;
2266   DMLabel        label;
2267   PetscInt       pStart, pEnd, p;
2268   PetscInt       numRoots = 0, numLeaves = 0;
2269   PetscErrorCode ierr;
2270 
2271   PetscFunctionBegin;
2272   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2273   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2274   /* Calculate depth */
2275   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2276   ierr = DMCreateLabel(dm, "depth");CHKERRQ(ierr);
2277   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2278   /* Initialize roots and count leaves */
2279   for (p = pStart; p < pEnd; ++p) {
2280     PetscInt coneSize, supportSize;
2281 
2282     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2283     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2284     if (!coneSize && supportSize) {
2285       ++numRoots;
2286       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
2287     } else if (!supportSize && coneSize) {
2288       ++numLeaves;
2289     } else if (!supportSize && !coneSize) {
2290       /* Isolated points */
2291       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
2292     }
2293   }
2294   if (numRoots + numLeaves == (pEnd - pStart)) {
2295     for (p = pStart; p < pEnd; ++p) {
2296       PetscInt coneSize, supportSize;
2297 
2298       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2299       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2300       if (!supportSize && coneSize) {
2301         ierr = DMLabelSetValue(label, p, 1);CHKERRQ(ierr);
2302       }
2303     }
2304   } else {
2305     IS       pointIS;
2306     PetscInt numPoints = 0, level = 0;
2307 
2308     ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
2309     if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
2310     while (numPoints) {
2311       const PetscInt *points;
2312       const PetscInt  newLevel = level+1;
2313 
2314       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
2315       for (p = 0; p < numPoints; ++p) {
2316         const PetscInt  point = points[p];
2317         const PetscInt *support;
2318         PetscInt        supportSize, s;
2319 
2320         ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
2321         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
2322         for (s = 0; s < supportSize; ++s) {
2323           ierr = DMLabelSetValue(label, support[s], newLevel);CHKERRQ(ierr);
2324         }
2325       }
2326       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
2327       ++level;
2328       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2329       ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
2330       if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
2331       else         {numPoints = 0;}
2332     }
2333     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2334   }
2335   { /* just in case there is an empty process */
2336     PetscInt numValues, maxValues = 0, v;
2337 
2338     ierr = DMLabelGetNumValues(label,&numValues);CHKERRQ(ierr);
2339     for (v = 0; v < numValues; v++) {
2340       IS pointIS;
2341 
2342       ierr = DMLabelGetStratumIS(label, v, &pointIS);CHKERRQ(ierr);
2343       if (pointIS) {
2344         PetscInt  min, max, numPoints;
2345         PetscInt  start;
2346         PetscBool contig;
2347 
2348         ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
2349         ierr = ISGetMinMax(pointIS, &min, &max);CHKERRQ(ierr);
2350         ierr = ISContiguousLocal(pointIS,min,max+1,&start,&contig);CHKERRQ(ierr);
2351         if (start == 0 && contig) {
2352           ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2353           ierr = ISCreateStride(PETSC_COMM_SELF,numPoints,min,1,&pointIS);CHKERRQ(ierr);
2354           ierr = DMLabelSetStratumIS(label, v, pointIS);CHKERRQ(ierr);
2355         }
2356       }
2357       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2358     }
2359     ierr = MPI_Allreduce(&numValues,&maxValues,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
2360     for (v = numValues; v < maxValues; v++) {
2361       DMLabelAddStratum(label,v);CHKERRQ(ierr);
2362     }
2363   }
2364 
2365   ierr = DMLabelGetState(label, &mesh->depthState);CHKERRQ(ierr);
2366   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2367   PetscFunctionReturn(0);
2368 }
2369 
2370 /*@C
2371   DMPlexGetJoin - Get an array for the join of the set of points
2372 
2373   Not Collective
2374 
2375   Input Parameters:
2376 + dm - The DMPlex object
2377 . numPoints - The number of input points for the join
2378 - points - The input points
2379 
2380   Output Parameters:
2381 + numCoveredPoints - The number of points in the join
2382 - coveredPoints - The points in the join
2383 
2384   Level: intermediate
2385 
2386   Note: Currently, this is restricted to a single level join
2387 
2388   Fortran Notes:
2389   Since it returns an array, this routine is only available in Fortran 90, and you must
2390   include petsc.h90 in your code.
2391 
2392   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2393 
2394 .keywords: mesh
2395 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
2396 @*/
2397 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2398 {
2399   DM_Plex       *mesh = (DM_Plex*) dm->data;
2400   PetscInt      *join[2];
2401   PetscInt       joinSize, i = 0;
2402   PetscInt       dof, off, p, c, m;
2403   PetscErrorCode ierr;
2404 
2405   PetscFunctionBegin;
2406   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2407   PetscValidPointer(points, 2);
2408   PetscValidPointer(numCoveredPoints, 3);
2409   PetscValidPointer(coveredPoints, 4);
2410   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
2411   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
2412   /* Copy in support of first point */
2413   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
2414   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
2415   for (joinSize = 0; joinSize < dof; ++joinSize) {
2416     join[i][joinSize] = mesh->supports[off+joinSize];
2417   }
2418   /* Check each successive support */
2419   for (p = 1; p < numPoints; ++p) {
2420     PetscInt newJoinSize = 0;
2421 
2422     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
2423     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
2424     for (c = 0; c < dof; ++c) {
2425       const PetscInt point = mesh->supports[off+c];
2426 
2427       for (m = 0; m < joinSize; ++m) {
2428         if (point == join[i][m]) {
2429           join[1-i][newJoinSize++] = point;
2430           break;
2431         }
2432       }
2433     }
2434     joinSize = newJoinSize;
2435     i        = 1-i;
2436   }
2437   *numCoveredPoints = joinSize;
2438   *coveredPoints    = join[i];
2439   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
2440   PetscFunctionReturn(0);
2441 }
2442 
2443 /*@C
2444   DMPlexRestoreJoin - Restore an array for the join of the set of points
2445 
2446   Not Collective
2447 
2448   Input Parameters:
2449 + dm - The DMPlex object
2450 . numPoints - The number of input points for the join
2451 - points - The input points
2452 
2453   Output Parameters:
2454 + numCoveredPoints - The number of points in the join
2455 - coveredPoints - The points in the join
2456 
2457   Fortran Notes:
2458   Since it returns an array, this routine is only available in Fortran 90, and you must
2459   include petsc.h90 in your code.
2460 
2461   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2462 
2463   Level: intermediate
2464 
2465 .keywords: mesh
2466 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
2467 @*/
2468 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2469 {
2470   PetscErrorCode ierr;
2471 
2472   PetscFunctionBegin;
2473   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2474   if (points) PetscValidIntPointer(points,3);
2475   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2476   PetscValidPointer(coveredPoints, 5);
2477   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
2478   if (numCoveredPoints) *numCoveredPoints = 0;
2479   PetscFunctionReturn(0);
2480 }
2481 
2482 /*@C
2483   DMPlexGetFullJoin - Get an array for the join of the set of points
2484 
2485   Not Collective
2486 
2487   Input Parameters:
2488 + dm - The DMPlex object
2489 . numPoints - The number of input points for the join
2490 - points - The input points
2491 
2492   Output Parameters:
2493 + numCoveredPoints - The number of points in the join
2494 - coveredPoints - The points in the join
2495 
2496   Fortran Notes:
2497   Since it returns an array, this routine is only available in Fortran 90, and you must
2498   include petsc.h90 in your code.
2499 
2500   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2501 
2502   Level: intermediate
2503 
2504 .keywords: mesh
2505 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
2506 @*/
2507 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2508 {
2509   DM_Plex       *mesh = (DM_Plex*) dm->data;
2510   PetscInt      *offsets, **closures;
2511   PetscInt      *join[2];
2512   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
2513   PetscInt       p, d, c, m, ms;
2514   PetscErrorCode ierr;
2515 
2516   PetscFunctionBegin;
2517   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2518   PetscValidPointer(points, 2);
2519   PetscValidPointer(numCoveredPoints, 3);
2520   PetscValidPointer(coveredPoints, 4);
2521 
2522   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2523   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
2524   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
2525   ms      = mesh->maxSupportSize;
2526   maxSize = (ms > 1) ? ((PetscPowInt(ms,depth+1)-1)/(ms-1)) : depth + 1;
2527   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
2528   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
2529 
2530   for (p = 0; p < numPoints; ++p) {
2531     PetscInt closureSize;
2532 
2533     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
2534 
2535     offsets[p*(depth+2)+0] = 0;
2536     for (d = 0; d < depth+1; ++d) {
2537       PetscInt pStart, pEnd, i;
2538 
2539       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
2540       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
2541         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2542           offsets[p*(depth+2)+d+1] = i;
2543           break;
2544         }
2545       }
2546       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
2547     }
2548     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);
2549   }
2550   for (d = 0; d < depth+1; ++d) {
2551     PetscInt dof;
2552 
2553     /* Copy in support of first point */
2554     dof = offsets[d+1] - offsets[d];
2555     for (joinSize = 0; joinSize < dof; ++joinSize) {
2556       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
2557     }
2558     /* Check each successive cone */
2559     for (p = 1; p < numPoints && joinSize; ++p) {
2560       PetscInt newJoinSize = 0;
2561 
2562       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
2563       for (c = 0; c < dof; ++c) {
2564         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
2565 
2566         for (m = 0; m < joinSize; ++m) {
2567           if (point == join[i][m]) {
2568             join[1-i][newJoinSize++] = point;
2569             break;
2570           }
2571         }
2572       }
2573       joinSize = newJoinSize;
2574       i        = 1-i;
2575     }
2576     if (joinSize) break;
2577   }
2578   *numCoveredPoints = joinSize;
2579   *coveredPoints    = join[i];
2580   for (p = 0; p < numPoints; ++p) {
2581     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
2582   }
2583   ierr = PetscFree(closures);CHKERRQ(ierr);
2584   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
2585   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
2586   PetscFunctionReturn(0);
2587 }
2588 
2589 /*@C
2590   DMPlexGetMeet - Get an array for the meet of the set of points
2591 
2592   Not Collective
2593 
2594   Input Parameters:
2595 + dm - The DMPlex object
2596 . numPoints - The number of input points for the meet
2597 - points - The input points
2598 
2599   Output Parameters:
2600 + numCoveredPoints - The number of points in the meet
2601 - coveredPoints - The points in the meet
2602 
2603   Level: intermediate
2604 
2605   Note: Currently, this is restricted to a single level meet
2606 
2607   Fortran Notes:
2608   Since it returns an array, this routine is only available in Fortran 90, and you must
2609   include petsc.h90 in your code.
2610 
2611   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2612 
2613 .keywords: mesh
2614 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
2615 @*/
2616 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
2617 {
2618   DM_Plex       *mesh = (DM_Plex*) dm->data;
2619   PetscInt      *meet[2];
2620   PetscInt       meetSize, i = 0;
2621   PetscInt       dof, off, p, c, m;
2622   PetscErrorCode ierr;
2623 
2624   PetscFunctionBegin;
2625   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2626   PetscValidPointer(points, 2);
2627   PetscValidPointer(numCoveringPoints, 3);
2628   PetscValidPointer(coveringPoints, 4);
2629   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
2630   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
2631   /* Copy in cone of first point */
2632   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
2633   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
2634   for (meetSize = 0; meetSize < dof; ++meetSize) {
2635     meet[i][meetSize] = mesh->cones[off+meetSize];
2636   }
2637   /* Check each successive cone */
2638   for (p = 1; p < numPoints; ++p) {
2639     PetscInt newMeetSize = 0;
2640 
2641     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
2642     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
2643     for (c = 0; c < dof; ++c) {
2644       const PetscInt point = mesh->cones[off+c];
2645 
2646       for (m = 0; m < meetSize; ++m) {
2647         if (point == meet[i][m]) {
2648           meet[1-i][newMeetSize++] = point;
2649           break;
2650         }
2651       }
2652     }
2653     meetSize = newMeetSize;
2654     i        = 1-i;
2655   }
2656   *numCoveringPoints = meetSize;
2657   *coveringPoints    = meet[i];
2658   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
2659   PetscFunctionReturn(0);
2660 }
2661 
2662 /*@C
2663   DMPlexRestoreMeet - Restore an array for the meet of the set of points
2664 
2665   Not Collective
2666 
2667   Input Parameters:
2668 + dm - The DMPlex object
2669 . numPoints - The number of input points for the meet
2670 - points - The input points
2671 
2672   Output Parameters:
2673 + numCoveredPoints - The number of points in the meet
2674 - coveredPoints - The points in the meet
2675 
2676   Level: intermediate
2677 
2678   Fortran Notes:
2679   Since it returns an array, this routine is only available in Fortran 90, and you must
2680   include petsc.h90 in your code.
2681 
2682   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2683 
2684 .keywords: mesh
2685 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
2686 @*/
2687 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2688 {
2689   PetscErrorCode ierr;
2690 
2691   PetscFunctionBegin;
2692   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2693   if (points) PetscValidIntPointer(points,3);
2694   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2695   PetscValidPointer(coveredPoints,5);
2696   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
2697   if (numCoveredPoints) *numCoveredPoints = 0;
2698   PetscFunctionReturn(0);
2699 }
2700 
2701 /*@C
2702   DMPlexGetFullMeet - Get an array for the meet of the set of points
2703 
2704   Not Collective
2705 
2706   Input Parameters:
2707 + dm - The DMPlex object
2708 . numPoints - The number of input points for the meet
2709 - points - The input points
2710 
2711   Output Parameters:
2712 + numCoveredPoints - The number of points in the meet
2713 - coveredPoints - The points in the meet
2714 
2715   Level: intermediate
2716 
2717   Fortran Notes:
2718   Since it returns an array, this routine is only available in Fortran 90, and you must
2719   include petsc.h90 in your code.
2720 
2721   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2722 
2723 .keywords: mesh
2724 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
2725 @*/
2726 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2727 {
2728   DM_Plex       *mesh = (DM_Plex*) dm->data;
2729   PetscInt      *offsets, **closures;
2730   PetscInt      *meet[2];
2731   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
2732   PetscInt       p, h, c, m, mc;
2733   PetscErrorCode ierr;
2734 
2735   PetscFunctionBegin;
2736   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2737   PetscValidPointer(points, 2);
2738   PetscValidPointer(numCoveredPoints, 3);
2739   PetscValidPointer(coveredPoints, 4);
2740 
2741   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
2742   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
2743   ierr    = DMGetWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
2744   mc      = mesh->maxConeSize;
2745   maxSize = (mc > 1) ? ((PetscPowInt(mc,height+1)-1)/(mc-1)) : height + 1;
2746   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
2747   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
2748 
2749   for (p = 0; p < numPoints; ++p) {
2750     PetscInt closureSize;
2751 
2752     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
2753 
2754     offsets[p*(height+2)+0] = 0;
2755     for (h = 0; h < height+1; ++h) {
2756       PetscInt pStart, pEnd, i;
2757 
2758       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
2759       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
2760         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2761           offsets[p*(height+2)+h+1] = i;
2762           break;
2763         }
2764       }
2765       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
2766     }
2767     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);
2768   }
2769   for (h = 0; h < height+1; ++h) {
2770     PetscInt dof;
2771 
2772     /* Copy in cone of first point */
2773     dof = offsets[h+1] - offsets[h];
2774     for (meetSize = 0; meetSize < dof; ++meetSize) {
2775       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
2776     }
2777     /* Check each successive cone */
2778     for (p = 1; p < numPoints && meetSize; ++p) {
2779       PetscInt newMeetSize = 0;
2780 
2781       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
2782       for (c = 0; c < dof; ++c) {
2783         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
2784 
2785         for (m = 0; m < meetSize; ++m) {
2786           if (point == meet[i][m]) {
2787             meet[1-i][newMeetSize++] = point;
2788             break;
2789           }
2790         }
2791       }
2792       meetSize = newMeetSize;
2793       i        = 1-i;
2794     }
2795     if (meetSize) break;
2796   }
2797   *numCoveredPoints = meetSize;
2798   *coveredPoints    = meet[i];
2799   for (p = 0; p < numPoints; ++p) {
2800     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
2801   }
2802   ierr = PetscFree(closures);CHKERRQ(ierr);
2803   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
2804   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
2805   PetscFunctionReturn(0);
2806 }
2807 
2808 /*@C
2809   DMPlexEqual - Determine if two DMs have the same topology
2810 
2811   Not Collective
2812 
2813   Input Parameters:
2814 + dmA - A DMPlex object
2815 - dmB - A DMPlex object
2816 
2817   Output Parameters:
2818 . equal - PETSC_TRUE if the topologies are identical
2819 
2820   Level: intermediate
2821 
2822   Notes:
2823   We are not solving graph isomorphism, so we do not permutation.
2824 
2825 .keywords: mesh
2826 .seealso: DMPlexGetCone()
2827 @*/
2828 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
2829 {
2830   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
2831   PetscErrorCode ierr;
2832 
2833   PetscFunctionBegin;
2834   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
2835   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
2836   PetscValidPointer(equal, 3);
2837 
2838   *equal = PETSC_FALSE;
2839   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
2840   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
2841   if (depth != depthB) PetscFunctionReturn(0);
2842   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
2843   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
2844   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
2845   for (p = pStart; p < pEnd; ++p) {
2846     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
2847     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
2848 
2849     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
2850     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
2851     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
2852     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
2853     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
2854     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
2855     if (coneSize != coneSizeB) PetscFunctionReturn(0);
2856     for (c = 0; c < coneSize; ++c) {
2857       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
2858       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
2859     }
2860     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
2861     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
2862     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
2863     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
2864     if (supportSize != supportSizeB) PetscFunctionReturn(0);
2865     for (s = 0; s < supportSize; ++s) {
2866       if (support[s] != supportB[s]) PetscFunctionReturn(0);
2867     }
2868   }
2869   *equal = PETSC_TRUE;
2870   PetscFunctionReturn(0);
2871 }
2872 
2873 /*@C
2874   DMPlexGetNumFaceVertices - Returns the number of vertices on a face
2875 
2876   Not Collective
2877 
2878   Input Parameters:
2879 + dm         - The DMPlex
2880 . cellDim    - The cell dimension
2881 - numCorners - The number of vertices on a cell
2882 
2883   Output Parameters:
2884 . numFaceVertices - The number of vertices on a face
2885 
2886   Level: developer
2887 
2888   Notes:
2889   Of course this can only work for a restricted set of symmetric shapes
2890 
2891 .seealso: DMPlexGetCone()
2892 @*/
2893 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
2894 {
2895   MPI_Comm       comm;
2896   PetscErrorCode ierr;
2897 
2898   PetscFunctionBegin;
2899   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2900   PetscValidPointer(numFaceVertices,3);
2901   switch (cellDim) {
2902   case 0:
2903     *numFaceVertices = 0;
2904     break;
2905   case 1:
2906     *numFaceVertices = 1;
2907     break;
2908   case 2:
2909     switch (numCorners) {
2910     case 3: /* triangle */
2911       *numFaceVertices = 2; /* Edge has 2 vertices */
2912       break;
2913     case 4: /* quadrilateral */
2914       *numFaceVertices = 2; /* Edge has 2 vertices */
2915       break;
2916     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
2917       *numFaceVertices = 3; /* Edge has 3 vertices */
2918       break;
2919     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
2920       *numFaceVertices = 3; /* Edge has 3 vertices */
2921       break;
2922     default:
2923       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
2924     }
2925     break;
2926   case 3:
2927     switch (numCorners) {
2928     case 4: /* tetradehdron */
2929       *numFaceVertices = 3; /* Face has 3 vertices */
2930       break;
2931     case 6: /* tet cohesive cells */
2932       *numFaceVertices = 4; /* Face has 4 vertices */
2933       break;
2934     case 8: /* hexahedron */
2935       *numFaceVertices = 4; /* Face has 4 vertices */
2936       break;
2937     case 9: /* tet cohesive Lagrange cells */
2938       *numFaceVertices = 6; /* Face has 6 vertices */
2939       break;
2940     case 10: /* quadratic tetrahedron */
2941       *numFaceVertices = 6; /* Face has 6 vertices */
2942       break;
2943     case 12: /* hex cohesive Lagrange cells */
2944       *numFaceVertices = 6; /* Face has 6 vertices */
2945       break;
2946     case 18: /* quadratic tet cohesive Lagrange cells */
2947       *numFaceVertices = 6; /* Face has 6 vertices */
2948       break;
2949     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
2950       *numFaceVertices = 9; /* Face has 9 vertices */
2951       break;
2952     default:
2953       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
2954     }
2955     break;
2956   default:
2957     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %D", cellDim);
2958   }
2959   PetscFunctionReturn(0);
2960 }
2961 
2962 /*@
2963   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
2964 
2965   Not Collective
2966 
2967   Input Parameter:
2968 . dm    - The DMPlex object
2969 
2970   Output Parameter:
2971 . depthLabel - The DMLabel recording point depth
2972 
2973   Level: developer
2974 
2975 .keywords: mesh, points
2976 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2977 @*/
2978 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
2979 {
2980   PetscErrorCode ierr;
2981 
2982   PetscFunctionBegin;
2983   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2984   PetscValidPointer(depthLabel, 2);
2985   if (!dm->depthLabel) {ierr = DMGetLabel(dm, "depth", &dm->depthLabel);CHKERRQ(ierr);}
2986   *depthLabel = dm->depthLabel;
2987   PetscFunctionReturn(0);
2988 }
2989 
2990 /*@
2991   DMPlexGetDepth - Get the depth of the DAG representing this mesh
2992 
2993   Not Collective
2994 
2995   Input Parameter:
2996 . dm    - The DMPlex object
2997 
2998   Output Parameter:
2999 . depth - The number of strata (breadth first levels) in the DAG
3000 
3001   Level: developer
3002 
3003 .keywords: mesh, points
3004 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
3005 @*/
3006 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
3007 {
3008   DMLabel        label;
3009   PetscInt       d = 0;
3010   PetscErrorCode ierr;
3011 
3012   PetscFunctionBegin;
3013   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3014   PetscValidPointer(depth, 2);
3015   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3016   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
3017   *depth = d-1;
3018   PetscFunctionReturn(0);
3019 }
3020 
3021 /*@
3022   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
3023 
3024   Not Collective
3025 
3026   Input Parameters:
3027 + dm           - The DMPlex object
3028 - stratumValue - The requested depth
3029 
3030   Output Parameters:
3031 + start - The first point at this depth
3032 - end   - One beyond the last point at this depth
3033 
3034   Level: developer
3035 
3036 .keywords: mesh, points
3037 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
3038 @*/
3039 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3040 {
3041   DMLabel        label;
3042   PetscInt       pStart, pEnd;
3043   PetscErrorCode ierr;
3044 
3045   PetscFunctionBegin;
3046   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3047   if (start) {PetscValidPointer(start, 3); *start = 0;}
3048   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3049   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3050   if (pStart == pEnd) PetscFunctionReturn(0);
3051   if (stratumValue < 0) {
3052     if (start) *start = pStart;
3053     if (end)   *end   = pEnd;
3054     PetscFunctionReturn(0);
3055   }
3056   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3057   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3058   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
3059   PetscFunctionReturn(0);
3060 }
3061 
3062 /*@
3063   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
3064 
3065   Not Collective
3066 
3067   Input Parameters:
3068 + dm           - The DMPlex object
3069 - stratumValue - The requested height
3070 
3071   Output Parameters:
3072 + start - The first point at this height
3073 - end   - One beyond the last point at this height
3074 
3075   Level: developer
3076 
3077 .keywords: mesh, points
3078 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
3079 @*/
3080 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3081 {
3082   DMLabel        label;
3083   PetscInt       depth, pStart, pEnd;
3084   PetscErrorCode ierr;
3085 
3086   PetscFunctionBegin;
3087   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3088   if (start) {PetscValidPointer(start, 3); *start = 0;}
3089   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3090   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3091   if (pStart == pEnd) PetscFunctionReturn(0);
3092   if (stratumValue < 0) {
3093     if (start) *start = pStart;
3094     if (end)   *end   = pEnd;
3095     PetscFunctionReturn(0);
3096   }
3097   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3098   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3099   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
3100   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
3101   PetscFunctionReturn(0);
3102 }
3103 
3104 /* Set the number of dof on each point and separate by fields */
3105 static PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
3106 {
3107   PetscInt      *pMax;
3108   PetscInt       depth, cellHeight, pStart = 0, pEnd = 0;
3109   PetscInt       Nf, p, d, dep, f;
3110   PetscBool     *isFE;
3111   PetscErrorCode ierr;
3112 
3113   PetscFunctionBegin;
3114   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
3115   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
3116   for (f = 0; f < numFields; ++f) {
3117     PetscObject  obj;
3118     PetscClassId id;
3119 
3120     isFE[f] = PETSC_FALSE;
3121     if (f >= Nf) continue;
3122     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
3123     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3124     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
3125     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
3126   }
3127   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
3128   if (numFields > 0) {
3129     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
3130     if (numComp) {
3131       for (f = 0; f < numFields; ++f) {
3132         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
3133         if (isFE[f]) {
3134           PetscFE           fe;
3135           PetscDualSpace    dspace;
3136           const PetscInt    ***perms;
3137           const PetscScalar ***flips;
3138           const PetscInt    *numDof;
3139 
3140           ierr = DMGetField(dm,f,(PetscObject *) &fe);CHKERRQ(ierr);
3141           ierr = PetscFEGetDualSpace(fe,&dspace);CHKERRQ(ierr);
3142           ierr = PetscDualSpaceGetSymmetries(dspace,&perms,&flips);CHKERRQ(ierr);
3143           ierr = PetscDualSpaceGetNumDof(dspace,&numDof);CHKERRQ(ierr);
3144           if (perms || flips) {
3145             DM               K;
3146             DMLabel          depthLabel;
3147             PetscInt         depth, h;
3148             PetscSectionSym  sym;
3149 
3150             ierr = PetscDualSpaceGetDM(dspace,&K);CHKERRQ(ierr);
3151             ierr = DMPlexGetDepthLabel(dm,&depthLabel);CHKERRQ(ierr);
3152             ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
3153             ierr = PetscSectionSymCreateLabel(PetscObjectComm((PetscObject)*section),depthLabel,&sym);CHKERRQ(ierr);
3154             for (h = 0; h <= depth; h++) {
3155               PetscDualSpace    hspace;
3156               PetscInt          kStart, kEnd;
3157               PetscInt          kConeSize;
3158               const PetscInt    **perms0 = NULL;
3159               const PetscScalar **flips0 = NULL;
3160 
3161               ierr = PetscDualSpaceGetHeightSubspace(dspace,h,&hspace);CHKERRQ(ierr);
3162               ierr = DMPlexGetHeightStratum(K,h,&kStart,&kEnd);CHKERRQ(ierr);
3163               if (!hspace) continue;
3164               ierr = PetscDualSpaceGetSymmetries(hspace,&perms,&flips);CHKERRQ(ierr);
3165               if (perms) perms0 = perms[0];
3166               if (flips) flips0 = flips[0];
3167               if (!(perms0 || flips0)) continue;
3168               ierr = DMPlexGetConeSize(K,kStart,&kConeSize);CHKERRQ(ierr);
3169               ierr = PetscSectionSymLabelSetStratum(sym,depth - h,numDof[depth - h],-kConeSize,kConeSize,PETSC_USE_POINTER,perms0 ? &perms0[-kConeSize] : NULL,flips0 ? &flips0[-kConeSize] : NULL);CHKERRQ(ierr);
3170             }
3171             ierr = PetscSectionSetFieldSym(*section,f,sym);CHKERRQ(ierr);
3172             ierr = PetscSectionSymDestroy(&sym);CHKERRQ(ierr);
3173           }
3174         }
3175       }
3176     }
3177   }
3178   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3179   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
3180   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3181   ierr = PetscMalloc1(depth+1,&pMax);CHKERRQ(ierr);
3182   ierr = DMPlexGetHybridBounds(dm, depth >= 0 ? &pMax[depth] : NULL, depth>1 ? &pMax[depth-1] : NULL, depth>2 ? &pMax[1] : NULL, &pMax[0]);CHKERRQ(ierr);
3183   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
3184   for (dep = 0; dep <= depth - cellHeight; ++dep) {
3185     d    = dim == depth ? dep : (!dep ? 0 : dim);
3186     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
3187     pMax[dep] = pMax[dep] < 0 ? pEnd : pMax[dep];
3188     for (p = pStart; p < pEnd; ++p) {
3189       PetscInt tot = 0;
3190 
3191       for (f = 0; f < numFields; ++f) {
3192         if (isFE[f] && p >= pMax[dep]) continue;
3193         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
3194         tot += numDof[f*(dim+1)+d];
3195       }
3196       ierr = PetscSectionSetDof(*section, p, tot);CHKERRQ(ierr);
3197     }
3198   }
3199   ierr = PetscFree(pMax);CHKERRQ(ierr);
3200   ierr = PetscFree(isFE);CHKERRQ(ierr);
3201   PetscFunctionReturn(0);
3202 }
3203 
3204 /* Set the number of dof on each point and separate by fields
3205    If bcComps is NULL or the IS is NULL, constrain every dof on the point
3206 */
3207 static PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC, const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
3208 {
3209   PetscInt       numFields;
3210   PetscInt       bc;
3211   PetscSection   aSec;
3212   PetscErrorCode ierr;
3213 
3214   PetscFunctionBegin;
3215   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3216   for (bc = 0; bc < numBC; ++bc) {
3217     PetscInt        field = 0;
3218     const PetscInt *comp;
3219     const PetscInt *idx;
3220     PetscInt        Nc = -1, n, i;
3221 
3222     if (numFields) field = bcField[bc];
3223     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
3224     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3225     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
3226     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3227     for (i = 0; i < n; ++i) {
3228       const PetscInt p = idx[i];
3229       PetscInt       numConst;
3230 
3231       if (numFields) {
3232         ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
3233       } else {
3234         ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
3235       }
3236       /* If Nc < 0, constrain every dof on the point */
3237       if (Nc > 0) numConst = PetscMin(numConst, Nc);
3238       if (numFields) {ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);}
3239       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
3240     }
3241     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3242     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3243   }
3244   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
3245   if (aSec) {
3246     PetscInt aStart, aEnd, a;
3247 
3248     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
3249     for (a = aStart; a < aEnd; a++) {
3250       PetscInt dof, f;
3251 
3252       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3253       if (dof) {
3254         /* if there are point-to-point constraints, then all dofs are constrained */
3255         ierr = PetscSectionGetDof(section, a, &dof);CHKERRQ(ierr);
3256         ierr = PetscSectionSetConstraintDof(section, a, dof);CHKERRQ(ierr);
3257         for (f = 0; f < numFields; f++) {
3258           ierr = PetscSectionGetFieldDof(section, a, f, &dof);CHKERRQ(ierr);
3259           ierr = PetscSectionSetFieldConstraintDof(section, a, f, dof);CHKERRQ(ierr);
3260         }
3261       }
3262     }
3263   }
3264   PetscFunctionReturn(0);
3265 }
3266 
3267 /* Set the constrained field indices on each point
3268    If bcComps is NULL or the IS is NULL, constrain every dof on the point
3269 */
3270 static PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt numBC,const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
3271 {
3272   PetscSection   aSec;
3273   PetscInt      *indices;
3274   PetscInt       numFields, cdof, maxDof = 0, pStart, pEnd, p, bc, f, d;
3275   PetscErrorCode ierr;
3276 
3277   PetscFunctionBegin;
3278   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3279   if (!numFields) PetscFunctionReturn(0);
3280   /* Initialize all field indices to -1 */
3281   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3282   for (p = pStart; p < pEnd; ++p) {ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); maxDof = PetscMax(maxDof, cdof);}
3283   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3284   for (d = 0; d < maxDof; ++d) indices[d] = -1;
3285   for (p = pStart; p < pEnd; ++p) for (f = 0; f < numFields; ++f) {ierr = PetscSectionSetFieldConstraintIndices(section, p, f, indices);CHKERRQ(ierr);}
3286   /* Handle BC constraints */
3287   for (bc = 0; bc < numBC; ++bc) {
3288     const PetscInt  field = bcField[bc];
3289     const PetscInt *comp, *idx;
3290     PetscInt        Nc = -1, n, i;
3291 
3292     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
3293     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3294     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
3295     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3296     for (i = 0; i < n; ++i) {
3297       const PetscInt  p = idx[i];
3298       const PetscInt *find;
3299       PetscInt        fdof, fcdof, c;
3300 
3301       ierr = PetscSectionGetFieldDof(section, p, field, &fdof);CHKERRQ(ierr);
3302       if (!fdof) continue;
3303       if (Nc < 0) {
3304         for (d = 0; d < fdof; ++d) indices[d] = d;
3305         fcdof = fdof;
3306       } else {
3307         ierr = PetscSectionGetFieldConstraintDof(section, p, field, &fcdof);CHKERRQ(ierr);
3308         ierr = PetscSectionGetFieldConstraintIndices(section, p, field, &find);CHKERRQ(ierr);
3309         for (d = 0; d < fcdof; ++d) {if (find[d] < 0) break; indices[d] = find[d];}
3310         for (c = 0; c < Nc; ++c) indices[d++] = comp[c];
3311         ierr = PetscSortRemoveDupsInt(&d, indices);CHKERRQ(ierr);
3312         for (c = d; c < fcdof; ++c) indices[c] = -1;
3313         fcdof = d;
3314       }
3315       ierr = PetscSectionSetFieldConstraintDof(section, p, field, fcdof);CHKERRQ(ierr);
3316       ierr = PetscSectionSetFieldConstraintIndices(section, p, field, indices);CHKERRQ(ierr);
3317     }
3318     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3319     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3320   }
3321   /* Handle anchors */
3322   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
3323   if (aSec) {
3324     PetscInt aStart, aEnd, a;
3325 
3326     for (d = 0; d < maxDof; ++d) indices[d] = d;
3327     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
3328     for (a = aStart; a < aEnd; a++) {
3329       PetscInt dof, f;
3330 
3331       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3332       if (dof) {
3333         /* if there are point-to-point constraints, then all dofs are constrained */
3334         for (f = 0; f < numFields; f++) {
3335           ierr = PetscSectionSetFieldConstraintIndices(section, a, f, indices);CHKERRQ(ierr);
3336         }
3337       }
3338     }
3339   }
3340   ierr = PetscFree(indices);CHKERRQ(ierr);
3341   PetscFunctionReturn(0);
3342 }
3343 
3344 /* Set the constrained indices on each point */
3345 static PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
3346 {
3347   PetscInt      *indices;
3348   PetscInt       numFields, maxDof, pStart, pEnd, p, f, d;
3349   PetscErrorCode ierr;
3350 
3351   PetscFunctionBegin;
3352   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3353   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3354   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3355   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3356   for (d = 0; d < maxDof; ++d) indices[d] = -1;
3357   for (p = pStart; p < pEnd; ++p) {
3358     PetscInt cdof, d;
3359 
3360     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3361     if (cdof) {
3362       if (numFields) {
3363         PetscInt numConst = 0, foff = 0;
3364 
3365         for (f = 0; f < numFields; ++f) {
3366           const PetscInt *find;
3367           PetscInt        fcdof, fdof;
3368 
3369           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
3370           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
3371           /* Change constraint numbering from field component to local dof number */
3372           ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &find);CHKERRQ(ierr);
3373           for (d = 0; d < fcdof; ++d) indices[numConst+d] = find[d] + foff;
3374           numConst += fcdof;
3375           foff     += fdof;
3376         }
3377         if (cdof != numConst) {ierr = PetscSectionSetConstraintDof(section, p, numConst);CHKERRQ(ierr);}
3378       } else {
3379         for (d = 0; d < cdof; ++d) indices[d] = d;
3380       }
3381       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
3382     }
3383   }
3384   ierr = PetscFree(indices);CHKERRQ(ierr);
3385   PetscFunctionReturn(0);
3386 }
3387 
3388 /*@C
3389   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
3390 
3391   Not Collective
3392 
3393   Input Parameters:
3394 + dm        - The DMPlex object
3395 . dim       - The spatial dimension of the problem
3396 . numFields - The number of fields in the problem
3397 . numComp   - An array of size numFields that holds the number of components for each field
3398 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
3399 . numBC     - The number of boundary conditions
3400 . bcField   - An array of size numBC giving the field number for each boundry condition
3401 . bcComps   - [Optional] An array of size numBC giving an IS holding the field components to which each boundary condition applies
3402 . bcPoints  - An array of size numBC giving an IS holding the Plex points to which each boundary condition applies
3403 - perm      - Optional permutation of the chart, or NULL
3404 
3405   Output Parameter:
3406 . section - The PetscSection object
3407 
3408   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
3409   number of dof for field 0 on each edge.
3410 
3411   The chart permutation is the same one set using PetscSectionSetPermutation()
3412 
3413   Level: developer
3414 
3415   Fortran Notes:
3416   A Fortran 90 version is available as DMPlexCreateSectionF90()
3417 
3418 .keywords: mesh, elements
3419 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
3420 @*/
3421 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)
3422 {
3423   PetscSection   aSec;
3424   PetscErrorCode ierr;
3425 
3426   PetscFunctionBegin;
3427   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
3428   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3429   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
3430   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3431   ierr = DMPlexGetAnchors(dm,&aSec,NULL);CHKERRQ(ierr);
3432   if (numBC || aSec) {
3433     ierr = DMPlexCreateSectionBCIndicesField(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3434     ierr = DMPlexCreateSectionBCIndices(dm, *section);CHKERRQ(ierr);
3435   }
3436   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
3437   PetscFunctionReturn(0);
3438 }
3439 
3440 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3441 {
3442   PetscSection   section, s;
3443   Mat            m;
3444   PetscInt       maxHeight;
3445   PetscErrorCode ierr;
3446 
3447   PetscFunctionBegin;
3448   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
3449   ierr = DMPlexGetMaxProjectionHeight(dm, &maxHeight);CHKERRQ(ierr);
3450   ierr = DMPlexSetMaxProjectionHeight(*cdm, maxHeight);CHKERRQ(ierr);
3451   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
3452   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
3453   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
3454   ierr = PetscSectionCreate(PETSC_COMM_SELF, &s);CHKERRQ(ierr);
3455   ierr = MatCreate(PETSC_COMM_SELF, &m);CHKERRQ(ierr);
3456   ierr = DMSetDefaultConstraints(*cdm, s, m);CHKERRQ(ierr);
3457   ierr = PetscSectionDestroy(&s);CHKERRQ(ierr);
3458   ierr = MatDestroy(&m);CHKERRQ(ierr);
3459   PetscFunctionReturn(0);
3460 }
3461 
3462 /*@C
3463   DMPlexGetConeSection - Return a section which describes the layout of cone data
3464 
3465   Not Collective
3466 
3467   Input Parameters:
3468 . dm        - The DMPlex object
3469 
3470   Output Parameter:
3471 . section - The PetscSection object
3472 
3473   Level: developer
3474 
3475 .seealso: DMPlexGetSupportSection(), DMPlexGetCones(), DMPlexGetConeOrientations()
3476 @*/
3477 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
3478 {
3479   DM_Plex *mesh = (DM_Plex*) dm->data;
3480 
3481   PetscFunctionBegin;
3482   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3483   if (section) *section = mesh->coneSection;
3484   PetscFunctionReturn(0);
3485 }
3486 
3487 /*@C
3488   DMPlexGetSupportSection - Return a section which describes the layout of support data
3489 
3490   Not Collective
3491 
3492   Input Parameters:
3493 . dm        - The DMPlex object
3494 
3495   Output Parameter:
3496 . section - The PetscSection object
3497 
3498   Level: developer
3499 
3500 .seealso: DMPlexGetConeSection()
3501 @*/
3502 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
3503 {
3504   DM_Plex *mesh = (DM_Plex*) dm->data;
3505 
3506   PetscFunctionBegin;
3507   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3508   if (section) *section = mesh->supportSection;
3509   PetscFunctionReturn(0);
3510 }
3511 
3512 /*@C
3513   DMPlexGetCones - Return cone data
3514 
3515   Not Collective
3516 
3517   Input Parameters:
3518 . dm        - The DMPlex object
3519 
3520   Output Parameter:
3521 . cones - The cone for each point
3522 
3523   Level: developer
3524 
3525 .seealso: DMPlexGetConeSection()
3526 @*/
3527 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
3528 {
3529   DM_Plex *mesh = (DM_Plex*) dm->data;
3530 
3531   PetscFunctionBegin;
3532   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3533   if (cones) *cones = mesh->cones;
3534   PetscFunctionReturn(0);
3535 }
3536 
3537 /*@C
3538   DMPlexGetConeOrientations - Return cone orientation data
3539 
3540   Not Collective
3541 
3542   Input Parameters:
3543 . dm        - The DMPlex object
3544 
3545   Output Parameter:
3546 . coneOrientations - The cone orientation for each point
3547 
3548   Level: developer
3549 
3550 .seealso: DMPlexGetConeSection()
3551 @*/
3552 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
3553 {
3554   DM_Plex *mesh = (DM_Plex*) dm->data;
3555 
3556   PetscFunctionBegin;
3557   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3558   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
3559   PetscFunctionReturn(0);
3560 }
3561 
3562 /******************************** FEM Support **********************************/
3563 
3564 PetscErrorCode DMPlexCreateSpectralClosurePermutation(DM dm, PetscInt point, PetscSection section)
3565 {
3566   DMLabel        label;
3567   PetscInt      *perm;
3568   PetscInt       dim, depth, eStart, k, Nf, f, Nc, c, i, j, size = 0, offset = 0, foffset = 0;
3569   PetscErrorCode ierr;
3570 
3571   PetscFunctionBegin;
3572   if (point < 0) {ierr = DMPlexGetDepthStratum(dm, 1, &point, NULL);CHKERRQ(ierr);}
3573   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3574   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3575   ierr = DMLabelGetValue(label, point, &depth);CHKERRQ(ierr);
3576   if (depth == 1) {eStart = point;}
3577   else if  (depth == dim) {
3578     const PetscInt *cone;
3579 
3580     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3581     eStart = cone[0];
3582   } else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %D of depth %D cannot be used to bootstrap spectral ordering", point, depth);
3583   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3584   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
3585   if (dim <= 1) PetscFunctionReturn(0);
3586   for (f = 0; f < Nf; ++f) {
3587     /* An order k SEM disc has k-1 dofs on an edge */
3588     ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3589     ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3590     k = k/Nc + 1;
3591     size += PetscPowInt(k+1, dim)*Nc;
3592   }
3593   ierr = PetscMalloc1(size, &perm);CHKERRQ(ierr);
3594   for (f = 0; f < Nf; ++f) {
3595     switch (dim) {
3596     case 2:
3597       /* The original quad closure is oriented clockwise, {f, e_b, e_r, e_t, e_l, v_lb, v_rb, v_tr, v_tl} */
3598       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3599       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3600       k = k/Nc + 1;
3601       /* The SEM order is
3602 
3603          v_lb, {e_b}, v_rb,
3604          e^{(k-1)-i}_l, {f^{i*(k-1)}}, e^i_r,
3605          v_lt, reverse {e_t}, v_rt
3606       */
3607       {
3608         const PetscInt of   = 0;
3609         const PetscInt oeb  = of   + PetscSqr(k-1);
3610         const PetscInt oer  = oeb  + (k-1);
3611         const PetscInt oet  = oer  + (k-1);
3612         const PetscInt oel  = oet  + (k-1);
3613         const PetscInt ovlb = oel  + (k-1);
3614         const PetscInt ovrb = ovlb + 1;
3615         const PetscInt ovrt = ovrb + 1;
3616         const PetscInt ovlt = ovrt + 1;
3617         PetscInt       o;
3618 
3619         /* bottom */
3620         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlb*Nc + c + foffset;
3621         for (o = oeb; o < oer; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3622         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrb*Nc + c + foffset;
3623         /* middle */
3624         for (i = 0; i < k-1; ++i) {
3625           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oel+(k-2)-i)*Nc + c + foffset;
3626           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;
3627           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oer+i)*Nc + c + foffset;
3628         }
3629         /* top */
3630         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlt*Nc + c + foffset;
3631         for (o = oel-1; o >= oet; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3632         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrt*Nc + c + foffset;
3633         foffset = offset;
3634       }
3635       break;
3636     case 3:
3637       /* The original hex closure is
3638 
3639          {c,
3640           f_b, f_t, f_f, f_b, f_r, f_l,
3641           e_bl, e_bb, e_br, e_bf,  e_tf, e_tr, e_tb, e_tl,  e_rf, e_lf, e_lb, e_rb,
3642           v_blf, v_blb, v_brb, v_brf, v_tlf, v_trf, v_trb, v_tlb}
3643       */
3644       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3645       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3646       k = k/Nc + 1;
3647       /* The SEM order is
3648          Bottom Slice
3649          v_blf, {e^{(k-1)-n}_bf}, v_brf,
3650          e^{i}_bl, f^{n*(k-1)+(k-1)-i}_b, e^{(k-1)-i}_br,
3651          v_blb, {e_bb}, v_brb,
3652 
3653          Middle Slice (j)
3654          {e^{(k-1)-j}_lf}, {f^{j*(k-1)+n}_f}, e^j_rf,
3655          f^{i*(k-1)+j}_l, {c^{(j*(k-1) + i)*(k-1)+n}_t}, f^{j*(k-1)+i}_r,
3656          e^j_lb, {f^{j*(k-1)+(k-1)-n}_b}, e^{(k-1)-j}_rb,
3657 
3658          Top Slice
3659          v_tlf, {e_tf}, v_trf,
3660          e^{(k-1)-i}_tl, {f^{i*(k-1)}_t}, e^{i}_tr,
3661          v_tlb, {e^{(k-1)-n}_tb}, v_trb,
3662       */
3663       {
3664         const PetscInt oc    = 0;
3665         const PetscInt ofb   = oc    + PetscSqr(k-1)*(k-1);
3666         const PetscInt oft   = ofb   + PetscSqr(k-1);
3667         const PetscInt off   = oft   + PetscSqr(k-1);
3668         const PetscInt ofk   = off   + PetscSqr(k-1);
3669         const PetscInt ofr   = ofk   + PetscSqr(k-1);
3670         const PetscInt ofl   = ofr   + PetscSqr(k-1);
3671         const PetscInt oebl  = ofl   + PetscSqr(k-1);
3672         const PetscInt oebb  = oebl  + (k-1);
3673         const PetscInt oebr  = oebb  + (k-1);
3674         const PetscInt oebf  = oebr  + (k-1);
3675         const PetscInt oetf  = oebf  + (k-1);
3676         const PetscInt oetr  = oetf  + (k-1);
3677         const PetscInt oetb  = oetr  + (k-1);
3678         const PetscInt oetl  = oetb  + (k-1);
3679         const PetscInt oerf  = oetl  + (k-1);
3680         const PetscInt oelf  = oerf  + (k-1);
3681         const PetscInt oelb  = oelf  + (k-1);
3682         const PetscInt oerb  = oelb  + (k-1);
3683         const PetscInt ovblf = oerb  + (k-1);
3684         const PetscInt ovblb = ovblf + 1;
3685         const PetscInt ovbrb = ovblb + 1;
3686         const PetscInt ovbrf = ovbrb + 1;
3687         const PetscInt ovtlf = ovbrf + 1;
3688         const PetscInt ovtrf = ovtlf + 1;
3689         const PetscInt ovtrb = ovtrf + 1;
3690         const PetscInt ovtlb = ovtrb + 1;
3691         PetscInt       o, n;
3692 
3693         /* Bottom Slice */
3694         /*   bottom */
3695         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblf*Nc + c + foffset;
3696         for (o = oetf-1; o >= oebf; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3697         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrf*Nc + c + foffset;
3698         /*   middle */
3699         for (i = 0; i < k-1; ++i) {
3700           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebl+i)*Nc + c + foffset;
3701           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;}
3702           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebr+(k-2)-i)*Nc + c + foffset;
3703         }
3704         /*   top */
3705         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblb*Nc + c + foffset;
3706         for (o = oebb; o < oebr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3707         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrb*Nc + c + foffset;
3708 
3709         /* Middle Slice */
3710         for (j = 0; j < k-1; ++j) {
3711           /*   bottom */
3712           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelf+(k-2)-j)*Nc + c + foffset;
3713           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;
3714           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerf+j)*Nc + c + foffset;
3715           /*   middle */
3716           for (i = 0; i < k-1; ++i) {
3717             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofl+i*(k-1)+j)*Nc + c + foffset;
3718             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;
3719             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofr+j*(k-1)+i)*Nc + c + foffset;
3720           }
3721           /*   top */
3722           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelb+j)*Nc + c + foffset;
3723           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;
3724           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerb+(k-2)-j)*Nc + c + foffset;
3725         }
3726 
3727         /* Top Slice */
3728         /*   bottom */
3729         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlf*Nc + c + foffset;
3730         for (o = oetf; o < oetr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3731         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrf*Nc + c + foffset;
3732         /*   middle */
3733         for (i = 0; i < k-1; ++i) {
3734           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetl+(k-2)-i)*Nc + c + foffset;
3735           for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oft+i*(k-1)+n)*Nc + c + foffset;
3736           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetr+i)*Nc + c + foffset;
3737         }
3738         /*   top */
3739         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlb*Nc + c + foffset;
3740         for (o = oetl-1; o >= oetb; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3741         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrb*Nc + c + foffset;
3742 
3743         foffset = offset;
3744       }
3745       break;
3746     default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No spectral ordering for dimension %D", dim);
3747     }
3748   }
3749   if (offset != size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Number of permutation entries %D != %D", offset, size);
3750   /* Check permutation */
3751   {
3752     PetscInt *check;
3753 
3754     ierr = PetscMalloc1(size, &check);CHKERRQ(ierr);
3755     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]);}
3756     for (i = 0; i < size; ++i) check[perm[i]] = i;
3757     for (i = 0; i < size; ++i) {if (check[i] < 0) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Missing permutation index %D", i);}
3758     ierr = PetscFree(check);CHKERRQ(ierr);
3759   }
3760   ierr = PetscSectionSetClosurePermutation_Internal(section, (PetscObject) dm, size, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
3761   PetscFunctionReturn(0);
3762 }
3763 
3764 PetscErrorCode DMPlexGetPointDualSpaceFEM(DM dm, PetscInt point, PetscInt field, PetscDualSpace *dspace)
3765 {
3766   PetscDS        prob;
3767   PetscInt       depth, Nf, h;
3768   DMLabel        label;
3769   PetscErrorCode ierr;
3770 
3771   PetscFunctionBeginHot;
3772   prob    = dm->prob;
3773   Nf      = prob->Nf;
3774   label   = dm->depthLabel;
3775   *dspace = NULL;
3776   if (field < Nf) {
3777     PetscObject disc = prob->disc[field];
3778 
3779     if (disc->classid == PETSCFE_CLASSID) {
3780       PetscDualSpace dsp;
3781 
3782       ierr = PetscFEGetDualSpace((PetscFE)disc,&dsp);CHKERRQ(ierr);
3783       ierr = DMLabelGetNumValues(label,&depth);CHKERRQ(ierr);
3784       ierr = DMLabelGetValue(label,point,&h);CHKERRQ(ierr);
3785       h    = depth - 1 - h;
3786       if (h) {
3787         ierr = PetscDualSpaceGetHeightSubspace(dsp,h,dspace);CHKERRQ(ierr);
3788       } else {
3789         *dspace = dsp;
3790       }
3791     }
3792   }
3793   PetscFunctionReturn(0);
3794 }
3795 
3796 
3797 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3798 {
3799   PetscScalar    *array, *vArray;
3800   const PetscInt *cone, *coneO;
3801   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
3802   PetscErrorCode  ierr;
3803 
3804   PetscFunctionBeginHot;
3805   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3806   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3807   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3808   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3809   if (!values || !*values) {
3810     if ((point >= pStart) && (point < pEnd)) {
3811       PetscInt dof;
3812 
3813       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3814       size += dof;
3815     }
3816     for (p = 0; p < numPoints; ++p) {
3817       const PetscInt cp = cone[p];
3818       PetscInt       dof;
3819 
3820       if ((cp < pStart) || (cp >= pEnd)) continue;
3821       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3822       size += dof;
3823     }
3824     if (!values) {
3825       if (csize) *csize = size;
3826       PetscFunctionReturn(0);
3827     }
3828     ierr = DMGetWorkArray(dm, size, MPIU_SCALAR, &array);CHKERRQ(ierr);
3829   } else {
3830     array = *values;
3831   }
3832   size = 0;
3833   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3834   if ((point >= pStart) && (point < pEnd)) {
3835     PetscInt     dof, off, d;
3836     PetscScalar *varr;
3837 
3838     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3839     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3840     varr = &vArray[off];
3841     for (d = 0; d < dof; ++d, ++offset) {
3842       array[offset] = varr[d];
3843     }
3844     size += dof;
3845   }
3846   for (p = 0; p < numPoints; ++p) {
3847     const PetscInt cp = cone[p];
3848     PetscInt       o  = coneO[p];
3849     PetscInt       dof, off, d;
3850     PetscScalar   *varr;
3851 
3852     if ((cp < pStart) || (cp >= pEnd)) continue;
3853     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3854     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3855     varr = &vArray[off];
3856     if (o >= 0) {
3857       for (d = 0; d < dof; ++d, ++offset) {
3858         array[offset] = varr[d];
3859       }
3860     } else {
3861       for (d = dof-1; d >= 0; --d, ++offset) {
3862         array[offset] = varr[d];
3863       }
3864     }
3865     size += dof;
3866   }
3867   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3868   if (!*values) {
3869     if (csize) *csize = size;
3870     *values = array;
3871   } else {
3872     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
3873     *csize = size;
3874   }
3875   PetscFunctionReturn(0);
3876 }
3877 
3878 static PetscErrorCode DMPlexGetCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3879 {
3880   const PetscInt *cla;
3881   PetscInt       np, *pts = NULL;
3882   PetscErrorCode ierr;
3883 
3884   PetscFunctionBeginHot;
3885   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, clSec, clPoints);CHKERRQ(ierr);
3886   if (!*clPoints) {
3887     PetscInt pStart, pEnd, p, q;
3888 
3889     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3890     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &np, &pts);CHKERRQ(ierr);
3891     /* Compress out points not in the section */
3892     for (p = 0, q = 0; p < np; p++) {
3893       PetscInt r = pts[2*p];
3894       if ((r >= pStart) && (r < pEnd)) {
3895         pts[q*2]   = r;
3896         pts[q*2+1] = pts[2*p+1];
3897         ++q;
3898       }
3899     }
3900     np = q;
3901     cla = NULL;
3902   } else {
3903     PetscInt dof, off;
3904 
3905     ierr = PetscSectionGetDof(*clSec, point, &dof);CHKERRQ(ierr);
3906     ierr = PetscSectionGetOffset(*clSec, point, &off);CHKERRQ(ierr);
3907     ierr = ISGetIndices(*clPoints, &cla);CHKERRQ(ierr);
3908     np   = dof/2;
3909     pts  = (PetscInt *) &cla[off];
3910   }
3911   *numPoints = np;
3912   *points    = pts;
3913   *clp       = cla;
3914 
3915   PetscFunctionReturn(0);
3916 }
3917 
3918 static PetscErrorCode DMPlexRestoreCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3919 {
3920   PetscErrorCode ierr;
3921 
3922   PetscFunctionBeginHot;
3923   if (!*clPoints) {
3924     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, numPoints, points);CHKERRQ(ierr);
3925   } else {
3926     ierr = ISRestoreIndices(*clPoints, clp);CHKERRQ(ierr);
3927   }
3928   *numPoints = 0;
3929   *points    = NULL;
3930   *clSec     = NULL;
3931   *clPoints  = NULL;
3932   *clp       = NULL;
3933   PetscFunctionReturn(0);
3934 }
3935 
3936 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[])
3937 {
3938   PetscInt          offset = 0, p;
3939   const PetscInt    **perms = NULL;
3940   const PetscScalar **flips = NULL;
3941   PetscErrorCode    ierr;
3942 
3943   PetscFunctionBeginHot;
3944   *size = 0;
3945   ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3946   for (p = 0; p < numPoints; p++) {
3947     const PetscInt    point = points[2*p];
3948     const PetscInt    *perm = perms ? perms[p] : NULL;
3949     const PetscScalar *flip = flips ? flips[p] : NULL;
3950     PetscInt          dof, off, d;
3951     const PetscScalar *varr;
3952 
3953     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3954     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3955     varr = &vArray[off];
3956     if (clperm) {
3957       if (perm) {
3958         for (d = 0; d < dof; d++) array[clperm[offset + perm[d]]]  = varr[d];
3959       } else {
3960         for (d = 0; d < dof; d++) array[clperm[offset +      d ]]  = varr[d];
3961       }
3962       if (flip) {
3963         for (d = 0; d < dof; d++) array[clperm[offset +      d ]] *= flip[d];
3964       }
3965     } else {
3966       if (perm) {
3967         for (d = 0; d < dof; d++) array[offset + perm[d]]  = varr[d];
3968       } else {
3969         for (d = 0; d < dof; d++) array[offset +      d ]  = varr[d];
3970       }
3971       if (flip) {
3972         for (d = 0; d < dof; d++) array[offset +      d ] *= flip[d];
3973       }
3974     }
3975     offset += dof;
3976   }
3977   ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3978   *size = offset;
3979   PetscFunctionReturn(0);
3980 }
3981 
3982 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[])
3983 {
3984   PetscInt          offset = 0, f;
3985   PetscErrorCode    ierr;
3986 
3987   PetscFunctionBeginHot;
3988   *size = 0;
3989   for (f = 0; f < numFields; ++f) {
3990     PetscInt          p;
3991     const PetscInt    **perms = NULL;
3992     const PetscScalar **flips = NULL;
3993 
3994     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3995     for (p = 0; p < numPoints; p++) {
3996       const PetscInt    point = points[2*p];
3997       PetscInt          fdof, foff, b;
3998       const PetscScalar *varr;
3999       const PetscInt    *perm = perms ? perms[p] : NULL;
4000       const PetscScalar *flip = flips ? flips[p] : NULL;
4001 
4002       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4003       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4004       varr = &vArray[foff];
4005       if (clperm) {
4006         if (perm) {for (b = 0; b < fdof; b++) {array[clperm[offset + perm[b]]]  = varr[b];}}
4007         else      {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]]  = varr[b];}}
4008         if (flip) {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]] *= flip[b];}}
4009       } else {
4010         if (perm) {for (b = 0; b < fdof; b++) {array[offset + perm[b]]  = varr[b];}}
4011         else      {for (b = 0; b < fdof; b++) {array[offset +      b ]  = varr[b];}}
4012         if (flip) {for (b = 0; b < fdof; b++) {array[offset +      b ] *= flip[b];}}
4013       }
4014       offset += fdof;
4015     }
4016     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4017   }
4018   *size = offset;
4019   PetscFunctionReturn(0);
4020 }
4021 
4022 /*@C
4023   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4024 
4025   Not collective
4026 
4027   Input Parameters:
4028 + dm - The DM
4029 . section - The section describing the layout in v, or NULL to use the default section
4030 . v - The local vector
4031 . point - The point in the DM
4032 . csize - The size of the input values array, or NULL
4033 - values - An array to use for the values, or NULL to have it allocated automatically
4034 
4035   Output Parameters:
4036 + csize - The number of values in the closure
4037 - values - The array of values. If the user provided NULL, it is a borrowed array and should not be freed
4038 
4039 $ Note that DMPlexVecGetClosure/DMPlexVecRestoreClosure only allocates the values array if it set to NULL in the
4040 $ calling function. This is because DMPlexVecGetClosure() is typically called in the inner loop of a Vec or Mat
4041 $ assembly function, and a user may already have allocated storage for this operation.
4042 $
4043 $ A typical use could be
4044 $
4045 $  values = NULL;
4046 $  ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4047 $  for (cl = 0; cl < clSize; ++cl) {
4048 $    <Compute on closure>
4049 $  }
4050 $  ierr = DMPlexVecRestoreClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4051 $
4052 $ or
4053 $
4054 $  PetscMalloc1(clMaxSize, &values);
4055 $  for (p = pStart; p < pEnd; ++p) {
4056 $    clSize = clMaxSize;
4057 $    ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4058 $    for (cl = 0; cl < clSize; ++cl) {
4059 $      <Compute on closure>
4060 $    }
4061 $  }
4062 $  PetscFree(values);
4063 
4064   Fortran Notes:
4065   Since it returns an array, this routine is only available in Fortran 90, and you must
4066   include petsc.h90 in your code.
4067 
4068   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4069 
4070   Level: intermediate
4071 
4072 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4073 @*/
4074 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4075 {
4076   PetscSection       clSection;
4077   IS                 clPoints;
4078   PetscScalar       *array;
4079   const PetscScalar *vArray;
4080   PetscInt          *points = NULL;
4081   const PetscInt    *clp, *perm;
4082   PetscInt           depth, numFields, numPoints, size;
4083   PetscErrorCode     ierr;
4084 
4085   PetscFunctionBeginHot;
4086   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4087   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4088   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4089   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4090   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4091   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4092   if (depth == 1 && numFields < 2) {
4093     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4094     PetscFunctionReturn(0);
4095   }
4096   /* Get points */
4097   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4098   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &perm);CHKERRQ(ierr);
4099   /* Get array */
4100   if (!values || !*values) {
4101     PetscInt asize = 0, dof, p;
4102 
4103     for (p = 0; p < numPoints*2; p += 2) {
4104       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4105       asize += dof;
4106     }
4107     if (!values) {
4108       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4109       if (csize) *csize = asize;
4110       PetscFunctionReturn(0);
4111     }
4112     ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, &array);CHKERRQ(ierr);
4113   } else {
4114     array = *values;
4115   }
4116   ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4117   /* Get values */
4118   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, numPoints, points, numFields, perm, vArray, &size, array);CHKERRQ(ierr);}
4119   else               {ierr = DMPlexVecGetClosure_Static(dm, section, numPoints, points, perm, vArray, &size, array);CHKERRQ(ierr);}
4120   /* Cleanup points */
4121   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4122   /* Cleanup array */
4123   ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4124   if (!*values) {
4125     if (csize) *csize = size;
4126     *values = array;
4127   } else {
4128     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4129     *csize = size;
4130   }
4131   PetscFunctionReturn(0);
4132 }
4133 
4134 /*@C
4135   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
4136 
4137   Not collective
4138 
4139   Input Parameters:
4140 + dm - The DM
4141 . section - The section describing the layout in v, or NULL to use the default section
4142 . v - The local vector
4143 . point - The point in the DM
4144 . csize - The number of values in the closure, or NULL
4145 - values - The array of values, which is a borrowed array and should not be freed
4146 
4147   Note that the array values are discarded and not copied back into v. In order to copy values back to v, use DMPlexVecSetClosure()
4148 
4149   Fortran Notes:
4150   Since it returns an array, this routine is only available in Fortran 90, and you must
4151   include petsc.h90 in your code.
4152 
4153   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4154 
4155   Level: intermediate
4156 
4157 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4158 @*/
4159 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4160 {
4161   PetscInt       size = 0;
4162   PetscErrorCode ierr;
4163 
4164   PetscFunctionBegin;
4165   /* Should work without recalculating size */
4166   ierr = DMRestoreWorkArray(dm, size, MPIU_SCALAR, (void*) values);CHKERRQ(ierr);
4167   *values = NULL;
4168   PetscFunctionReturn(0);
4169 }
4170 
4171 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
4172 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4173 
4174 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[])
4175 {
4176   PetscInt        cdof;   /* The number of constraints on this point */
4177   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4178   PetscScalar    *a;
4179   PetscInt        off, cind = 0, k;
4180   PetscErrorCode  ierr;
4181 
4182   PetscFunctionBegin;
4183   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4184   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4185   a    = &array[off];
4186   if (!cdof || setBC) {
4187     if (clperm) {
4188       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
4189       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
4190     } else {
4191       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
4192       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
4193     }
4194   } else {
4195     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4196     if (clperm) {
4197       if (perm) {for (k = 0; k < dof; ++k) {
4198           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4199           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4200         }
4201       } else {
4202         for (k = 0; k < dof; ++k) {
4203           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4204           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4205         }
4206       }
4207     } else {
4208       if (perm) {
4209         for (k = 0; k < dof; ++k) {
4210           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4211           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4212         }
4213       } else {
4214         for (k = 0; k < dof; ++k) {
4215           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4216           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4217         }
4218       }
4219     }
4220   }
4221   PetscFunctionReturn(0);
4222 }
4223 
4224 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[])
4225 {
4226   PetscInt        cdof;   /* The number of constraints on this point */
4227   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4228   PetscScalar    *a;
4229   PetscInt        off, cind = 0, k;
4230   PetscErrorCode  ierr;
4231 
4232   PetscFunctionBegin;
4233   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4234   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4235   a    = &array[off];
4236   if (cdof) {
4237     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4238     if (clperm) {
4239       if (perm) {
4240         for (k = 0; k < dof; ++k) {
4241           if ((cind < cdof) && (k == cdofs[cind])) {
4242             fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4243             cind++;
4244           }
4245         }
4246       } else {
4247         for (k = 0; k < dof; ++k) {
4248           if ((cind < cdof) && (k == cdofs[cind])) {
4249             fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4250             cind++;
4251           }
4252         }
4253       }
4254     } else {
4255       if (perm) {
4256         for (k = 0; k < dof; ++k) {
4257           if ((cind < cdof) && (k == cdofs[cind])) {
4258             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
4259             cind++;
4260           }
4261         }
4262       } else {
4263         for (k = 0; k < dof; ++k) {
4264           if ((cind < cdof) && (k == cdofs[cind])) {
4265             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
4266             cind++;
4267           }
4268         }
4269       }
4270     }
4271   }
4272   PetscFunctionReturn(0);
4273 }
4274 
4275 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[])
4276 {
4277   PetscScalar    *a;
4278   PetscInt        fdof, foff, fcdof, foffset = *offset;
4279   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4280   PetscInt        cind = 0, b;
4281   PetscErrorCode  ierr;
4282 
4283   PetscFunctionBegin;
4284   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4285   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4286   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4287   a    = &array[foff];
4288   if (!fcdof || setBC) {
4289     if (clperm) {
4290       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
4291       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
4292     } else {
4293       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
4294       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
4295     }
4296   } else {
4297     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4298     if (clperm) {
4299       if (perm) {
4300         for (b = 0; b < fdof; b++) {
4301           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4302           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4303         }
4304       } else {
4305         for (b = 0; b < fdof; b++) {
4306           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4307           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4308         }
4309       }
4310     } else {
4311       if (perm) {
4312         for (b = 0; b < fdof; b++) {
4313           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4314           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4315         }
4316       } else {
4317         for (b = 0; b < fdof; b++) {
4318           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4319           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4320         }
4321       }
4322     }
4323   }
4324   *offset += fdof;
4325   PetscFunctionReturn(0);
4326 }
4327 
4328 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[])
4329 {
4330   PetscScalar    *a;
4331   PetscInt        fdof, foff, fcdof, foffset = *offset;
4332   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4333   PetscInt        cind = 0, ncind = 0, b;
4334   PetscBool       ncSet, fcSet;
4335   PetscErrorCode  ierr;
4336 
4337   PetscFunctionBegin;
4338   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4339   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4340   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4341   a    = &array[foff];
4342   if (fcdof) {
4343     /* We just override fcdof and fcdofs with Ncc and comps */
4344     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4345     if (clperm) {
4346       if (perm) {
4347         if (comps) {
4348           for (b = 0; b < fdof; b++) {
4349             ncSet = fcSet = PETSC_FALSE;
4350             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4351             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4352             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}
4353           }
4354         } else {
4355           for (b = 0; b < fdof; b++) {
4356             if ((cind < fcdof) && (b == fcdofs[cind])) {
4357               fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4358               ++cind;
4359             }
4360           }
4361         }
4362       } else {
4363         if (comps) {
4364           for (b = 0; b < fdof; b++) {
4365             ncSet = fcSet = PETSC_FALSE;
4366             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4367             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4368             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}
4369           }
4370         } else {
4371           for (b = 0; b < fdof; b++) {
4372             if ((cind < fcdof) && (b == fcdofs[cind])) {
4373               fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4374               ++cind;
4375             }
4376           }
4377         }
4378       }
4379     } else {
4380       if (perm) {
4381         if (comps) {
4382           for (b = 0; b < fdof; b++) {
4383             ncSet = fcSet = PETSC_FALSE;
4384             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4385             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4386             if (ncSet && fcSet) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}
4387           }
4388         } else {
4389           for (b = 0; b < fdof; b++) {
4390             if ((cind < fcdof) && (b == fcdofs[cind])) {
4391               fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4392               ++cind;
4393             }
4394           }
4395         }
4396       } else {
4397         if (comps) {
4398           for (b = 0; b < fdof; b++) {
4399             ncSet = fcSet = PETSC_FALSE;
4400             if ((ncind < Ncc)  && (b == comps[ncind])) {++ncind; ncSet = PETSC_TRUE;}
4401             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
4402             if (ncSet && fcSet) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}
4403           }
4404         } else {
4405           for (b = 0; b < fdof; b++) {
4406             if ((cind < fcdof) && (b == fcdofs[cind])) {
4407               fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4408               ++cind;
4409             }
4410           }
4411         }
4412       }
4413     }
4414   }
4415   *offset += fdof;
4416   PetscFunctionReturn(0);
4417 }
4418 
4419 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4420 {
4421   PetscScalar    *array;
4422   const PetscInt *cone, *coneO;
4423   PetscInt        pStart, pEnd, p, numPoints, off, dof;
4424   PetscErrorCode  ierr;
4425 
4426   PetscFunctionBeginHot;
4427   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4428   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4429   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4430   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4431   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4432   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
4433     const PetscInt cp = !p ? point : cone[p-1];
4434     const PetscInt o  = !p ? 0     : coneO[p-1];
4435 
4436     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
4437     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4438     /* ADD_VALUES */
4439     {
4440       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4441       PetscScalar    *a;
4442       PetscInt        cdof, coff, cind = 0, k;
4443 
4444       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
4445       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
4446       a    = &array[coff];
4447       if (!cdof) {
4448         if (o >= 0) {
4449           for (k = 0; k < dof; ++k) {
4450             a[k] += values[off+k];
4451           }
4452         } else {
4453           for (k = 0; k < dof; ++k) {
4454             a[k] += values[off+dof-k-1];
4455           }
4456         }
4457       } else {
4458         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
4459         if (o >= 0) {
4460           for (k = 0; k < dof; ++k) {
4461             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4462             a[k] += values[off+k];
4463           }
4464         } else {
4465           for (k = 0; k < dof; ++k) {
4466             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4467             a[k] += values[off+dof-k-1];
4468           }
4469         }
4470       }
4471     }
4472   }
4473   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4474   PetscFunctionReturn(0);
4475 }
4476 
4477 /*@C
4478   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
4479 
4480   Not collective
4481 
4482   Input Parameters:
4483 + dm - The DM
4484 . section - The section describing the layout in v, or NULL to use the default section
4485 . v - The local vector
4486 . point - The point in the DM
4487 . values - The array of values
4488 - mode - The insert mode. One of INSERT_ALL_VALUES, ADD_ALL_VALUES, INSERT_VALUES, ADD_VALUES, INSERT_BC_VALUES, and ADD_BC_VALUES,
4489          where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions.
4490 
4491   Fortran Notes:
4492   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4493 
4494   Level: intermediate
4495 
4496 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
4497 @*/
4498 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4499 {
4500   PetscSection    clSection;
4501   IS              clPoints;
4502   PetscScalar    *array;
4503   PetscInt       *points = NULL;
4504   const PetscInt *clp, *clperm;
4505   PetscInt        depth, numFields, numPoints, p;
4506   PetscErrorCode  ierr;
4507 
4508   PetscFunctionBeginHot;
4509   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4510   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4511   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4512   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4513   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4514   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4515   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
4516     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
4517     PetscFunctionReturn(0);
4518   }
4519   /* Get points */
4520   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4521   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4522   /* Get array */
4523   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4524   /* Get values */
4525   if (numFields > 0) {
4526     PetscInt offset = 0, f;
4527     for (f = 0; f < numFields; ++f) {
4528       const PetscInt    **perms = NULL;
4529       const PetscScalar **flips = NULL;
4530 
4531       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4532       switch (mode) {
4533       case INSERT_VALUES:
4534         for (p = 0; p < numPoints; p++) {
4535           const PetscInt    point = points[2*p];
4536           const PetscInt    *perm = perms ? perms[p] : NULL;
4537           const PetscScalar *flip = flips ? flips[p] : NULL;
4538           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4539         } break;
4540       case INSERT_ALL_VALUES:
4541         for (p = 0; p < numPoints; p++) {
4542           const PetscInt    point = points[2*p];
4543           const PetscInt    *perm = perms ? perms[p] : NULL;
4544           const PetscScalar *flip = flips ? flips[p] : NULL;
4545           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4546         } break;
4547       case INSERT_BC_VALUES:
4548         for (p = 0; p < numPoints; p++) {
4549           const PetscInt    point = points[2*p];
4550           const PetscInt    *perm = perms ? perms[p] : NULL;
4551           const PetscScalar *flip = flips ? flips[p] : NULL;
4552           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, insert, clperm, values, &offset, array);
4553         } break;
4554       case ADD_VALUES:
4555         for (p = 0; p < numPoints; p++) {
4556           const PetscInt    point = points[2*p];
4557           const PetscInt    *perm = perms ? perms[p] : NULL;
4558           const PetscScalar *flip = flips ? flips[p] : NULL;
4559           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4560         } break;
4561       case ADD_ALL_VALUES:
4562         for (p = 0; p < numPoints; p++) {
4563           const PetscInt    point = points[2*p];
4564           const PetscInt    *perm = perms ? perms[p] : NULL;
4565           const PetscScalar *flip = flips ? flips[p] : NULL;
4566           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4567         } break;
4568       case ADD_BC_VALUES:
4569         for (p = 0; p < numPoints; p++) {
4570           const PetscInt    point = points[2*p];
4571           const PetscInt    *perm = perms ? perms[p] : NULL;
4572           const PetscScalar *flip = flips ? flips[p] : NULL;
4573           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, add, clperm, values, &offset, array);
4574         } break;
4575       default:
4576         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4577       }
4578       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4579     }
4580   } else {
4581     PetscInt dof, off;
4582     const PetscInt    **perms = NULL;
4583     const PetscScalar **flips = NULL;
4584 
4585     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4586     switch (mode) {
4587     case INSERT_VALUES:
4588       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4589         const PetscInt    point = points[2*p];
4590         const PetscInt    *perm = perms ? perms[p] : NULL;
4591         const PetscScalar *flip = flips ? flips[p] : NULL;
4592         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4593         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
4594       } break;
4595     case INSERT_ALL_VALUES:
4596       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4597         const PetscInt    point = points[2*p];
4598         const PetscInt    *perm = perms ? perms[p] : NULL;
4599         const PetscScalar *flip = flips ? flips[p] : NULL;
4600         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4601         updatePoint_private(section, point, dof, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
4602       } break;
4603     case INSERT_BC_VALUES:
4604       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4605         const PetscInt    point = points[2*p];
4606         const PetscInt    *perm = perms ? perms[p] : NULL;
4607         const PetscScalar *flip = flips ? flips[p] : NULL;
4608         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4609         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
4610       } break;
4611     case ADD_VALUES:
4612       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4613         const PetscInt    point = points[2*p];
4614         const PetscInt    *perm = perms ? perms[p] : NULL;
4615         const PetscScalar *flip = flips ? flips[p] : NULL;
4616         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4617         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
4618       } break;
4619     case ADD_ALL_VALUES:
4620       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4621         const PetscInt    point = points[2*p];
4622         const PetscInt    *perm = perms ? perms[p] : NULL;
4623         const PetscScalar *flip = flips ? flips[p] : NULL;
4624         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4625         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
4626       } break;
4627     case ADD_BC_VALUES:
4628       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4629         const PetscInt    point = points[2*p];
4630         const PetscInt    *perm = perms ? perms[p] : NULL;
4631         const PetscScalar *flip = flips ? flips[p] : NULL;
4632         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4633         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
4634       } break;
4635     default:
4636       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4637     }
4638     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4639   }
4640   /* Cleanup points */
4641   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4642   /* Cleanup array */
4643   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4644   PetscFunctionReturn(0);
4645 }
4646 
4647 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, PetscInt Ncc, const PetscInt comps[], const PetscScalar values[], InsertMode mode)
4648 {
4649   PetscSection      clSection;
4650   IS                clPoints;
4651   PetscScalar       *array;
4652   PetscInt          *points = NULL;
4653   const PetscInt    *clp, *clperm;
4654   PetscInt          numFields, numPoints, p;
4655   PetscInt          offset = 0, f;
4656   PetscErrorCode    ierr;
4657 
4658   PetscFunctionBeginHot;
4659   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4660   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4661   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4662   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4663   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4664   /* Get points */
4665   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4666   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4667   /* Get array */
4668   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4669   /* Get values */
4670   for (f = 0; f < numFields; ++f) {
4671     const PetscInt    **perms = NULL;
4672     const PetscScalar **flips = NULL;
4673 
4674     if (!fieldActive[f]) {
4675       for (p = 0; p < numPoints*2; p += 2) {
4676         PetscInt fdof;
4677         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4678         offset += fdof;
4679       }
4680       continue;
4681     }
4682     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4683     switch (mode) {
4684     case INSERT_VALUES:
4685       for (p = 0; p < numPoints; p++) {
4686         const PetscInt    point = points[2*p];
4687         const PetscInt    *perm = perms ? perms[p] : NULL;
4688         const PetscScalar *flip = flips ? flips[p] : NULL;
4689         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4690       } break;
4691     case INSERT_ALL_VALUES:
4692       for (p = 0; p < numPoints; p++) {
4693         const PetscInt    point = points[2*p];
4694         const PetscInt    *perm = perms ? perms[p] : NULL;
4695         const PetscScalar *flip = flips ? flips[p] : NULL;
4696         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4697         } break;
4698     case INSERT_BC_VALUES:
4699       for (p = 0; p < numPoints; p++) {
4700         const PetscInt    point = points[2*p];
4701         const PetscInt    *perm = perms ? perms[p] : NULL;
4702         const PetscScalar *flip = flips ? flips[p] : NULL;
4703         updatePointFieldsBC_private(section, point, perm, flip, f, Ncc, comps, insert, clperm, values, &offset, array);
4704       } break;
4705     case ADD_VALUES:
4706       for (p = 0; p < numPoints; p++) {
4707         const PetscInt    point = points[2*p];
4708         const PetscInt    *perm = perms ? perms[p] : NULL;
4709         const PetscScalar *flip = flips ? flips[p] : NULL;
4710         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4711       } break;
4712     case ADD_ALL_VALUES:
4713       for (p = 0; p < numPoints; p++) {
4714         const PetscInt    point = points[2*p];
4715         const PetscInt    *perm = perms ? perms[p] : NULL;
4716         const PetscScalar *flip = flips ? flips[p] : NULL;
4717         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4718       } break;
4719     default:
4720       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4721     }
4722     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4723   }
4724   /* Cleanup points */
4725   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4726   /* Cleanup array */
4727   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4728   PetscFunctionReturn(0);
4729 }
4730 
4731 static PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
4732 {
4733   PetscMPIInt    rank;
4734   PetscInt       i, j;
4735   PetscErrorCode ierr;
4736 
4737   PetscFunctionBegin;
4738   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
4739   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for point %D\n", rank, point);CHKERRQ(ierr);
4740   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
4741   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
4742   numCIndices = numCIndices ? numCIndices : numRIndices;
4743   for (i = 0; i < numRIndices; i++) {
4744     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
4745     for (j = 0; j < numCIndices; j++) {
4746 #if defined(PETSC_USE_COMPLEX)
4747       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
4748 #else
4749       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
4750 #endif
4751     }
4752     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
4753   }
4754   PetscFunctionReturn(0);
4755 }
4756 
4757 /* . off - The global offset of this point */
4758 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], PetscInt indices[])
4759 {
4760   PetscInt        dof;    /* The number of unknowns on this point */
4761   PetscInt        cdof;   /* The number of constraints on this point */
4762   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4763   PetscInt        cind = 0, k;
4764   PetscErrorCode  ierr;
4765 
4766   PetscFunctionBegin;
4767   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4768   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4769   if (!cdof || setBC) {
4770     if (perm) {
4771       for (k = 0; k < dof; k++) indices[*loff+perm[k]] = off + k;
4772     } else {
4773       for (k = 0; k < dof; k++) indices[*loff+k] = off + k;
4774     }
4775   } else {
4776     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4777     if (perm) {
4778       for (k = 0; k < dof; ++k) {
4779         if ((cind < cdof) && (k == cdofs[cind])) {
4780           /* Insert check for returning constrained indices */
4781           indices[*loff+perm[k]] = -(off+k+1);
4782           ++cind;
4783         } else {
4784           indices[*loff+perm[k]] = off+k-cind;
4785         }
4786       }
4787     } else {
4788       for (k = 0; k < dof; ++k) {
4789         if ((cind < cdof) && (k == cdofs[cind])) {
4790           /* Insert check for returning constrained indices */
4791           indices[*loff+k] = -(off+k+1);
4792           ++cind;
4793         } else {
4794           indices[*loff+k] = off+k-cind;
4795         }
4796       }
4797     }
4798   }
4799   *loff += dof;
4800   PetscFunctionReturn(0);
4801 }
4802 
4803 /* . off - The global offset of this point */
4804 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, PetscInt indices[])
4805 {
4806   PetscInt       numFields, foff, f;
4807   PetscErrorCode ierr;
4808 
4809   PetscFunctionBegin;
4810   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4811   for (f = 0, foff = 0; f < numFields; ++f) {
4812     PetscInt        fdof, cfdof;
4813     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4814     PetscInt        cind = 0, b;
4815     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
4816 
4817     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4818     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4819     if (!cfdof || setBC) {
4820       if (perm) {for (b = 0; b < fdof; b++) {indices[foffs[f]+perm[b]] = off+foff+b;}}
4821       else      {for (b = 0; b < fdof; b++) {indices[foffs[f]+     b ] = off+foff+b;}}
4822     } else {
4823       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4824       if (perm) {
4825         for (b = 0; b < fdof; b++) {
4826           if ((cind < cfdof) && (b == fcdofs[cind])) {
4827             indices[foffs[f]+perm[b]] = -(off+foff+b+1);
4828             ++cind;
4829           } else {
4830             indices[foffs[f]+perm[b]] = off+foff+b-cind;
4831           }
4832         }
4833       } else {
4834         for (b = 0; b < fdof; b++) {
4835           if ((cind < cfdof) && (b == fcdofs[cind])) {
4836             indices[foffs[f]+b] = -(off+foff+b+1);
4837             ++cind;
4838           } else {
4839             indices[foffs[f]+b] = off+foff+b-cind;
4840           }
4841         }
4842       }
4843     }
4844     foff     += (setBC ? fdof : (fdof - cfdof));
4845     foffs[f] += fdof;
4846   }
4847   PetscFunctionReturn(0);
4848 }
4849 
4850 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)
4851 {
4852   Mat             cMat;
4853   PetscSection    aSec, cSec;
4854   IS              aIS;
4855   PetscInt        aStart = -1, aEnd = -1;
4856   const PetscInt  *anchors;
4857   PetscInt        numFields, f, p, q, newP = 0;
4858   PetscInt        newNumPoints = 0, newNumIndices = 0;
4859   PetscInt        *newPoints, *indices, *newIndices;
4860   PetscInt        maxAnchor, maxDof;
4861   PetscInt        newOffsets[32];
4862   PetscInt        *pointMatOffsets[32];
4863   PetscInt        *newPointOffsets[32];
4864   PetscScalar     *pointMat[32];
4865   PetscScalar     *newValues=NULL,*tmpValues;
4866   PetscBool       anyConstrained = PETSC_FALSE;
4867   PetscErrorCode  ierr;
4868 
4869   PetscFunctionBegin;
4870   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4871   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4872   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4873 
4874   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4875   /* if there are point-to-point constraints */
4876   if (aSec) {
4877     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4878     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4879     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4880     /* figure out how many points are going to be in the new element matrix
4881      * (we allow double counting, because it's all just going to be summed
4882      * into the global matrix anyway) */
4883     for (p = 0; p < 2*numPoints; p+=2) {
4884       PetscInt b    = points[p];
4885       PetscInt bDof = 0, bSecDof;
4886 
4887       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4888       if (!bSecDof) {
4889         continue;
4890       }
4891       if (b >= aStart && b < aEnd) {
4892         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4893       }
4894       if (bDof) {
4895         /* this point is constrained */
4896         /* it is going to be replaced by its anchors */
4897         PetscInt bOff, q;
4898 
4899         anyConstrained = PETSC_TRUE;
4900         newNumPoints  += bDof;
4901         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4902         for (q = 0; q < bDof; q++) {
4903           PetscInt a = anchors[bOff + q];
4904           PetscInt aDof;
4905 
4906           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4907           newNumIndices += aDof;
4908           for (f = 0; f < numFields; ++f) {
4909             PetscInt fDof;
4910 
4911             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4912             newOffsets[f+1] += fDof;
4913           }
4914         }
4915       }
4916       else {
4917         /* this point is not constrained */
4918         newNumPoints++;
4919         newNumIndices += bSecDof;
4920         for (f = 0; f < numFields; ++f) {
4921           PetscInt fDof;
4922 
4923           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4924           newOffsets[f+1] += fDof;
4925         }
4926       }
4927     }
4928   }
4929   if (!anyConstrained) {
4930     if (outNumPoints)  *outNumPoints  = 0;
4931     if (outNumIndices) *outNumIndices = 0;
4932     if (outPoints)     *outPoints     = NULL;
4933     if (outValues)     *outValues     = NULL;
4934     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4935     PetscFunctionReturn(0);
4936   }
4937 
4938   if (outNumPoints)  *outNumPoints  = newNumPoints;
4939   if (outNumIndices) *outNumIndices = newNumIndices;
4940 
4941   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
4942 
4943   if (!outPoints && !outValues) {
4944     if (offsets) {
4945       for (f = 0; f <= numFields; f++) {
4946         offsets[f] = newOffsets[f];
4947       }
4948     }
4949     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4950     PetscFunctionReturn(0);
4951   }
4952 
4953   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
4954 
4955   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
4956 
4957   /* workspaces */
4958   if (numFields) {
4959     for (f = 0; f < numFields; f++) {
4960       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4961       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4962     }
4963   }
4964   else {
4965     ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4966     ierr = DMGetWorkArray(dm,numPoints,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4967   }
4968 
4969   /* get workspaces for the point-to-point matrices */
4970   if (numFields) {
4971     PetscInt totalOffset, totalMatOffset;
4972 
4973     for (p = 0; p < numPoints; p++) {
4974       PetscInt b    = points[2*p];
4975       PetscInt bDof = 0, bSecDof;
4976 
4977       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4978       if (!bSecDof) {
4979         for (f = 0; f < numFields; f++) {
4980           newPointOffsets[f][p + 1] = 0;
4981           pointMatOffsets[f][p + 1] = 0;
4982         }
4983         continue;
4984       }
4985       if (b >= aStart && b < aEnd) {
4986         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4987       }
4988       if (bDof) {
4989         for (f = 0; f < numFields; f++) {
4990           PetscInt fDof, q, bOff, allFDof = 0;
4991 
4992           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4993           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4994           for (q = 0; q < bDof; q++) {
4995             PetscInt a = anchors[bOff + q];
4996             PetscInt aFDof;
4997 
4998             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4999             allFDof += aFDof;
5000           }
5001           newPointOffsets[f][p+1] = allFDof;
5002           pointMatOffsets[f][p+1] = fDof * allFDof;
5003         }
5004       }
5005       else {
5006         for (f = 0; f < numFields; f++) {
5007           PetscInt fDof;
5008 
5009           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5010           newPointOffsets[f][p+1] = fDof;
5011           pointMatOffsets[f][p+1] = 0;
5012         }
5013       }
5014     }
5015     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
5016       newPointOffsets[f][0] = totalOffset;
5017       pointMatOffsets[f][0] = totalMatOffset;
5018       for (p = 0; p < numPoints; p++) {
5019         newPointOffsets[f][p+1] += newPointOffsets[f][p];
5020         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
5021       }
5022       totalOffset    = newPointOffsets[f][numPoints];
5023       totalMatOffset = pointMatOffsets[f][numPoints];
5024       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5025     }
5026   }
5027   else {
5028     for (p = 0; p < numPoints; p++) {
5029       PetscInt b    = points[2*p];
5030       PetscInt bDof = 0, bSecDof;
5031 
5032       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5033       if (!bSecDof) {
5034         newPointOffsets[0][p + 1] = 0;
5035         pointMatOffsets[0][p + 1] = 0;
5036         continue;
5037       }
5038       if (b >= aStart && b < aEnd) {
5039         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5040       }
5041       if (bDof) {
5042         PetscInt bOff, q, allDof = 0;
5043 
5044         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5045         for (q = 0; q < bDof; q++) {
5046           PetscInt a = anchors[bOff + q], aDof;
5047 
5048           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5049           allDof += aDof;
5050         }
5051         newPointOffsets[0][p+1] = allDof;
5052         pointMatOffsets[0][p+1] = bSecDof * allDof;
5053       }
5054       else {
5055         newPointOffsets[0][p+1] = bSecDof;
5056         pointMatOffsets[0][p+1] = 0;
5057       }
5058     }
5059     newPointOffsets[0][0] = 0;
5060     pointMatOffsets[0][0] = 0;
5061     for (p = 0; p < numPoints; p++) {
5062       newPointOffsets[0][p+1] += newPointOffsets[0][p];
5063       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
5064     }
5065     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5066   }
5067 
5068   /* output arrays */
5069   ierr = DMGetWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5070 
5071   /* get the point-to-point matrices; construct newPoints */
5072   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
5073   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
5074   ierr = DMGetWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5075   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5076   if (numFields) {
5077     for (p = 0, newP = 0; p < numPoints; p++) {
5078       PetscInt b    = points[2*p];
5079       PetscInt o    = points[2*p+1];
5080       PetscInt bDof = 0, bSecDof;
5081 
5082       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5083       if (!bSecDof) {
5084         continue;
5085       }
5086       if (b >= aStart && b < aEnd) {
5087         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5088       }
5089       if (bDof) {
5090         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
5091 
5092         fStart[0] = 0;
5093         fEnd[0]   = 0;
5094         for (f = 0; f < numFields; f++) {
5095           PetscInt fDof;
5096 
5097           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
5098           fStart[f+1] = fStart[f] + fDof;
5099           fEnd[f+1]   = fStart[f+1];
5100         }
5101         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5102         ierr = DMPlexGetIndicesPointFields_Internal(cSec, b, bOff, fEnd, PETSC_TRUE, perms, p, indices);CHKERRQ(ierr);
5103 
5104         fAnchorStart[0] = 0;
5105         fAnchorEnd[0]   = 0;
5106         for (f = 0; f < numFields; f++) {
5107           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
5108 
5109           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
5110           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
5111         }
5112         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5113         for (q = 0; q < bDof; q++) {
5114           PetscInt a = anchors[bOff + q], aOff;
5115 
5116           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5117           newPoints[2*(newP + q)]     = a;
5118           newPoints[2*(newP + q) + 1] = 0;
5119           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5120           ierr = DMPlexGetIndicesPointFields_Internal(section, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, newIndices);CHKERRQ(ierr);
5121         }
5122         newP += bDof;
5123 
5124         if (outValues) {
5125           /* get the point-to-point submatrix */
5126           for (f = 0; f < numFields; f++) {
5127             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
5128           }
5129         }
5130       }
5131       else {
5132         newPoints[2 * newP]     = b;
5133         newPoints[2 * newP + 1] = o;
5134         newP++;
5135       }
5136     }
5137   } else {
5138     for (p = 0; p < numPoints; p++) {
5139       PetscInt b    = points[2*p];
5140       PetscInt o    = points[2*p+1];
5141       PetscInt bDof = 0, bSecDof;
5142 
5143       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
5144       if (!bSecDof) {
5145         continue;
5146       }
5147       if (b >= aStart && b < aEnd) {
5148         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5149       }
5150       if (bDof) {
5151         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
5152 
5153         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5154         ierr = DMPlexGetIndicesPoint_Internal(cSec, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, indices);CHKERRQ(ierr);
5155 
5156         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
5157         for (q = 0; q < bDof; q++) {
5158           PetscInt a = anchors[bOff + q], aOff;
5159 
5160           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5161 
5162           newPoints[2*(newP + q)]     = a;
5163           newPoints[2*(newP + q) + 1] = 0;
5164           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
5165           ierr = DMPlexGetIndicesPoint_Internal(section, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, newIndices);CHKERRQ(ierr);
5166         }
5167         newP += bDof;
5168 
5169         /* get the point-to-point submatrix */
5170         if (outValues) {
5171           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
5172         }
5173       }
5174       else {
5175         newPoints[2 * newP]     = b;
5176         newPoints[2 * newP + 1] = o;
5177         newP++;
5178       }
5179     }
5180   }
5181 
5182   if (outValues) {
5183     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5184     ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
5185     /* multiply constraints on the right */
5186     if (numFields) {
5187       for (f = 0; f < numFields; f++) {
5188         PetscInt oldOff = offsets[f];
5189 
5190         for (p = 0; p < numPoints; p++) {
5191           PetscInt cStart = newPointOffsets[f][p];
5192           PetscInt b      = points[2 * p];
5193           PetscInt c, r, k;
5194           PetscInt dof;
5195 
5196           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5197           if (!dof) {
5198             continue;
5199           }
5200           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5201             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
5202             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
5203 
5204             for (r = 0; r < numIndices; r++) {
5205               for (c = 0; c < nCols; c++) {
5206                 for (k = 0; k < dof; k++) {
5207                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
5208                 }
5209               }
5210             }
5211           }
5212           else {
5213             /* copy this column as is */
5214             for (r = 0; r < numIndices; r++) {
5215               for (c = 0; c < dof; c++) {
5216                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5217               }
5218             }
5219           }
5220           oldOff += dof;
5221         }
5222       }
5223     }
5224     else {
5225       PetscInt oldOff = 0;
5226       for (p = 0; p < numPoints; p++) {
5227         PetscInt cStart = newPointOffsets[0][p];
5228         PetscInt b      = points[2 * p];
5229         PetscInt c, r, k;
5230         PetscInt dof;
5231 
5232         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5233         if (!dof) {
5234           continue;
5235         }
5236         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5237           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
5238           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
5239 
5240           for (r = 0; r < numIndices; r++) {
5241             for (c = 0; c < nCols; c++) {
5242               for (k = 0; k < dof; k++) {
5243                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
5244               }
5245             }
5246           }
5247         }
5248         else {
5249           /* copy this column as is */
5250           for (r = 0; r < numIndices; r++) {
5251             for (c = 0; c < dof; c++) {
5252               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5253             }
5254           }
5255         }
5256         oldOff += dof;
5257       }
5258     }
5259 
5260     if (multiplyLeft) {
5261       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5262       ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
5263       /* multiply constraints transpose on the left */
5264       if (numFields) {
5265         for (f = 0; f < numFields; f++) {
5266           PetscInt oldOff = offsets[f];
5267 
5268           for (p = 0; p < numPoints; p++) {
5269             PetscInt rStart = newPointOffsets[f][p];
5270             PetscInt b      = points[2 * p];
5271             PetscInt c, r, k;
5272             PetscInt dof;
5273 
5274             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5275             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5276               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
5277               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
5278 
5279               for (r = 0; r < nRows; r++) {
5280                 for (c = 0; c < newNumIndices; c++) {
5281                   for (k = 0; k < dof; k++) {
5282                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5283                   }
5284                 }
5285               }
5286             }
5287             else {
5288               /* copy this row as is */
5289               for (r = 0; r < dof; r++) {
5290                 for (c = 0; c < newNumIndices; c++) {
5291                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5292                 }
5293               }
5294             }
5295             oldOff += dof;
5296           }
5297         }
5298       }
5299       else {
5300         PetscInt oldOff = 0;
5301 
5302         for (p = 0; p < numPoints; p++) {
5303           PetscInt rStart = newPointOffsets[0][p];
5304           PetscInt b      = points[2 * p];
5305           PetscInt c, r, k;
5306           PetscInt dof;
5307 
5308           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5309           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5310             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
5311             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
5312 
5313             for (r = 0; r < nRows; r++) {
5314               for (c = 0; c < newNumIndices; c++) {
5315                 for (k = 0; k < dof; k++) {
5316                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5317                 }
5318               }
5319             }
5320           }
5321           else {
5322             /* copy this row as is */
5323             for (r = 0; r < dof; r++) {
5324               for (c = 0; c < newNumIndices; c++) {
5325                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5326               }
5327             }
5328           }
5329           oldOff += dof;
5330         }
5331       }
5332 
5333       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
5334     }
5335     else {
5336       newValues = tmpValues;
5337     }
5338   }
5339 
5340   /* clean up */
5341   ierr = DMRestoreWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
5342   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
5343 
5344   if (numFields) {
5345     for (f = 0; f < numFields; f++) {
5346       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5347       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5348       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5349     }
5350   }
5351   else {
5352     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5353     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5354     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5355   }
5356   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5357 
5358   /* output */
5359   if (outPoints) {
5360     *outPoints = newPoints;
5361   }
5362   else {
5363     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5364   }
5365   if (outValues) {
5366     *outValues = newValues;
5367   }
5368   for (f = 0; f <= numFields; f++) {
5369     offsets[f] = newOffsets[f];
5370   }
5371   PetscFunctionReturn(0);
5372 }
5373 
5374 /*@C
5375   DMPlexGetClosureIndices - Get the global indices in a vector v for all points in the closure of the given point
5376 
5377   Not collective
5378 
5379   Input Parameters:
5380 + dm - The DM
5381 . section - The section describing the layout in v, or NULL to use the default section
5382 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5383 - point - The mesh point
5384 
5385   Output parameters:
5386 + numIndices - The number of indices
5387 . indices - The indices
5388 - outOffsets - Field offset if not NULL
5389 
5390   Note: Must call DMPlexRestoreClosureIndices() to free allocated memory
5391 
5392   Level: advanced
5393 
5394 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5395 @*/
5396 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices, PetscInt *outOffsets)
5397 {
5398   PetscSection    clSection;
5399   IS              clPoints;
5400   const PetscInt *clp;
5401   const PetscInt  **perms[32] = {NULL};
5402   PetscInt       *points = NULL, *pointsNew;
5403   PetscInt        numPoints, numPointsNew;
5404   PetscInt        offsets[32];
5405   PetscInt        Nf, Nind, NindNew, off, globalOff, f, p;
5406   PetscErrorCode  ierr;
5407 
5408   PetscFunctionBegin;
5409   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5410   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5411   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5412   if (numIndices) PetscValidPointer(numIndices, 4);
5413   PetscValidPointer(indices, 5);
5414   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
5415   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
5416   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5417   /* Get points in closure */
5418   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5419   /* Get number of indices and indices per field */
5420   for (p = 0, Nind = 0; p < numPoints*2; p += 2) {
5421     PetscInt dof, fdof;
5422 
5423     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5424     for (f = 0; f < Nf; ++f) {
5425       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5426       offsets[f+1] += fdof;
5427     }
5428     Nind += dof;
5429   }
5430   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
5431   if (Nf && offsets[Nf] != Nind) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Nind);
5432   if (!Nf) offsets[1] = Nind;
5433   /* Get dual space symmetries */
5434   for (f = 0; f < PetscMax(1,Nf); f++) {
5435     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5436     else    {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5437   }
5438   /* Correct for hanging node constraints */
5439   {
5440     ierr = DMPlexAnchorsModifyMat(dm, section, numPoints, Nind, points, perms, NULL, &numPointsNew, &NindNew, &pointsNew, NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
5441     if (numPointsNew) {
5442       for (f = 0; f < PetscMax(1,Nf); f++) {
5443         if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5444         else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5445       }
5446       for (f = 0; f < PetscMax(1,Nf); f++) {
5447         if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5448         else    {ierr = PetscSectionGetPointSyms(section,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5449       }
5450       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5451       numPoints = numPointsNew;
5452       Nind      = NindNew;
5453       points    = pointsNew;
5454     }
5455   }
5456   /* Calculate indices */
5457   ierr = DMGetWorkArray(dm, Nind, MPIU_INT, indices);CHKERRQ(ierr);
5458   if (Nf) {
5459     if (outOffsets) {
5460       PetscInt f;
5461 
5462       for (f = 0; f <= Nf; f++) {
5463         outOffsets[f] = offsets[f];
5464       }
5465     }
5466     for (p = 0; p < numPoints; p++) {
5467       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5468       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, *indices);
5469     }
5470   } else {
5471     for (p = 0, off = 0; p < numPoints; p++) {
5472       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5473 
5474       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5475       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, *indices);
5476     }
5477   }
5478   /* Cleanup points */
5479   for (f = 0; f < PetscMax(1,Nf); f++) {
5480     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5481     else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5482   }
5483   if (numPointsNew) {
5484     ierr = DMRestoreWorkArray(dm, 2*numPointsNew, MPIU_INT, &pointsNew);CHKERRQ(ierr);
5485   } else {
5486     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5487   }
5488   if (numIndices) *numIndices = Nind;
5489   PetscFunctionReturn(0);
5490 }
5491 
5492 /*@C
5493   DMPlexRestoreClosureIndices - Restore the indices in a vector v for all points in the closure of the given point
5494 
5495   Not collective
5496 
5497   Input Parameters:
5498 + dm - The DM
5499 . section - The section describing the layout in v, or NULL to use the default section
5500 . globalSection - The section describing the parallel layout in v, or NULL to use the default section
5501 . point - The mesh point
5502 . numIndices - The number of indices
5503 . indices - The indices
5504 - outOffsets - Field offset if not NULL
5505 
5506   Level: advanced
5507 
5508 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure()
5509 @*/
5510 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices,PetscInt *outOffsets)
5511 {
5512   PetscErrorCode ierr;
5513 
5514   PetscFunctionBegin;
5515   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5516   PetscValidPointer(indices, 5);
5517   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
5518   PetscFunctionReturn(0);
5519 }
5520 
5521 /*@C
5522   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5523 
5524   Not collective
5525 
5526   Input Parameters:
5527 + dm - The DM
5528 . section - The section describing the layout in v, or NULL to use the default section
5529 . globalSection - The section describing the layout in v, or NULL to use the default global section
5530 . A - The matrix
5531 . point - The point in the DM
5532 . values - The array of values
5533 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5534 
5535   Fortran Notes:
5536   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5537 
5538   Level: intermediate
5539 
5540 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5541 @*/
5542 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5543 {
5544   DM_Plex            *mesh   = (DM_Plex*) dm->data;
5545   PetscSection        clSection;
5546   IS                  clPoints;
5547   PetscInt           *points = NULL, *newPoints;
5548   const PetscInt     *clp;
5549   PetscInt           *indices;
5550   PetscInt            offsets[32];
5551   const PetscInt    **perms[32] = {NULL};
5552   const PetscScalar **flips[32] = {NULL};
5553   PetscInt            numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, p, f;
5554   PetscScalar        *valCopy = NULL;
5555   PetscScalar        *newValues;
5556   PetscErrorCode      ierr;
5557 
5558   PetscFunctionBegin;
5559   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5560   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5561   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5562   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5563   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5564   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5565   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5566   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5567   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5568   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5569   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5570     PetscInt fdof;
5571 
5572     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5573     for (f = 0; f < numFields; ++f) {
5574       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5575       offsets[f+1] += fdof;
5576     }
5577     numIndices += dof;
5578   }
5579   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5580 
5581   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[numFields], numIndices);
5582   /* Get symmetries */
5583   for (f = 0; f < PetscMax(1,numFields); f++) {
5584     if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5585     else           {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5586     if (values && flips[f]) { /* may need to apply sign changes to the element matrix */
5587       PetscInt foffset = offsets[f];
5588 
5589       for (p = 0; p < numPoints; p++) {
5590         PetscInt point          = points[2*p], fdof;
5591         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
5592 
5593         if (!numFields) {
5594           ierr = PetscSectionGetDof(section,point,&fdof);CHKERRQ(ierr);
5595         } else {
5596           ierr = PetscSectionGetFieldDof(section,point,f,&fdof);CHKERRQ(ierr);
5597         }
5598         if (flip) {
5599           PetscInt i, j, k;
5600 
5601           if (!valCopy) {
5602             ierr = DMGetWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5603             for (j = 0; j < numIndices * numIndices; j++) valCopy[j] = values[j];
5604             values = valCopy;
5605           }
5606           for (i = 0; i < fdof; i++) {
5607             PetscScalar fval = flip[i];
5608 
5609             for (k = 0; k < numIndices; k++) {
5610               valCopy[numIndices * (foffset + i) + k] *= fval;
5611               valCopy[numIndices * k + (foffset + i)] *= fval;
5612             }
5613           }
5614         }
5615         foffset += fdof;
5616       }
5617     }
5618   }
5619   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,perms,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets,PETSC_TRUE);CHKERRQ(ierr);
5620   if (newNumPoints) {
5621     if (valCopy) {
5622       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5623     }
5624     for (f = 0; f < PetscMax(1,numFields); f++) {
5625       if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5626       else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5627     }
5628     for (f = 0; f < PetscMax(1,numFields); f++) {
5629       if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5630       else           {ierr = PetscSectionGetPointSyms(section,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5631     }
5632     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5633     numPoints  = newNumPoints;
5634     numIndices = newNumIndices;
5635     points     = newPoints;
5636     values     = newValues;
5637   }
5638   ierr = DMGetWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5639   if (numFields) {
5640     for (p = 0; p < numPoints; p++) {
5641       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5642       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, indices);
5643     }
5644   } else {
5645     for (p = 0, off = 0; p < numPoints; p++) {
5646       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5647       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5648       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, indices);
5649     }
5650   }
5651   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5652   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5653   if (mesh->printFEM > 1) {
5654     PetscInt i;
5655     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
5656     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
5657     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5658   }
5659   if (ierr) {
5660     PetscMPIInt    rank;
5661     PetscErrorCode ierr2;
5662 
5663     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5664     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5665     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5666     ierr2 = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr2);
5667     CHKERRQ(ierr);
5668   }
5669   for (f = 0; f < PetscMax(1,numFields); f++) {
5670     if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5671     else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5672   }
5673   if (newNumPoints) {
5674     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
5675     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5676   }
5677   else {
5678     if (valCopy) {
5679       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,MPIU_SCALAR,&valCopy);CHKERRQ(ierr);
5680     }
5681     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5682   }
5683   ierr = DMRestoreWorkArray(dm, numIndices, MPIU_INT, &indices);CHKERRQ(ierr);
5684   PetscFunctionReturn(0);
5685 }
5686 
5687 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5688 {
5689   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5690   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5691   PetscInt       *cpoints = NULL;
5692   PetscInt       *findices, *cindices;
5693   PetscInt        foffsets[32], coffsets[32];
5694   CellRefiner     cellRefiner;
5695   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5696   PetscErrorCode  ierr;
5697 
5698   PetscFunctionBegin;
5699   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5700   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5701   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5702   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5703   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5704   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5705   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5706   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5707   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5708   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5709   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5710   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5711   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5712   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5713   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5714   /* Column indices */
5715   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5716   maxFPoints = numCPoints;
5717   /* Compress out points not in the section */
5718   /*   TODO: Squeeze out points with 0 dof as well */
5719   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5720   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5721     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5722       cpoints[q*2]   = cpoints[p];
5723       cpoints[q*2+1] = cpoints[p+1];
5724       ++q;
5725     }
5726   }
5727   numCPoints = q;
5728   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5729     PetscInt fdof;
5730 
5731     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5732     if (!dof) continue;
5733     for (f = 0; f < numFields; ++f) {
5734       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5735       coffsets[f+1] += fdof;
5736     }
5737     numCIndices += dof;
5738   }
5739   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5740   /* Row indices */
5741   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5742   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5743   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5744   for (r = 0, q = 0; r < numSubcells; ++r) {
5745     /* TODO Map from coarse to fine cells */
5746     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5747     /* Compress out points not in the section */
5748     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5749     for (p = 0; p < numFPoints*2; p += 2) {
5750       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5751         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5752         if (!dof) continue;
5753         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5754         if (s < q) continue;
5755         ftotpoints[q*2]   = fpoints[p];
5756         ftotpoints[q*2+1] = fpoints[p+1];
5757         ++q;
5758       }
5759     }
5760     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5761   }
5762   numFPoints = q;
5763   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5764     PetscInt fdof;
5765 
5766     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5767     if (!dof) continue;
5768     for (f = 0; f < numFields; ++f) {
5769       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5770       foffsets[f+1] += fdof;
5771     }
5772     numFIndices += dof;
5773   }
5774   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5775 
5776   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5777   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5778   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5779   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5780   if (numFields) {
5781     const PetscInt **permsF[32] = {NULL};
5782     const PetscInt **permsC[32] = {NULL};
5783 
5784     for (f = 0; f < numFields; f++) {
5785       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5786       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5787     }
5788     for (p = 0; p < numFPoints; p++) {
5789       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5790       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5791     }
5792     for (p = 0; p < numCPoints; p++) {
5793       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5794       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5795     }
5796     for (f = 0; f < numFields; f++) {
5797       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5798       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5799     }
5800   } else {
5801     const PetscInt **permsF = NULL;
5802     const PetscInt **permsC = NULL;
5803 
5804     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5805     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5806     for (p = 0, off = 0; p < numFPoints; p++) {
5807       const PetscInt *perm = permsF ? permsF[p] : NULL;
5808 
5809       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5810       ierr = DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);CHKERRQ(ierr);
5811     }
5812     for (p = 0, off = 0; p < numCPoints; p++) {
5813       const PetscInt *perm = permsC ? permsC[p] : NULL;
5814 
5815       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5816       ierr = DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);CHKERRQ(ierr);
5817     }
5818     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5819     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5820   }
5821   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5822   /* TODO: flips */
5823   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5824   if (ierr) {
5825     PetscMPIInt    rank;
5826     PetscErrorCode ierr2;
5827 
5828     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5829     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5830     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5831     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
5832     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
5833     CHKERRQ(ierr);
5834   }
5835   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5836   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5837   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
5838   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
5839   PetscFunctionReturn(0);
5840 }
5841 
5842 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
5843 {
5844   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
5845   PetscInt      *cpoints = NULL;
5846   PetscInt       foffsets[32], coffsets[32];
5847   CellRefiner    cellRefiner;
5848   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5849   PetscErrorCode ierr;
5850 
5851   PetscFunctionBegin;
5852   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5853   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5854   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5855   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5856   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5857   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5858   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5859   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5860   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5861   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5862   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5863   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5864   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5865   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5866   /* Column indices */
5867   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5868   maxFPoints = numCPoints;
5869   /* Compress out points not in the section */
5870   /*   TODO: Squeeze out points with 0 dof as well */
5871   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5872   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5873     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5874       cpoints[q*2]   = cpoints[p];
5875       cpoints[q*2+1] = cpoints[p+1];
5876       ++q;
5877     }
5878   }
5879   numCPoints = q;
5880   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5881     PetscInt fdof;
5882 
5883     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5884     if (!dof) continue;
5885     for (f = 0; f < numFields; ++f) {
5886       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5887       coffsets[f+1] += fdof;
5888     }
5889     numCIndices += dof;
5890   }
5891   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5892   /* Row indices */
5893   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5894   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5895   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5896   for (r = 0, q = 0; r < numSubcells; ++r) {
5897     /* TODO Map from coarse to fine cells */
5898     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5899     /* Compress out points not in the section */
5900     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5901     for (p = 0; p < numFPoints*2; p += 2) {
5902       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5903         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5904         if (!dof) continue;
5905         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5906         if (s < q) continue;
5907         ftotpoints[q*2]   = fpoints[p];
5908         ftotpoints[q*2+1] = fpoints[p+1];
5909         ++q;
5910       }
5911     }
5912     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5913   }
5914   numFPoints = q;
5915   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5916     PetscInt fdof;
5917 
5918     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5919     if (!dof) continue;
5920     for (f = 0; f < numFields; ++f) {
5921       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5922       foffsets[f+1] += fdof;
5923     }
5924     numFIndices += dof;
5925   }
5926   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5927 
5928   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5929   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5930   if (numFields) {
5931     const PetscInt **permsF[32] = {NULL};
5932     const PetscInt **permsC[32] = {NULL};
5933 
5934     for (f = 0; f < numFields; f++) {
5935       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5936       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5937     }
5938     for (p = 0; p < numFPoints; p++) {
5939       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5940       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5941     }
5942     for (p = 0; p < numCPoints; p++) {
5943       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5944       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5945     }
5946     for (f = 0; f < numFields; f++) {
5947       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5948       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5949     }
5950   } else {
5951     const PetscInt **permsF = NULL;
5952     const PetscInt **permsC = NULL;
5953 
5954     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5955     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5956     for (p = 0, off = 0; p < numFPoints; p++) {
5957       const PetscInt *perm = permsF ? permsF[p] : NULL;
5958 
5959       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5960       DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);
5961     }
5962     for (p = 0, off = 0; p < numCPoints; p++) {
5963       const PetscInt *perm = permsC ? permsC[p] : NULL;
5964 
5965       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5966       DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);
5967     }
5968     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5969     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5970   }
5971   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
5972   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5973   PetscFunctionReturn(0);
5974 }
5975 
5976 /*@
5977   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5978 
5979   Input Parameter:
5980 . dm - The DMPlex object
5981 
5982   Output Parameters:
5983 + cMax - The first hybrid cell
5984 . fMax - The first hybrid face
5985 . eMax - The first hybrid edge
5986 - vMax - The first hybrid vertex
5987 
5988   Level: developer
5989 
5990 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
5991 @*/
5992 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5993 {
5994   DM_Plex       *mesh = (DM_Plex*) dm->data;
5995   PetscInt       dim;
5996   PetscErrorCode ierr;
5997 
5998   PetscFunctionBegin;
5999   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6000   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6001   if (cMax) *cMax = mesh->hybridPointMax[dim];
6002   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
6003   if (eMax) *eMax = mesh->hybridPointMax[1];
6004   if (vMax) *vMax = mesh->hybridPointMax[0];
6005   PetscFunctionReturn(0);
6006 }
6007 
6008 /*@
6009   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
6010 
6011   Input Parameters:
6012 . dm   - The DMPlex object
6013 . cMax - The first hybrid cell
6014 . fMax - The first hybrid face
6015 . eMax - The first hybrid edge
6016 - vMax - The first hybrid vertex
6017 
6018   Level: developer
6019 
6020 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
6021 @*/
6022 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6023 {
6024   DM_Plex       *mesh = (DM_Plex*) dm->data;
6025   PetscInt       dim;
6026   PetscErrorCode ierr;
6027 
6028   PetscFunctionBegin;
6029   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6030   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6031   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
6032   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
6033   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
6034   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
6035   PetscFunctionReturn(0);
6036 }
6037 
6038 /*@C
6039   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6040 
6041   Input Parameter:
6042 . dm   - The DMPlex object
6043 
6044   Output Parameter:
6045 . cellHeight - The height of a cell
6046 
6047   Level: developer
6048 
6049 .seealso DMPlexSetVTKCellHeight()
6050 @*/
6051 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6052 {
6053   DM_Plex *mesh = (DM_Plex*) dm->data;
6054 
6055   PetscFunctionBegin;
6056   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6057   PetscValidPointer(cellHeight, 2);
6058   *cellHeight = mesh->vtkCellHeight;
6059   PetscFunctionReturn(0);
6060 }
6061 
6062 /*@C
6063   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
6064 
6065   Input Parameters:
6066 + dm   - The DMPlex object
6067 - cellHeight - The height of a cell
6068 
6069   Level: developer
6070 
6071 .seealso DMPlexGetVTKCellHeight()
6072 @*/
6073 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6074 {
6075   DM_Plex *mesh = (DM_Plex*) dm->data;
6076 
6077   PetscFunctionBegin;
6078   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6079   mesh->vtkCellHeight = cellHeight;
6080   PetscFunctionReturn(0);
6081 }
6082 
6083 /* We can easily have a form that takes an IS instead */
6084 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
6085 {
6086   PetscSection   section, globalSection;
6087   PetscInt      *numbers, p;
6088   PetscErrorCode ierr;
6089 
6090   PetscFunctionBegin;
6091   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6092   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6093   for (p = pStart; p < pEnd; ++p) {
6094     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6095   }
6096   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6097   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6098   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
6099   for (p = pStart; p < pEnd; ++p) {
6100     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6101     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
6102     else                       numbers[p-pStart] += shift;
6103   }
6104   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6105   if (globalSize) {
6106     PetscLayout layout;
6107     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
6108     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
6109     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
6110   }
6111   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6112   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6113   PetscFunctionReturn(0);
6114 }
6115 
6116 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
6117 {
6118   PetscInt       cellHeight, cStart, cEnd, cMax;
6119   PetscErrorCode ierr;
6120 
6121   PetscFunctionBegin;
6122   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6123   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6124   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6125   if (cMax >= 0 && !includeHybrid) cEnd = PetscMin(cEnd, cMax);
6126   ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
6127   PetscFunctionReturn(0);
6128 }
6129 
6130 /*@C
6131   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
6132 
6133   Input Parameter:
6134 . dm   - The DMPlex object
6135 
6136   Output Parameter:
6137 . globalCellNumbers - Global cell numbers for all cells on this process
6138 
6139   Level: developer
6140 
6141 .seealso DMPlexGetVertexNumbering()
6142 @*/
6143 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6144 {
6145   DM_Plex       *mesh = (DM_Plex*) dm->data;
6146   PetscErrorCode ierr;
6147 
6148   PetscFunctionBegin;
6149   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6150   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
6151   *globalCellNumbers = mesh->globalCellNumbers;
6152   PetscFunctionReturn(0);
6153 }
6154 
6155 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
6156 {
6157   PetscInt       vStart, vEnd, vMax;
6158   PetscErrorCode ierr;
6159 
6160   PetscFunctionBegin;
6161   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6162   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6163   ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6164   if (vMax >= 0 && !includeHybrid) vEnd = PetscMin(vEnd, vMax);
6165   ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
6166   PetscFunctionReturn(0);
6167 }
6168 
6169 /*@C
6170   DMPlexGetVertexNumbering - Get a global certex numbering for all vertices on this process
6171 
6172   Input Parameter:
6173 . dm   - The DMPlex object
6174 
6175   Output Parameter:
6176 . globalVertexNumbers - Global vertex numbers for all vertices on this process
6177 
6178   Level: developer
6179 
6180 .seealso DMPlexGetCellNumbering()
6181 @*/
6182 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6183 {
6184   DM_Plex       *mesh = (DM_Plex*) dm->data;
6185   PetscErrorCode ierr;
6186 
6187   PetscFunctionBegin;
6188   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6189   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
6190   *globalVertexNumbers = mesh->globalVertexNumbers;
6191   PetscFunctionReturn(0);
6192 }
6193 
6194 /*@C
6195   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
6196 
6197   Input Parameter:
6198 . dm   - The DMPlex object
6199 
6200   Output Parameter:
6201 . globalPointNumbers - Global numbers for all points on this process
6202 
6203   Level: developer
6204 
6205 .seealso DMPlexGetCellNumbering()
6206 @*/
6207 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
6208 {
6209   IS             nums[4];
6210   PetscInt       depths[4];
6211   PetscInt       depth, d, shift = 0;
6212   PetscErrorCode ierr;
6213 
6214   PetscFunctionBegin;
6215   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6216   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6217   /* For unstratified meshes use dim instead of depth */
6218   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
6219   depths[0] = depth; depths[1] = 0;
6220   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
6221   for (d = 0; d <= depth; ++d) {
6222     PetscInt pStart, pEnd, gsize;
6223 
6224     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
6225     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
6226     shift += gsize;
6227   }
6228   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
6229   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
6230   PetscFunctionReturn(0);
6231 }
6232 
6233 
6234 /*@
6235   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
6236 
6237   Input Parameter:
6238 . dm - The DMPlex object
6239 
6240   Output Parameter:
6241 . ranks - The rank field
6242 
6243   Options Database Keys:
6244 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
6245 
6246   Level: intermediate
6247 
6248 .seealso: DMView()
6249 @*/
6250 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
6251 {
6252   DM             rdm;
6253   PetscDS        prob;
6254   PetscFE        fe;
6255   PetscScalar   *r;
6256   PetscMPIInt    rank;
6257   PetscInt       dim, cStart, cEnd, c;
6258   PetscErrorCode ierr;
6259 
6260   PetscFunctionBeginUser;
6261   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
6262   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
6263   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
6264   ierr = PetscFECreateDefault(rdm, dim, 1, PETSC_TRUE, NULL, -1, &fe);CHKERRQ(ierr);
6265   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
6266   ierr = DMGetDS(rdm, &prob);CHKERRQ(ierr);
6267   ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
6268   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
6269   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6270   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
6271   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
6272   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
6273   for (c = cStart; c < cEnd; ++c) {
6274     PetscScalar *lr;
6275 
6276     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
6277     *lr = rank;
6278   }
6279   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
6280   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
6281   PetscFunctionReturn(0);
6282 }
6283 
6284 /*@
6285   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6286 
6287   Input Parameter:
6288 . dm - The DMPlex object
6289 
6290   Note: This is a useful diagnostic when creating meshes programmatically.
6291 
6292   Level: developer
6293 
6294 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6295 @*/
6296 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6297 {
6298   PetscSection    coneSection, supportSection;
6299   const PetscInt *cone, *support;
6300   PetscInt        coneSize, c, supportSize, s;
6301   PetscInt        pStart, pEnd, p, csize, ssize;
6302   PetscErrorCode  ierr;
6303 
6304   PetscFunctionBegin;
6305   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6306   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6307   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6308   /* Check that point p is found in the support of its cone points, and vice versa */
6309   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6310   for (p = pStart; p < pEnd; ++p) {
6311     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6312     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6313     for (c = 0; c < coneSize; ++c) {
6314       PetscBool dup = PETSC_FALSE;
6315       PetscInt  d;
6316       for (d = c-1; d >= 0; --d) {
6317         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
6318       }
6319       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6320       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6321       for (s = 0; s < supportSize; ++s) {
6322         if (support[s] == p) break;
6323       }
6324       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
6325         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
6326         for (s = 0; s < coneSize; ++s) {
6327           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
6328         }
6329         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6330         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
6331         for (s = 0; s < supportSize; ++s) {
6332           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
6333         }
6334         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6335         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
6336         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
6337       }
6338     }
6339     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6340     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6341     for (s = 0; s < supportSize; ++s) {
6342       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6343       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6344       for (c = 0; c < coneSize; ++c) {
6345         if (cone[c] == p) break;
6346       }
6347       if (c >= coneSize) {
6348         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
6349         for (c = 0; c < supportSize; ++c) {
6350           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
6351         }
6352         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6353         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
6354         for (c = 0; c < coneSize; ++c) {
6355           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
6356         }
6357         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6358         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
6359       }
6360     }
6361   }
6362   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6363   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6364   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
6365   PetscFunctionReturn(0);
6366 }
6367 
6368 /*@
6369   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6370 
6371   Input Parameters:
6372 + dm - The DMPlex object
6373 . isSimplex - Are the cells simplices or tensor products
6374 - cellHeight - Normally 0
6375 
6376   Note: This is a useful diagnostic when creating meshes programmatically.
6377 
6378   Level: developer
6379 
6380 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6381 @*/
6382 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6383 {
6384   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6385   PetscErrorCode ierr;
6386 
6387   PetscFunctionBegin;
6388   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6389   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6390   switch (dim) {
6391   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6392   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6393   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6394   default:
6395     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %D", dim);
6396   }
6397   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6398   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6399   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6400   cMax = cMax >= 0 ? cMax : cEnd;
6401   for (c = cStart; c < cMax; ++c) {
6402     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6403 
6404     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6405     for (cl = 0; cl < closureSize*2; cl += 2) {
6406       const PetscInt p = closure[cl];
6407       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6408     }
6409     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6410     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has  %D vertices != %D", c, coneSize, numCorners);
6411   }
6412   for (c = cMax; c < cEnd; ++c) {
6413     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6414 
6415     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6416     for (cl = 0; cl < closureSize*2; cl += 2) {
6417       const PetscInt p = closure[cl];
6418       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6419     }
6420     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6421     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %D has  %D vertices > %D", c, coneSize, numHybridCorners);
6422   }
6423   PetscFunctionReturn(0);
6424 }
6425 
6426 /*@
6427   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6428 
6429   Input Parameters:
6430 + dm - The DMPlex object
6431 . isSimplex - Are the cells simplices or tensor products
6432 - cellHeight - Normally 0
6433 
6434   Note: This is a useful diagnostic when creating meshes programmatically.
6435 
6436   Level: developer
6437 
6438 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6439 @*/
6440 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6441 {
6442   PetscInt       pMax[4];
6443   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6444   PetscErrorCode ierr;
6445 
6446   PetscFunctionBegin;
6447   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6448   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6449   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6450   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6451   for (h = cellHeight; h < dim; ++h) {
6452     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6453     for (c = cStart; c < cEnd; ++c) {
6454       const PetscInt *cone, *ornt, *faces;
6455       PetscInt        numFaces, faceSize, coneSize,f;
6456       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6457 
6458       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6459       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6460       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6461       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6462       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6463       for (cl = 0; cl < closureSize*2; cl += 2) {
6464         const PetscInt p = closure[cl];
6465         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6466       }
6467       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6468       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D faces but should have %D", c, coneSize, numFaces);
6469       for (f = 0; f < numFaces; ++f) {
6470         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6471 
6472         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6473         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6474           const PetscInt p = fclosure[cl];
6475           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6476         }
6477         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);
6478         for (v = 0; v < fnumCorners; ++v) {
6479           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]);
6480         }
6481         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6482       }
6483       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6484       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6485     }
6486   }
6487   PetscFunctionReturn(0);
6488 }
6489 
6490 /* Pointwise interpolation
6491      Just code FEM for now
6492      u^f = I u^c
6493      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6494      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6495      I_{ij} = psi^f_i phi^c_j
6496 */
6497 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6498 {
6499   PetscSection   gsc, gsf;
6500   PetscInt       m, n;
6501   void          *ctx;
6502   DM             cdm;
6503   PetscBool      regular;
6504   PetscErrorCode ierr;
6505 
6506   PetscFunctionBegin;
6507   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6508   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6509   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6510   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6511 
6512   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6513   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6514   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6515   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6516 
6517   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6518   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6519   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6520   else                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6521   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
6522   /* Use naive scaling */
6523   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6524   PetscFunctionReturn(0);
6525 }
6526 
6527 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
6528 {
6529   PetscErrorCode ierr;
6530   VecScatter     ctx;
6531 
6532   PetscFunctionBegin;
6533   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
6534   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
6535   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
6536   PetscFunctionReturn(0);
6537 }
6538 
6539 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
6540 {
6541   PetscSection   gsc, gsf;
6542   PetscInt       m, n;
6543   void          *ctx;
6544   DM             cdm;
6545   PetscBool      regular;
6546   PetscErrorCode ierr;
6547 
6548   PetscFunctionBegin;
6549   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6550   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6551   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6552   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6553 
6554   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
6555   ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6556   ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
6557   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6558 
6559   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6560   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6561   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6562   else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
6563   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
6564   PetscFunctionReturn(0);
6565 }
6566 
6567 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6568 {
6569   PetscSection   section;
6570   IS            *bcPoints, *bcComps;
6571   PetscBool     *isFE;
6572   PetscInt      *bcFields, *numComp, *numDof;
6573   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
6574   PetscInt       cStart, cEnd, cEndInterior;
6575   PetscErrorCode ierr;
6576 
6577   PetscFunctionBegin;
6578   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6579   /* FE and FV boundary conditions are handled slightly differently */
6580   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
6581   for (f = 0; f < numFields; ++f) {
6582     PetscObject  obj;
6583     PetscClassId id;
6584 
6585     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6586     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
6587     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
6588     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
6589     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
6590   }
6591   /* Allocate boundary point storage for FEM boundaries */
6592   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6593   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6594   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6595   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
6596   ierr = PetscDSGetNumBoundary(dm->prob, &numBd);CHKERRQ(ierr);
6597   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)");
6598   for (bd = 0; bd < numBd; ++bd) {
6599     PetscInt                field;
6600     DMBoundaryConditionType type;
6601     const char             *labelName;
6602     DMLabel                 label;
6603 
6604     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &labelName, &field, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6605     ierr = DMGetLabel(dm,labelName,&label);CHKERRQ(ierr);
6606     if (label && isFE[field] && (type & DM_BC_ESSENTIAL)) ++numBC;
6607   }
6608   /* Add ghost cell boundaries for FVM */
6609   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
6610   ierr = PetscCalloc3(numBC,&bcFields,numBC,&bcPoints,numBC,&bcComps);CHKERRQ(ierr);
6611   /* Constrain ghost cells for FV */
6612   for (f = 0; f < numFields; ++f) {
6613     PetscInt *newidx, c;
6614 
6615     if (isFE[f] || cEndInterior < 0) continue;
6616     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
6617     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
6618     bcFields[bc] = f;
6619     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6620   }
6621   /* Handle FEM Dirichlet boundaries */
6622   for (bd = 0; bd < numBd; ++bd) {
6623     const char             *bdLabel;
6624     DMLabel                 label;
6625     const PetscInt         *comps;
6626     const PetscInt         *values;
6627     PetscInt                bd2, field, numComps, numValues;
6628     DMBoundaryConditionType type;
6629     PetscBool               duplicate = PETSC_FALSE;
6630 
6631     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &bdLabel, &field, &numComps, &comps, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6632     ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6633     if (!isFE[field] || !label) continue;
6634     /* Only want to modify label once */
6635     for (bd2 = 0; bd2 < bd; ++bd2) {
6636       const char *bdname;
6637       ierr = PetscDSGetBoundary(dm->prob, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6638       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
6639       if (duplicate) break;
6640     }
6641     if (!duplicate && (isFE[field])) {
6642       /* don't complete cells, which are just present to give orientation to the boundary */
6643       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6644     }
6645     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
6646     if (type & DM_BC_ESSENTIAL) {
6647       PetscInt       *newidx;
6648       PetscInt        n, newn = 0, p, v;
6649 
6650       bcFields[bc] = field;
6651       if (numComps) {ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), numComps, comps, PETSC_COPY_VALUES, &bcComps[bc]);CHKERRQ(ierr);}
6652       for (v = 0; v < numValues; ++v) {
6653         IS              tmp;
6654         const PetscInt *idx;
6655 
6656         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6657         if (!tmp) continue;
6658         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6659         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6660         if (isFE[field]) {
6661           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
6662         } else {
6663           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
6664         }
6665         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6666         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6667       }
6668       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
6669       newn = 0;
6670       for (v = 0; v < numValues; ++v) {
6671         IS              tmp;
6672         const PetscInt *idx;
6673 
6674         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6675         if (!tmp) continue;
6676         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6677         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6678         if (isFE[field]) {
6679           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
6680         } else {
6681           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
6682         }
6683         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6684         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6685       }
6686       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6687     }
6688   }
6689   /* Handle discretization */
6690   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6691   for (f = 0; f < numFields; ++f) {
6692     PetscObject obj;
6693 
6694     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6695     if (isFE[f]) {
6696       PetscFE         fe = (PetscFE) obj;
6697       const PetscInt *numFieldDof;
6698       PetscInt        d;
6699 
6700       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6701       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6702       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6703     } else {
6704       PetscFV fv = (PetscFV) obj;
6705 
6706       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
6707       numDof[f*(dim+1)+dim] = numComp[f];
6708     }
6709   }
6710   for (f = 0; f < numFields; ++f) {
6711     PetscInt d;
6712     for (d = 1; d < dim; ++d) {
6713       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.");
6714     }
6715   }
6716   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcComps, bcPoints, NULL, &section);CHKERRQ(ierr);
6717   for (f = 0; f < numFields; ++f) {
6718     PetscFE     fe;
6719     const char *name;
6720 
6721     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6722     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6723     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6724   }
6725   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6726   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6727   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);ierr = ISDestroy(&bcComps[bc]);CHKERRQ(ierr);}
6728   ierr = PetscFree3(bcFields,bcPoints,bcComps);CHKERRQ(ierr);
6729   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6730   ierr = PetscFree(isFE);CHKERRQ(ierr);
6731   PetscFunctionReturn(0);
6732 }
6733 
6734 /*@
6735   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6736 
6737   Input Parameter:
6738 . dm - The DMPlex object
6739 
6740   Output Parameter:
6741 . regular - The flag
6742 
6743   Level: intermediate
6744 
6745 .seealso: DMPlexSetRegularRefinement()
6746 @*/
6747 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
6748 {
6749   PetscFunctionBegin;
6750   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6751   PetscValidPointer(regular, 2);
6752   *regular = ((DM_Plex *) dm->data)->regularRefinement;
6753   PetscFunctionReturn(0);
6754 }
6755 
6756 /*@
6757   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6758 
6759   Input Parameters:
6760 + dm - The DMPlex object
6761 - regular - The flag
6762 
6763   Level: intermediate
6764 
6765 .seealso: DMPlexGetRegularRefinement()
6766 @*/
6767 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
6768 {
6769   PetscFunctionBegin;
6770   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6771   ((DM_Plex *) dm->data)->regularRefinement = regular;
6772   PetscFunctionReturn(0);
6773 }
6774 
6775 /* anchors */
6776 /*@
6777   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
6778   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
6779 
6780   not collective
6781 
6782   Input Parameters:
6783 . dm - The DMPlex object
6784 
6785   Output Parameters:
6786 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
6787 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
6788 
6789 
6790   Level: intermediate
6791 
6792 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
6793 @*/
6794 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
6795 {
6796   DM_Plex *plex = (DM_Plex *)dm->data;
6797   PetscErrorCode ierr;
6798 
6799   PetscFunctionBegin;
6800   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6801   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
6802   if (anchorSection) *anchorSection = plex->anchorSection;
6803   if (anchorIS) *anchorIS = plex->anchorIS;
6804   PetscFunctionReturn(0);
6805 }
6806 
6807 /*@
6808   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
6809   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
6810   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
6811 
6812   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
6813   DMGetConstraints() and filling in the entries in the constraint matrix.
6814 
6815   collective on dm
6816 
6817   Input Parameters:
6818 + dm - The DMPlex object
6819 . 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).
6820 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
6821 
6822   The reference counts of anchorSection and anchorIS are incremented.
6823 
6824   Level: intermediate
6825 
6826 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
6827 @*/
6828 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
6829 {
6830   DM_Plex        *plex = (DM_Plex *)dm->data;
6831   PetscMPIInt    result;
6832   PetscErrorCode ierr;
6833 
6834   PetscFunctionBegin;
6835   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6836   if (anchorSection) {
6837     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
6838     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
6839     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
6840   }
6841   if (anchorIS) {
6842     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
6843     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
6844     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
6845   }
6846 
6847   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
6848   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
6849   plex->anchorSection = anchorSection;
6850 
6851   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
6852   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
6853   plex->anchorIS = anchorIS;
6854 
6855 #if defined(PETSC_USE_DEBUG)
6856   if (anchorIS && anchorSection) {
6857     PetscInt size, a, pStart, pEnd;
6858     const PetscInt *anchors;
6859 
6860     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6861     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
6862     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
6863     for (a = 0; a < size; a++) {
6864       PetscInt p;
6865 
6866       p = anchors[a];
6867       if (p >= pStart && p < pEnd) {
6868         PetscInt dof;
6869 
6870         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6871         if (dof) {
6872           PetscErrorCode ierr2;
6873 
6874           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
6875           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
6876         }
6877       }
6878     }
6879     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
6880   }
6881 #endif
6882   /* reset the generic constraints */
6883   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
6884   PetscFunctionReturn(0);
6885 }
6886 
6887 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
6888 {
6889   PetscSection anchorSection;
6890   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
6891   PetscErrorCode ierr;
6892 
6893   PetscFunctionBegin;
6894   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6895   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
6896   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
6897   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6898   if (numFields) {
6899     PetscInt f;
6900     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
6901 
6902     for (f = 0; f < numFields; f++) {
6903       PetscInt numComp;
6904 
6905       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
6906       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
6907     }
6908   }
6909   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6910   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
6911   pStart = PetscMax(pStart,sStart);
6912   pEnd   = PetscMin(pEnd,sEnd);
6913   pEnd   = PetscMax(pStart,pEnd);
6914   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
6915   for (p = pStart; p < pEnd; p++) {
6916     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6917     if (dof) {
6918       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
6919       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
6920       for (f = 0; f < numFields; f++) {
6921         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
6922         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
6923       }
6924     }
6925   }
6926   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
6927   PetscFunctionReturn(0);
6928 }
6929 
6930 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
6931 {
6932   PetscSection aSec;
6933   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
6934   const PetscInt *anchors;
6935   PetscInt numFields, f;
6936   IS aIS;
6937   PetscErrorCode ierr;
6938 
6939   PetscFunctionBegin;
6940   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6941   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
6942   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
6943   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
6944   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
6945   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
6946   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
6947   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
6948   /* cSec will be a subset of aSec and section */
6949   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
6950   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
6951   i[0] = 0;
6952   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6953   for (p = pStart; p < pEnd; p++) {
6954     PetscInt rDof, rOff, r;
6955 
6956     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6957     if (!rDof) continue;
6958     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6959     if (numFields) {
6960       for (f = 0; f < numFields; f++) {
6961         annz = 0;
6962         for (r = 0; r < rDof; r++) {
6963           a = anchors[rOff + r];
6964           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6965           annz += aDof;
6966         }
6967         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6968         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
6969         for (q = 0; q < dof; q++) {
6970           i[off + q + 1] = i[off + q] + annz;
6971         }
6972       }
6973     }
6974     else {
6975       annz = 0;
6976       for (q = 0; q < dof; q++) {
6977         a = anchors[off + q];
6978         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6979         annz += aDof;
6980       }
6981       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6982       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
6983       for (q = 0; q < dof; q++) {
6984         i[off + q + 1] = i[off + q] + annz;
6985       }
6986     }
6987   }
6988   nnz = i[m];
6989   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
6990   offset = 0;
6991   for (p = pStart; p < pEnd; p++) {
6992     if (numFields) {
6993       for (f = 0; f < numFields; f++) {
6994         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6995         for (q = 0; q < dof; q++) {
6996           PetscInt rDof, rOff, r;
6997           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6998           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6999           for (r = 0; r < rDof; r++) {
7000             PetscInt s;
7001 
7002             a = anchors[rOff + r];
7003             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
7004             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
7005             for (s = 0; s < aDof; s++) {
7006               j[offset++] = aOff + s;
7007             }
7008           }
7009         }
7010       }
7011     }
7012     else {
7013       ierr = PetscSectionGetDof(cSec,p,&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 = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7023           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
7024           for (s = 0; s < aDof; s++) {
7025             j[offset++] = aOff + s;
7026           }
7027         }
7028       }
7029     }
7030   }
7031   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
7032   ierr = PetscFree(i);CHKERRQ(ierr);
7033   ierr = PetscFree(j);CHKERRQ(ierr);
7034   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
7035   PetscFunctionReturn(0);
7036 }
7037 
7038 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
7039 {
7040   DM_Plex        *plex = (DM_Plex *)dm->data;
7041   PetscSection   anchorSection, section, cSec;
7042   Mat            cMat;
7043   PetscErrorCode ierr;
7044 
7045   PetscFunctionBegin;
7046   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7047   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
7048   if (anchorSection) {
7049     PetscDS  ds;
7050     PetscInt nf;
7051 
7052     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
7053     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
7054     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
7055     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
7056     ierr = PetscDSGetNumFields(ds,&nf);CHKERRQ(ierr);
7057     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
7058     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
7059     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
7060     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
7061   }
7062   PetscFunctionReturn(0);
7063 }
7064