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