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