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