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