xref: /petsc/src/dm/impls/plex/plex.c (revision 2c40f2344c842f34c985881e382e04cdc1a3b10e)
1 #include <petsc-private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <../src/sys/utils/hash.h>
3 #include <petsc-private/isimpl.h>
4 #include <petscsf.h>
5 #include <petscviewerhdf5.h>
6 
7 /* Logging support */
8 PetscLogEvent DMPLEX_Interpolate, DMPLEX_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeField, DMPLEX_DistributeData, DMPLEX_Stratify, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM;
9 
10 PETSC_EXTERN PetscErrorCode VecView_Seq(Vec, PetscViewer);
11 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
12 PETSC_EXTERN PetscErrorCode VecLoad_Default(Vec, PetscViewer);
13 
14 #undef __FUNCT__
15 #define __FUNCT__ "VecView_Plex_Local"
16 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
17 {
18   DM             dm;
19   PetscBool      isvtk, ishdf5, isseq;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
24   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
25   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
26   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
27   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
28   if (isvtk || ishdf5) {ierr = DMPlexInsertBoundaryValues(dm, v);CHKERRQ(ierr);}
29   if (isvtk) {
30     PetscViewerVTKFieldType ft = PETSC_VTK_POINT_FIELD;
31     PetscSection            section;
32     PetscInt                dim, pStart, pEnd, cStart, fStart, vStart, cdof = 0, fdof = 0, vdof = 0;
33 
34     ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
35     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
36     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
37     ierr = DMPlexGetHeightStratum(dm, 1, &fStart, NULL);CHKERRQ(ierr);
38     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, NULL);CHKERRQ(ierr);
39     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
40     /* Assumes that numer of dofs per point of each stratum is constant, natural for VTK */
41     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &cdof);CHKERRQ(ierr);}
42     if ((fStart >= pStart) && (fStart < pEnd)) {ierr = PetscSectionGetDof(section, fStart, &fdof);CHKERRQ(ierr);}
43     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vdof);CHKERRQ(ierr);}
44     if (cdof && fdof && vdof) { /* Actually Q2 or some such, but visualize as Q1 */
45       ft = (cdof == dim) ? PETSC_VTK_POINT_VECTOR_FIELD : PETSC_VTK_POINT_FIELD;
46     } else if (cdof && vdof) {
47       SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"No support for viewing mixed space with dofs at both vertices and cells");
48     } else if (cdof) {
49       /* TODO: This assumption should be removed when there is a way of identifying whether a space is conceptually a
50        * vector or just happens to have the same number of dofs as the dimension. */
51       if (cdof == dim) {
52         ft = PETSC_VTK_CELL_VECTOR_FIELD;
53       } else {
54         ft = PETSC_VTK_CELL_FIELD;
55       }
56     } else if (vdof) {
57       if (vdof == dim) {
58         ft = PETSC_VTK_POINT_VECTOR_FIELD;
59       } else {
60         ft = PETSC_VTK_POINT_FIELD;
61       }
62     } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Could not classify input Vec for VTK");
63 
64     ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr); /* viewer drops reference */
65     ierr = PetscObjectReference((PetscObject) v);CHKERRQ(ierr);  /* viewer drops reference */
66     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, ft, (PetscObject) v);CHKERRQ(ierr);
67   } else if (ishdf5) {
68     DM          dmBC;
69     Vec         gv;
70     const char *name;
71 
72     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
73     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
74     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
75     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
76     ierr = DMLocalToGlobalBegin(dmBC, v, INSERT_VALUES, gv);CHKERRQ(ierr);
77     ierr = DMLocalToGlobalEnd(dmBC, v, INSERT_VALUES, gv);CHKERRQ(ierr);
78     ierr = PetscViewerHDF5PushGroup(viewer, "/fields");CHKERRQ(ierr);
79     /* TODO ierr = PetscViewerHDF5SetTimestep(viewer, istep);CHKERRQ(ierr); */
80     ierr = PetscObjectTypeCompare((PetscObject) gv, VECSEQ, &isseq);CHKERRQ(ierr);
81     if (isseq) {ierr = VecView_Seq(gv, viewer);CHKERRQ(ierr);}
82     else       {ierr = VecView_MPI(gv, viewer);CHKERRQ(ierr);}
83     ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);
84     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
85   } else {
86     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
87     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
88   }
89   PetscFunctionReturn(0);
90 }
91 
92 #undef __FUNCT__
93 #define __FUNCT__ "VecView_Plex"
94 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
95 {
96   DM             dm;
97   PetscBool      isvtk, ishdf5, isseq;
98   PetscErrorCode ierr;
99 
100   PetscFunctionBegin;
101   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
102   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
103   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
104   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
105   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
106   if (isvtk || ishdf5) {
107     Vec         locv;
108     const char *name;
109 
110     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
111     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
112     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
113     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
114     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
115     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
116     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
117   } else {
118     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
119     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
120   }
121   PetscFunctionReturn(0);
122 }
123 
124 #undef __FUNCT__
125 #define __FUNCT__ "VecLoad_Plex_Local"
126 PetscErrorCode VecLoad_Plex_Local(Vec v, PetscViewer viewer)
127 {
128   DM             dm;
129   PetscBool      ishdf5;
130   PetscErrorCode ierr;
131 
132   PetscFunctionBegin;
133   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
134   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
135   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
136   if (ishdf5) {
137     DM          dmBC;
138     Vec         gv;
139     const char *name;
140 
141     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
142     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
143     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
144     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
145     ierr = VecLoad_Default(gv, viewer);CHKERRQ(ierr);
146     ierr = DMGlobalToLocalBegin(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
147     ierr = DMGlobalToLocalEnd(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
148     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
149   } else {
150     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
151   }
152   PetscFunctionReturn(0);
153 }
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "VecLoad_Plex"
157 PetscErrorCode VecLoad_Plex(Vec v, PetscViewer viewer)
158 {
159   DM             dm;
160   PetscBool      ishdf5;
161   PetscErrorCode ierr;
162 
163   PetscFunctionBegin;
164   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
165   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
166   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
167   if (ishdf5) {
168     Vec         locv;
169     const char *name;
170 
171     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
172     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
173     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
174     if (ishdf5) {
175       ierr = PetscViewerHDF5PushGroup(viewer, "/fields");CHKERRQ(ierr);
176       /* TODO ierr = PetscViewerHDF5SetTimestep(viewer, istep);CHKERRQ(ierr); */
177     }
178     ierr = VecLoad_Plex_Local(locv, viewer);CHKERRQ(ierr);
179     if (ishdf5) {ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);}
180     ierr = DMLocalToGlobalBegin(dm, locv, INSERT_VALUES, v);CHKERRQ(ierr);
181     ierr = DMLocalToGlobalEnd(dm, locv, INSERT_VALUES, v);CHKERRQ(ierr);
182     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
183   } else {
184     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
185   }
186   PetscFunctionReturn(0);
187 }
188 
189 #undef __FUNCT__
190 #define __FUNCT__ "DMPlexView_Ascii"
191 PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
192 {
193   DM_Plex          *mesh = (DM_Plex*) dm->data;
194   DM                cdm;
195   DMLabel           markers;
196   PetscSection      coordSection;
197   Vec               coordinates;
198   PetscViewerFormat format;
199   PetscErrorCode    ierr;
200 
201   PetscFunctionBegin;
202   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
203   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
204   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
205   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
206   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
207     const char *name;
208     PetscInt    maxConeSize, maxSupportSize;
209     PetscInt    pStart, pEnd, p;
210     PetscMPIInt rank, size;
211 
212     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
213     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
214     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
215     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
216     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
217     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
218     ierr = PetscViewerASCIIPrintf(viewer, "Mesh '%s':\n", name);CHKERRQ(ierr);
219     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "Max sizes cone: %D support: %D\n", maxConeSize, maxSupportSize);CHKERRQ(ierr);
220     ierr = PetscViewerASCIIPrintf(viewer, "orientation is missing\n", name);CHKERRQ(ierr);
221     ierr = PetscViewerASCIIPrintf(viewer, "cap --> base:\n", name);CHKERRQ(ierr);
222     for (p = pStart; p < pEnd; ++p) {
223       PetscInt dof, off, s;
224 
225       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
226       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
227       for (s = off; s < off+dof; ++s) {
228         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%D]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
229       }
230     }
231     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
232     ierr = PetscViewerASCIIPrintf(viewer, "base <-- cap:\n", name);CHKERRQ(ierr);
233     for (p = pStart; p < pEnd; ++p) {
234       PetscInt dof, off, c;
235 
236       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
237       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
238       for (c = off; c < off+dof; ++c) {
239         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%D]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
240       }
241     }
242     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
243     ierr = PetscSectionGetChart(coordSection, &pStart, NULL);CHKERRQ(ierr);
244     if (pStart >= 0) {ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);}
245     ierr = DMPlexGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
246     ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);
247     if (size > 1) {
248       PetscSF sf;
249 
250       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
251       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
252     }
253     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
254   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
255     const char  *name;
256     const char  *colors[3] = {"red", "blue", "green"};
257     const int    numColors  = 3;
258     PetscReal    scale      = 2.0;
259     PetscScalar *coords;
260     PetscInt     depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
261     PetscMPIInt  rank, size;
262 
263     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
264     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
265     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
266     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
267     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
268     ierr = PetscViewerASCIIPrintf(viewer, "\
269 \\documentclass[crop,multi=false]{standalone}\n\n\
270 \\usepackage{tikz}\n\
271 \\usepackage{pgflibraryshapes}\n\
272 \\usetikzlibrary{backgrounds}\n\
273 \\usetikzlibrary{arrows}\n\
274 \\begin{document}\n\
275 \\section{%s}\n\
276 \\begin{center}\n", name, 8.0/scale);CHKERRQ(ierr);
277     ierr = PetscViewerASCIIPrintf(viewer, "Mesh for process ");CHKERRQ(ierr);
278     for (p = 0; p < size; ++p) {
279       if (p > 0 && p == size-1) {
280         ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
281       } else if (p > 0) {
282         ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
283       }
284       ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
285     }
286     ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n\
287 \\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n");CHKERRQ(ierr);
288     /* Plot vertices */
289     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
290     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
291     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
292     for (v = vStart; v < vEnd; ++v) {
293       PetscInt off, dof, d;
294 
295       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
296       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
297       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
298       for (d = 0; d < dof; ++d) {
299         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
300         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*PetscRealPart(coords[off+d])));CHKERRQ(ierr);
301       }
302       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", v, rank, colors[rank%numColors], v);CHKERRQ(ierr);
303     }
304     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
305     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
306     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
307     /* Plot edges */
308     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
309     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
310     if (depth > 1) {ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);}
311     for (e = eStart; e < eEnd; ++e) {
312       const PetscInt *cone;
313       PetscInt        coneSize, offA, offB, dof, d;
314 
315       ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
316       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %d cone should have two vertices, not %d", e, coneSize);
317       ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
318       ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
319       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
320       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
321       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
322       for (d = 0; d < dof; ++d) {
323         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
324         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*0.5*PetscRealPart(coords[offA+d]+coords[offB+d])));CHKERRQ(ierr);
325       }
326       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", e, rank, colors[rank%numColors], e);CHKERRQ(ierr);
327     }
328     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
329     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
330     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
331     /* Plot cells */
332     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
333     for (c = cStart; c < cEnd; ++c) {
334       PetscInt *closure = NULL;
335       PetscInt  closureSize, firstPoint = -1;
336 
337       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
338       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
339       for (p = 0; p < closureSize*2; p += 2) {
340         const PetscInt point = closure[p];
341 
342         if ((point < vStart) || (point >= vEnd)) continue;
343         if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
344         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%D)", point, rank);CHKERRQ(ierr);
345         if (firstPoint < 0) firstPoint = point;
346       }
347       /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
348       ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%D);\n", firstPoint, rank);CHKERRQ(ierr);
349       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
350     }
351     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
352     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n\\end{center}\n");CHKERRQ(ierr);
353     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
354   } else {
355     MPI_Comm    comm;
356     PetscInt   *sizes, *hybsizes;
357     PetscInt    locDepth, depth, dim, d, pMax[4];
358     PetscInt    pStart, pEnd, p;
359     PetscInt    numLabels, l;
360     const char *name;
361     PetscMPIInt size;
362 
363     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
364     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
365     ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
366     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
367     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimensions:\n", name, dim);CHKERRQ(ierr);}
368     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimensions:\n", dim);CHKERRQ(ierr);}
369     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
370     ierr = MPI_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
371     ierr = DMPlexGetHybridBounds(dm, &pMax[depth], &pMax[depth-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
372     ierr = PetscMalloc2(size,&sizes,size,&hybsizes);CHKERRQ(ierr);
373     if (depth == 1) {
374       ierr = DMPlexGetDepthStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
375       pEnd = pEnd - pStart;
376       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
377       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", 0);CHKERRQ(ierr);
378       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
379       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
380       ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
381       pEnd = pEnd - pStart;
382       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
383       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", dim);CHKERRQ(ierr);
384       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
385       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
386     } else {
387       for (d = 0; d <= dim; d++) {
388         ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
389         pEnd    -= pStart;
390         pMax[d] -= pStart;
391         ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
392         ierr = MPI_Gather(&pMax[d], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
393         ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", d);CHKERRQ(ierr);
394         for (p = 0; p < size; ++p) {
395           if (hybsizes[p] >= 0) {ierr = PetscViewerASCIIPrintf(viewer, " %D (%D)", sizes[p], sizes[p] - hybsizes[p]);CHKERRQ(ierr);}
396           else                  {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
397         }
398         ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
399       }
400     }
401     ierr = PetscFree2(sizes,hybsizes);CHKERRQ(ierr);
402     ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
403     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
404     for (l = 0; l < numLabels; ++l) {
405       DMLabel         label;
406       const char     *name;
407       IS              valueIS;
408       const PetscInt *values;
409       PetscInt        numValues, v;
410 
411       ierr = DMPlexGetLabelName(dm, l, &name);CHKERRQ(ierr);
412       ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
413       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
414       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %d strata of sizes (", name, numValues);CHKERRQ(ierr);
415       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
416       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
417       for (v = 0; v < numValues; ++v) {
418         PetscInt size;
419 
420         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
421         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
422         ierr = PetscViewerASCIIPrintf(viewer, "%d", size);CHKERRQ(ierr);
423       }
424       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
425       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
426       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
427     }
428   }
429   PetscFunctionReturn(0);
430 }
431 
432 #if defined(PETSC_HAVE_HDF5)
433 #undef __FUNCT__
434 #define __FUNCT__ "DMPlexView_HDF5"
435 /* We only write cells and vertices. Does this screw up parallel reading? */
436 PetscErrorCode DMPlexView_HDF5(DM dm, PetscViewer viewer)
437 {
438   DM              cdm;
439   Vec             coordinates, newcoords;
440   Vec             coneVec, cellVec;
441   IS              globalVertexNumbers;
442   const PetscInt *gvertex;
443   PetscScalar    *sizes, *vertices;
444   PetscReal       lengthScale;
445   const char     *label   = NULL;
446   PetscInt        labelId = 0, dim;
447   PetscInt        vStart, vEnd, v, cellHeight, cStart, cEnd, cMax, cell, conesSize = 0, numCornersLocal = 0, numCorners;
448   PetscErrorCode  ierr;
449 
450   PetscFunctionBegin;
451   /* Write coordinates */
452   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
453   ierr = DMPlexGetScale(dm, PETSC_UNIT_LENGTH, &lengthScale);CHKERRQ(ierr);
454   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
455   ierr = DMGetCoordinates(dm, &coordinates);CHKERRQ(ierr);
456   ierr = VecDuplicate(coordinates, &newcoords);CHKERRQ(ierr);
457   ierr = PetscObjectSetName((PetscObject) newcoords, "vertices");CHKERRQ(ierr);
458   ierr = VecCopy(coordinates, newcoords);CHKERRQ(ierr);
459   ierr = VecScale(newcoords, lengthScale);CHKERRQ(ierr);
460   ierr = PetscViewerHDF5PushGroup(viewer, "/geometry");CHKERRQ(ierr);
461   ierr = VecView(newcoords, viewer);CHKERRQ(ierr);
462   ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);
463   ierr = VecDestroy(&newcoords);CHKERRQ(ierr);
464   /* Write toplogy */
465   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
466   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
467   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
468   ierr = DMPlexGetHybridBounds(dm, &cMax, PETSC_NULL, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
469   if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
470 
471   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &coneVec);CHKERRQ(ierr);
472   ierr = VecSetSizes(coneVec, cEnd-cStart, PETSC_DETERMINE);CHKERRQ(ierr);
473   ierr = VecSetBlockSize(coneVec, 1);CHKERRQ(ierr);
474   ierr = VecSetFromOptions(coneVec);CHKERRQ(ierr);
475   ierr = PetscObjectSetName((PetscObject) coneVec, "coneSize");CHKERRQ(ierr);
476   ierr = VecGetArray(coneVec, &sizes);CHKERRQ(ierr);
477   for (cell = cStart; cell < cEnd; ++cell) {
478     PetscInt *closure = NULL;
479     PetscInt  closureSize, v, Nc = 0;
480 
481     if (label) {
482       PetscInt value;
483       ierr = DMPlexGetLabelValue(dm, label, cell, &value);CHKERRQ(ierr);
484       if (value == labelId) continue;
485     }
486     ierr = DMPlexGetTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
487     for (v = 0; v < closureSize*2; v += 2) {
488       if ((closure[v] >= vStart) && (closure[v] < vEnd)) ++Nc;
489     }
490     ierr = DMPlexRestoreTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
491     conesSize += Nc;
492     if (!numCornersLocal)           numCornersLocal = Nc;
493     else if (numCornersLocal != Nc) numCornersLocal = 1;
494   }
495   ierr = VecRestoreArray(coneVec, &sizes);CHKERRQ(ierr);
496   ierr = MPI_Allreduce(&numCornersLocal, &numCorners, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
497   if (numCornersLocal && numCornersLocal != numCorners) numCorners = 1;
498 
499   ierr = DMPlexGetVertexNumbering(dm, &globalVertexNumbers);CHKERRQ(ierr);
500   ierr = ISGetIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
501   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cellVec);CHKERRQ(ierr);
502   ierr = VecSetSizes(cellVec, conesSize, PETSC_DETERMINE);CHKERRQ(ierr);
503   ierr = VecSetBlockSize(cellVec, numCorners);CHKERRQ(ierr);
504   ierr = VecSetFromOptions(cellVec);CHKERRQ(ierr);
505   ierr = PetscObjectSetName((PetscObject) cellVec, "cells");CHKERRQ(ierr);
506   ierr = VecGetArray(cellVec, &vertices);CHKERRQ(ierr);
507   for (cell = cStart, v = 0; cell < cEnd; ++cell) {
508     PetscInt *closure = NULL;
509     PetscInt  closureSize, Nc = 0, p;
510 
511     if (label) {
512       PetscInt value;
513       ierr = DMPlexGetLabelValue(dm, label, cell, &value);CHKERRQ(ierr);
514       if (value == labelId) continue;
515     }
516     ierr = DMPlexGetTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
517     for (p = 0; p < closureSize*2; p += 2) {
518       if ((closure[p] >= vStart) && (closure[p] < vEnd)) {
519         closure[Nc++] = closure[p];
520         }
521     }
522     ierr = DMPlexInvertCell(dim, Nc, closure);CHKERRQ(ierr);
523     for (p = 0; p < Nc; ++p) {
524       const PetscInt gv = gvertex[closure[p] - vStart];
525       vertices[v++] = gv < 0 ? -(gv+1) : gv;
526     }
527     ierr = DMPlexRestoreTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
528   }
529   if (v != conesSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of cell vertices %d != %d", v, conesSize);
530   ierr = VecRestoreArray(cellVec, &vertices);CHKERRQ(ierr);
531   ierr = PetscViewerHDF5PushGroup(viewer, "/topology");CHKERRQ(ierr);
532   ierr = VecView(cellVec, viewer);CHKERRQ(ierr);
533   if (numCorners == 1) {
534     ierr = VecView(coneVec, viewer);CHKERRQ(ierr);
535   } else {
536     ierr = PetscViewerHDF5WriteAttribute(viewer, "/topology/cells", "cell_corners", PETSC_INT, (void *) &numCorners);CHKERRQ(ierr);
537   }
538   ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);
539   ierr = VecDestroy(&cellVec);CHKERRQ(ierr);
540   ierr = VecDestroy(&coneVec);CHKERRQ(ierr);
541   ierr = ISRestoreIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
542 
543   ierr = PetscViewerHDF5WriteAttribute(viewer, "/topology/cells", "cell_dim", PETSC_INT, (void *) &dim);CHKERRQ(ierr);
544   PetscFunctionReturn(0);
545 }
546 #endif
547 
548 #undef __FUNCT__
549 #define __FUNCT__ "DMView_Plex"
550 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
551 {
552   PetscBool      iascii, ishdf5;
553   PetscErrorCode ierr;
554 
555   PetscFunctionBegin;
556   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
557   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
558   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
559   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
560   if (iascii) {
561     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
562   } else if (ishdf5) {
563 #if defined(PETSC_HAVE_HDF5)
564     ierr = DMPlexView_HDF5(dm, viewer);CHKERRQ(ierr);
565 #else
566     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
567 #endif
568   }
569   PetscFunctionReturn(0);
570 }
571 
572 #if defined(PETSC_HAVE_HDF5)
573 #undef __FUNCT__
574 #define __FUNCT__ "DMPlexLoad_HDF5"
575 /* The first version will read everything onto proc 0, letting the user distribute
576    The next will create a naive partition, and then rebalance after reading
577 */
578 PetscErrorCode DMPlexLoad_HDF5(DM dm, PetscViewer viewer)
579 {
580   PetscSection    coordSection;
581   Vec             coordinates;
582   Vec             cellVec;
583   PetscScalar    *cells;
584   PetscReal       lengthScale;
585   PetscInt       *cone;
586   PetscInt        dim, spatialDim, numVertices, v, numCorners, numCells, cell, c;
587   PetscErrorCode  ierr;
588 
589   PetscFunctionBegin;
590   /* Read geometry */
591   ierr = PetscViewerHDF5PushGroup(viewer, "/geometry");CHKERRQ(ierr);
592   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &coordinates);CHKERRQ(ierr);
593   ierr = PetscObjectSetName((PetscObject) coordinates, "vertices");CHKERRQ(ierr);
594   ierr = VecLoad(coordinates, viewer);CHKERRQ(ierr);
595   ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);
596   ierr = DMPlexGetScale(dm, PETSC_UNIT_LENGTH, &lengthScale);CHKERRQ(ierr);
597   ierr = VecScale(coordinates, 1.0/lengthScale);CHKERRQ(ierr);
598   ierr = VecGetSize(coordinates, &numVertices);CHKERRQ(ierr);
599   ierr = VecGetBlockSize(coordinates, &spatialDim);CHKERRQ(ierr);
600   numVertices /= spatialDim;
601   /* Read toplogy */
602   ierr = PetscViewerHDF5ReadAttribute(viewer, "/topology/cells", "cell_dim", PETSC_INT, (void *) &dim);CHKERRQ(ierr);
603   ierr = DMPlexSetDimension(dm, dim);CHKERRQ(ierr);
604   /*   TODO Check for coneSize vector rather than this attribute */
605   ierr = PetscViewerHDF5ReadAttribute(viewer, "/topology/cells", "cell_corners", PETSC_INT, (void *) &numCorners);CHKERRQ(ierr);
606   ierr = PetscViewerHDF5PushGroup(viewer, "/topology");CHKERRQ(ierr);
607   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cellVec);CHKERRQ(ierr);
608   ierr = VecSetBlockSize(cellVec, numCorners);CHKERRQ(ierr);
609   ierr = PetscObjectSetName((PetscObject) cellVec, "cells");CHKERRQ(ierr);
610   ierr = VecLoad(cellVec, viewer);CHKERRQ(ierr);
611   ierr = PetscViewerHDF5PopGroup(viewer);CHKERRQ(ierr);
612   ierr = VecGetSize(cellVec, &numCells);CHKERRQ(ierr);
613   numCells /= numCorners;
614   /* Create Plex */
615   ierr = DMPlexSetChart(dm, 0, numCells+numVertices);CHKERRQ(ierr);
616   for (cell = 0; cell < numCells; ++cell) {ierr = DMPlexSetConeSize(dm, cell, numCorners);CHKERRQ(ierr);}
617   ierr = DMSetUp(dm);CHKERRQ(ierr);
618   ierr = PetscMalloc1(numCorners,&cone);CHKERRQ(ierr);
619   ierr = VecGetArray(cellVec, &cells);CHKERRQ(ierr);
620   for (cell = 0; cell < numCells; ++cell) {
621     for (c = 0; c < numCorners; ++c) {cone[c] = numCells + cells[cell*numCorners+c];}
622     ierr = DMPlexSetCone(dm, cell, cone);CHKERRQ(ierr);
623   }
624   ierr = VecRestoreArray(cellVec, &cells);CHKERRQ(ierr);
625   ierr = PetscFree(cone);CHKERRQ(ierr);
626   ierr = VecDestroy(&cellVec);CHKERRQ(ierr);
627   ierr = DMPlexSymmetrize(dm);CHKERRQ(ierr);
628   ierr = DMPlexStratify(dm);CHKERRQ(ierr);
629   /* Create coordinates */
630   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
631   ierr = PetscSectionSetNumFields(coordSection, 1);CHKERRQ(ierr);
632   ierr = PetscSectionSetFieldComponents(coordSection, 0, spatialDim);CHKERRQ(ierr);
633   ierr = PetscSectionSetChart(coordSection, numCells, numCells+numVertices);CHKERRQ(ierr);
634   for (v = numCells; v < numCells+numVertices; ++v) {
635     ierr = PetscSectionSetDof(coordSection, v, spatialDim);CHKERRQ(ierr);
636     ierr = PetscSectionSetFieldDof(coordSection, v, 0, spatialDim);CHKERRQ(ierr);
637   }
638   ierr = PetscSectionSetUp(coordSection);CHKERRQ(ierr);
639   ierr = DMSetCoordinates(dm, coordinates);CHKERRQ(ierr);
640   ierr = VecDestroy(&coordinates);CHKERRQ(ierr);
641   /* TODO Labels*/
642   PetscFunctionReturn(0);
643 }
644 #endif
645 
646 #undef __FUNCT__
647 #define __FUNCT__ "DMLoad_Plex"
648 PetscErrorCode DMLoad_Plex(DM dm, PetscViewer viewer)
649 {
650   PetscBool      isbinary, ishdf5;
651   PetscErrorCode ierr;
652 
653   PetscFunctionBegin;
654   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
655   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
656   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
657   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,   &ishdf5);CHKERRQ(ierr);
658   if (isbinary) {SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Do not yet support binary viewers");}
659   else if (ishdf5) {
660     DM odm;
661 #if defined(PETSC_HAVE_HDF5)
662     ierr = DMCreate(PetscObjectComm((PetscObject) dm), &odm);CHKERRQ(ierr);
663     ierr = DMSetType(odm, DMPLEX);CHKERRQ(ierr);
664     ierr = DMPlexLoad_HDF5(odm, viewer);CHKERRQ(ierr);
665     ierr = DMPlexInterpolate(odm, &dm);CHKERRQ(ierr);
666     ierr = DMPlexCopyCoordinates(odm, dm);CHKERRQ(ierr);
667     ierr = DMDestroy(&odm);CHKERRQ(ierr);
668 #else
669     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
670 #endif
671   }
672   PetscFunctionReturn(0);
673 }
674 
675 #undef __FUNCT__
676 #define __FUNCT__ "BoundaryDestroy"
677 static PetscErrorCode BoundaryDestroy(DMBoundary *boundary)
678 {
679   DMBoundary     b, next;
680   PetscErrorCode ierr;
681 
682   PetscFunctionBeginUser;
683   if (!boundary) PetscFunctionReturn(0);
684   b = *boundary;
685   *boundary = NULL;
686   for (; b; b = next) {
687     next = b->next;
688     ierr = PetscFree(b->ids);CHKERRQ(ierr);
689     ierr = PetscFree(b->name);CHKERRQ(ierr);
690     ierr = PetscFree(b);CHKERRQ(ierr);
691   }
692   PetscFunctionReturn(0);
693 }
694 
695 #undef __FUNCT__
696 #define __FUNCT__ "DMDestroy_Plex"
697 PetscErrorCode DMDestroy_Plex(DM dm)
698 {
699   DM_Plex       *mesh = (DM_Plex*) dm->data;
700   DMLabel        next  = mesh->labels;
701   PetscErrorCode ierr;
702 
703   PetscFunctionBegin;
704   if (--mesh->refct > 0) PetscFunctionReturn(0);
705   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
706   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
707   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
708   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
709   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
710   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
711   while (next) {
712     DMLabel tmp = next->next;
713 
714     ierr = DMLabelDestroy(&next);CHKERRQ(ierr);
715     next = tmp;
716   }
717   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
718   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
719   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
720   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
721   ierr = BoundaryDestroy(&mesh->boundary);CHKERRQ(ierr);
722   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
723   ierr = PetscFree(mesh);CHKERRQ(ierr);
724   PetscFunctionReturn(0);
725 }
726 
727 #undef __FUNCT__
728 #define __FUNCT__ "DMCreateMatrix_Plex"
729 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
730 {
731   PetscSection   section, sectionGlobal;
732   PetscInt       bs = -1;
733   PetscInt       localSize;
734   PetscBool      isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock;
735   PetscErrorCode ierr;
736   MatType        mtype;
737 
738   PetscFunctionBegin;
739   ierr = MatInitializePackage();CHKERRQ(ierr);
740   mtype = dm->mattype;
741   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
742   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
743   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
744   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
745   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
746   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
747   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
748   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
749   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
750   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
751   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
752   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
753   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
754   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
755   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
756   if (!isShell) {
757     PetscBool fillMatrix = (PetscBool) !dm->prealloc_only;
758     PetscInt *dnz, *onz, *dnzu, *onzu, bsLocal, bsMax, bsMin;
759 
760     if (bs < 0) {
761       if (isBlock || isSeqBlock || isMPIBlock || isSymBlock || isSymSeqBlock || isSymMPIBlock) {
762         PetscInt pStart, pEnd, p, dof, cdof;
763 
764         ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
765         for (p = pStart; p < pEnd; ++p) {
766           ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
767           ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
768           if (dof-cdof) {
769             if (bs < 0) {
770               bs = dof-cdof;
771             } else if (bs != dof-cdof) {
772               /* Layout does not admit a pointwise block size */
773               bs = 1;
774               break;
775             }
776           }
777         }
778         /* Must have same blocksize on all procs (some might have no points) */
779         bsLocal = bs;
780         ierr = MPI_Allreduce(&bsLocal, &bsMax, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
781         bsLocal = bs < 0 ? bsMax : bs;
782         ierr = MPI_Allreduce(&bsLocal, &bsMin, 1, MPIU_INT, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
783         if (bsMin != bsMax) {
784           bs = 1;
785         } else {
786           bs = bsMax;
787         }
788       } else {
789         bs = 1;
790       }
791     }
792     ierr = PetscCalloc4(localSize/bs, &dnz, localSize/bs, &onz, localSize/bs, &dnzu, localSize/bs, &onzu);CHKERRQ(ierr);
793     ierr = DMPlexPreallocateOperator(dm, bs, section, sectionGlobal, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
794     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
795   }
796   PetscFunctionReturn(0);
797 }
798 
799 #undef __FUNCT__
800 #define __FUNCT__ "DMPlexGetDimension"
801 /*@
802   DMPlexGetDimension - Return the topological mesh dimension
803 
804   Not collective
805 
806   Input Parameter:
807 . mesh - The DMPlex
808 
809   Output Parameter:
810 . dim - The topological mesh dimension
811 
812   Level: beginner
813 
814 .seealso: DMPlexCreate()
815 @*/
816 PetscErrorCode DMPlexGetDimension(DM dm, PetscInt *dim)
817 {
818   DM_Plex *mesh = (DM_Plex*) dm->data;
819 
820   PetscFunctionBegin;
821   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
822   PetscValidPointer(dim, 2);
823   *dim = mesh->dim;
824   PetscFunctionReturn(0);
825 }
826 
827 #undef __FUNCT__
828 #define __FUNCT__ "DMPlexSetDimension"
829 /*@
830   DMPlexSetDimension - Set the topological mesh dimension
831 
832   Collective on mesh
833 
834   Input Parameters:
835 + mesh - The DMPlex
836 - dim - The topological mesh dimension
837 
838   Level: beginner
839 
840 .seealso: DMPlexCreate()
841 @*/
842 PetscErrorCode DMPlexSetDimension(DM dm, PetscInt dim)
843 {
844   DM_Plex *mesh = (DM_Plex*) dm->data;
845 
846   PetscFunctionBegin;
847   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
848   PetscValidLogicalCollectiveInt(dm, dim, 2);
849   mesh->dim = dim;
850   PetscFunctionReturn(0);
851 }
852 
853 #undef __FUNCT__
854 #define __FUNCT__ "DMPlexGetChart"
855 /*@
856   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
857 
858   Not collective
859 
860   Input Parameter:
861 . mesh - The DMPlex
862 
863   Output Parameters:
864 + pStart - The first mesh point
865 - pEnd   - The upper bound for mesh points
866 
867   Level: beginner
868 
869 .seealso: DMPlexCreate(), DMPlexSetChart()
870 @*/
871 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
872 {
873   DM_Plex       *mesh = (DM_Plex*) dm->data;
874   PetscErrorCode ierr;
875 
876   PetscFunctionBegin;
877   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
878   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
879   PetscFunctionReturn(0);
880 }
881 
882 #undef __FUNCT__
883 #define __FUNCT__ "DMPlexSetChart"
884 /*@
885   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
886 
887   Not collective
888 
889   Input Parameters:
890 + mesh - The DMPlex
891 . pStart - The first mesh point
892 - pEnd   - The upper bound for mesh points
893 
894   Output Parameters:
895 
896   Level: beginner
897 
898 .seealso: DMPlexCreate(), DMPlexGetChart()
899 @*/
900 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
901 {
902   DM_Plex       *mesh = (DM_Plex*) dm->data;
903   PetscErrorCode ierr;
904 
905   PetscFunctionBegin;
906   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
907   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
908   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
909   PetscFunctionReturn(0);
910 }
911 
912 #undef __FUNCT__
913 #define __FUNCT__ "DMPlexGetConeSize"
914 /*@
915   DMPlexGetConeSize - Return the number of in-edges for this point in the Sieve DAG
916 
917   Not collective
918 
919   Input Parameters:
920 + mesh - The DMPlex
921 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
922 
923   Output Parameter:
924 . size - The cone size for point p
925 
926   Level: beginner
927 
928 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
929 @*/
930 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
931 {
932   DM_Plex       *mesh = (DM_Plex*) dm->data;
933   PetscErrorCode ierr;
934 
935   PetscFunctionBegin;
936   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
937   PetscValidPointer(size, 3);
938   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
939   PetscFunctionReturn(0);
940 }
941 
942 #undef __FUNCT__
943 #define __FUNCT__ "DMPlexSetConeSize"
944 /*@
945   DMPlexSetConeSize - Set the number of in-edges for this point in the Sieve DAG
946 
947   Not collective
948 
949   Input Parameters:
950 + mesh - The DMPlex
951 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
952 - size - The cone size for point p
953 
954   Output Parameter:
955 
956   Note:
957   This should be called after DMPlexSetChart().
958 
959   Level: beginner
960 
961 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
962 @*/
963 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
964 {
965   DM_Plex       *mesh = (DM_Plex*) dm->data;
966   PetscErrorCode ierr;
967 
968   PetscFunctionBegin;
969   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
970   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
971 
972   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
973   PetscFunctionReturn(0);
974 }
975 
976 #undef __FUNCT__
977 #define __FUNCT__ "DMPlexGetCone"
978 /*@C
979   DMPlexGetCone - Return the points on the in-edges for this point in the Sieve DAG
980 
981   Not collective
982 
983   Input Parameters:
984 + mesh - The DMPlex
985 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
986 
987   Output Parameter:
988 . cone - An array of points which are on the in-edges for point p
989 
990   Level: beginner
991 
992   Fortran Notes:
993   Since it returns an array, this routine is only available in Fortran 90, and you must
994   include petsc.h90 in your code.
995 
996   You must also call DMPlexRestoreCone() after you finish using the returned array.
997 
998 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart()
999 @*/
1000 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
1001 {
1002   DM_Plex       *mesh = (DM_Plex*) dm->data;
1003   PetscInt       off;
1004   PetscErrorCode ierr;
1005 
1006   PetscFunctionBegin;
1007   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1008   PetscValidPointer(cone, 3);
1009   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1010   *cone = &mesh->cones[off];
1011   PetscFunctionReturn(0);
1012 }
1013 
1014 #undef __FUNCT__
1015 #define __FUNCT__ "DMPlexSetCone"
1016 /*@
1017   DMPlexSetCone - Set the points on the in-edges for this point in the Sieve DAG
1018 
1019   Not collective
1020 
1021   Input Parameters:
1022 + mesh - The DMPlex
1023 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1024 - cone - An array of points which are on the in-edges for point p
1025 
1026   Output Parameter:
1027 
1028   Note:
1029   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1030 
1031   Level: beginner
1032 
1033 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1034 @*/
1035 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
1036 {
1037   DM_Plex       *mesh = (DM_Plex*) dm->data;
1038   PetscInt       pStart, pEnd;
1039   PetscInt       dof, off, c;
1040   PetscErrorCode ierr;
1041 
1042   PetscFunctionBegin;
1043   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1044   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1045   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1046   if (dof) PetscValidPointer(cone, 3);
1047   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1048   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);
1049   for (c = 0; c < dof; ++c) {
1050     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);
1051     mesh->cones[off+c] = cone[c];
1052   }
1053   PetscFunctionReturn(0);
1054 }
1055 
1056 #undef __FUNCT__
1057 #define __FUNCT__ "DMPlexGetConeOrientation"
1058 /*@C
1059   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the Sieve DAG
1060 
1061   Not collective
1062 
1063   Input Parameters:
1064 + mesh - The DMPlex
1065 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1066 
1067   Output Parameter:
1068 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1069                     integer giving the prescription for cone traversal. If it is negative, the cone is
1070                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1071                     the index of the cone point on which to start.
1072 
1073   Level: beginner
1074 
1075   Fortran Notes:
1076   Since it returns an array, this routine is only available in Fortran 90, and you must
1077   include petsc.h90 in your code.
1078 
1079   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
1080 
1081 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
1082 @*/
1083 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
1084 {
1085   DM_Plex       *mesh = (DM_Plex*) dm->data;
1086   PetscInt       off;
1087   PetscErrorCode ierr;
1088 
1089   PetscFunctionBegin;
1090   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1091 #if defined(PETSC_USE_DEBUG)
1092   {
1093     PetscInt dof;
1094     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1095     if (dof) PetscValidPointer(coneOrientation, 3);
1096   }
1097 #endif
1098   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1099 
1100   *coneOrientation = &mesh->coneOrientations[off];
1101   PetscFunctionReturn(0);
1102 }
1103 
1104 #undef __FUNCT__
1105 #define __FUNCT__ "DMPlexSetConeOrientation"
1106 /*@
1107   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the Sieve DAG
1108 
1109   Not collective
1110 
1111   Input Parameters:
1112 + mesh - The DMPlex
1113 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1114 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1115                     integer giving the prescription for cone traversal. If it is negative, the cone is
1116                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1117                     the index of the cone point on which to start.
1118 
1119   Output Parameter:
1120 
1121   Note:
1122   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1123 
1124   Level: beginner
1125 
1126 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1127 @*/
1128 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
1129 {
1130   DM_Plex       *mesh = (DM_Plex*) dm->data;
1131   PetscInt       pStart, pEnd;
1132   PetscInt       dof, off, c;
1133   PetscErrorCode ierr;
1134 
1135   PetscFunctionBegin;
1136   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1137   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1138   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1139   if (dof) PetscValidPointer(coneOrientation, 3);
1140   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1141   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);
1142   for (c = 0; c < dof; ++c) {
1143     PetscInt cdof, o = coneOrientation[c];
1144 
1145     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
1146     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);
1147     mesh->coneOrientations[off+c] = o;
1148   }
1149   PetscFunctionReturn(0);
1150 }
1151 
1152 #undef __FUNCT__
1153 #define __FUNCT__ "DMPlexInsertCone"
1154 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
1155 {
1156   DM_Plex       *mesh = (DM_Plex*) dm->data;
1157   PetscInt       pStart, pEnd;
1158   PetscInt       dof, off;
1159   PetscErrorCode ierr;
1160 
1161   PetscFunctionBegin;
1162   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1163   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1164   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);
1165   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);
1166   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1167   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1168   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);
1169   mesh->cones[off+conePos] = conePoint;
1170   PetscFunctionReturn(0);
1171 }
1172 
1173 #undef __FUNCT__
1174 #define __FUNCT__ "DMPlexInsertConeOrientation"
1175 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
1176 {
1177   DM_Plex       *mesh = (DM_Plex*) dm->data;
1178   PetscInt       pStart, pEnd;
1179   PetscInt       dof, off;
1180   PetscErrorCode ierr;
1181 
1182   PetscFunctionBegin;
1183   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1184   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1185   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);
1186   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1187   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1188   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);
1189   mesh->coneOrientations[off+conePos] = coneOrientation;
1190   PetscFunctionReturn(0);
1191 }
1192 
1193 #undef __FUNCT__
1194 #define __FUNCT__ "DMPlexGetSupportSize"
1195 /*@
1196   DMPlexGetSupportSize - Return the number of out-edges for this point in the Sieve DAG
1197 
1198   Not collective
1199 
1200   Input Parameters:
1201 + mesh - The DMPlex
1202 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1203 
1204   Output Parameter:
1205 . size - The support size for point p
1206 
1207   Level: beginner
1208 
1209 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
1210 @*/
1211 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
1212 {
1213   DM_Plex       *mesh = (DM_Plex*) dm->data;
1214   PetscErrorCode ierr;
1215 
1216   PetscFunctionBegin;
1217   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1218   PetscValidPointer(size, 3);
1219   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1220   PetscFunctionReturn(0);
1221 }
1222 
1223 #undef __FUNCT__
1224 #define __FUNCT__ "DMPlexSetSupportSize"
1225 /*@
1226   DMPlexSetSupportSize - Set the number of out-edges for this point in the Sieve DAG
1227 
1228   Not collective
1229 
1230   Input Parameters:
1231 + mesh - The DMPlex
1232 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1233 - size - The support size for point p
1234 
1235   Output Parameter:
1236 
1237   Note:
1238   This should be called after DMPlexSetChart().
1239 
1240   Level: beginner
1241 
1242 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
1243 @*/
1244 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
1245 {
1246   DM_Plex       *mesh = (DM_Plex*) dm->data;
1247   PetscErrorCode ierr;
1248 
1249   PetscFunctionBegin;
1250   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1251   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1252 
1253   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
1254   PetscFunctionReturn(0);
1255 }
1256 
1257 #undef __FUNCT__
1258 #define __FUNCT__ "DMPlexGetSupport"
1259 /*@C
1260   DMPlexGetSupport - Return the points on the out-edges for this point in the Sieve DAG
1261 
1262   Not collective
1263 
1264   Input Parameters:
1265 + mesh - The DMPlex
1266 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1267 
1268   Output Parameter:
1269 . support - An array of points which are on the out-edges for point p
1270 
1271   Level: beginner
1272 
1273   Fortran Notes:
1274   Since it returns an array, this routine is only available in Fortran 90, and you must
1275   include petsc.h90 in your code.
1276 
1277   You must also call DMPlexRestoreSupport() after you finish using the returned array.
1278 
1279 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1280 @*/
1281 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
1282 {
1283   DM_Plex       *mesh = (DM_Plex*) dm->data;
1284   PetscInt       off;
1285   PetscErrorCode ierr;
1286 
1287   PetscFunctionBegin;
1288   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1289   PetscValidPointer(support, 3);
1290   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1291   *support = &mesh->supports[off];
1292   PetscFunctionReturn(0);
1293 }
1294 
1295 #undef __FUNCT__
1296 #define __FUNCT__ "DMPlexSetSupport"
1297 /*@
1298   DMPlexSetSupport - Set the points on the out-edges for this point in the Sieve DAG
1299 
1300   Not collective
1301 
1302   Input Parameters:
1303 + mesh - The DMPlex
1304 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1305 - support - An array of points which are on the in-edges for point p
1306 
1307   Output Parameter:
1308 
1309   Note:
1310   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
1311 
1312   Level: beginner
1313 
1314 .seealso: DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
1315 @*/
1316 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
1317 {
1318   DM_Plex       *mesh = (DM_Plex*) dm->data;
1319   PetscInt       pStart, pEnd;
1320   PetscInt       dof, off, c;
1321   PetscErrorCode ierr;
1322 
1323   PetscFunctionBegin;
1324   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1325   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1326   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1327   if (dof) PetscValidPointer(support, 3);
1328   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1329   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);
1330   for (c = 0; c < dof; ++c) {
1331     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);
1332     mesh->supports[off+c] = support[c];
1333   }
1334   PetscFunctionReturn(0);
1335 }
1336 
1337 #undef __FUNCT__
1338 #define __FUNCT__ "DMPlexInsertSupport"
1339 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
1340 {
1341   DM_Plex       *mesh = (DM_Plex*) dm->data;
1342   PetscInt       pStart, pEnd;
1343   PetscInt       dof, off;
1344   PetscErrorCode ierr;
1345 
1346   PetscFunctionBegin;
1347   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1348   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1349   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1350   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1351   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);
1352   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);
1353   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);
1354   mesh->supports[off+supportPos] = supportPoint;
1355   PetscFunctionReturn(0);
1356 }
1357 
1358 #undef __FUNCT__
1359 #define __FUNCT__ "DMPlexGetTransitiveClosure"
1360 /*@C
1361   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1362 
1363   Not collective
1364 
1365   Input Parameters:
1366 + mesh - The DMPlex
1367 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1368 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1369 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1370 
1371   Output Parameters:
1372 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1373 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1374 
1375   Note:
1376   If using internal storage (points is NULL on input), each call overwrites the last output.
1377 
1378   Fortran Notes:
1379   Since it returns an array, this routine is only available in Fortran 90, and you must
1380   include petsc.h90 in your code.
1381 
1382   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1383 
1384   Level: beginner
1385 
1386 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1387 @*/
1388 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1389 {
1390   DM_Plex        *mesh = (DM_Plex*) dm->data;
1391   PetscInt       *closure, *fifo;
1392   const PetscInt *tmp = NULL, *tmpO = NULL;
1393   PetscInt        tmpSize, t;
1394   PetscInt        depth       = 0, maxSize;
1395   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1396   PetscErrorCode  ierr;
1397 
1398   PetscFunctionBegin;
1399   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1400   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1401   /* This is only 1-level */
1402   if (useCone) {
1403     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1404     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1405     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1406   } else {
1407     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1408     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1409   }
1410   if (depth == 1) {
1411     if (*points) {
1412       closure = *points;
1413     } else {
1414       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1415       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1416     }
1417     closure[0] = p; closure[1] = 0;
1418     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1419       closure[closureSize]   = tmp[t];
1420       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
1421     }
1422     if (numPoints) *numPoints = closureSize/2;
1423     if (points)    *points    = closure;
1424     PetscFunctionReturn(0);
1425   }
1426   maxSize = 2*PetscMax(PetscMax(PetscPowInt(mesh->maxConeSize,depth+1),PetscPowInt(mesh->maxSupportSize,depth+1)),depth+1);
1427   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1428   if (*points) {
1429     closure = *points;
1430   } else {
1431     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1432   }
1433   closure[0] = p; closure[1] = 0;
1434   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1435     const PetscInt cp = tmp[t];
1436     const PetscInt co = tmpO ? tmpO[t] : 0;
1437 
1438     closure[closureSize]   = cp;
1439     closure[closureSize+1] = co;
1440     fifo[fifoSize]         = cp;
1441     fifo[fifoSize+1]       = co;
1442   }
1443   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1444   while (fifoSize - fifoStart) {
1445     const PetscInt q   = fifo[fifoStart];
1446     const PetscInt o   = fifo[fifoStart+1];
1447     const PetscInt rev = o >= 0 ? 0 : 1;
1448     const PetscInt off = rev ? -(o+1) : o;
1449 
1450     if (useCone) {
1451       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1452       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1453       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1454     } else {
1455       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1456       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1457       tmpO = NULL;
1458     }
1459     for (t = 0; t < tmpSize; ++t) {
1460       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1461       const PetscInt cp = tmp[i];
1462       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1463       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1464        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1465       PetscInt       co = tmpO ? tmpO[i] : 0;
1466       PetscInt       c;
1467 
1468       if (rev) {
1469         PetscInt childSize, coff;
1470         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1471         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1472         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1473       }
1474       /* Check for duplicate */
1475       for (c = 0; c < closureSize; c += 2) {
1476         if (closure[c] == cp) break;
1477       }
1478       if (c == closureSize) {
1479         closure[closureSize]   = cp;
1480         closure[closureSize+1] = co;
1481         fifo[fifoSize]         = cp;
1482         fifo[fifoSize+1]       = co;
1483         closureSize           += 2;
1484         fifoSize              += 2;
1485       }
1486     }
1487     fifoStart += 2;
1488   }
1489   if (numPoints) *numPoints = closureSize/2;
1490   if (points)    *points    = closure;
1491   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1492   PetscFunctionReturn(0);
1493 }
1494 
1495 #undef __FUNCT__
1496 #define __FUNCT__ "DMPlexGetTransitiveClosure_Internal"
1497 /*@C
1498   DMPlexGetTransitiveClosure_Internal - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG with a specified initial orientation
1499 
1500   Not collective
1501 
1502   Input Parameters:
1503 + mesh - The DMPlex
1504 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1505 . orientation - The orientation of the point
1506 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1507 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1508 
1509   Output Parameters:
1510 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1511 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1512 
1513   Note:
1514   If using internal storage (points is NULL on input), each call overwrites the last output.
1515 
1516   Fortran Notes:
1517   Since it returns an array, this routine is only available in Fortran 90, and you must
1518   include petsc.h90 in your code.
1519 
1520   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1521 
1522   Level: beginner
1523 
1524 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1525 @*/
1526 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM dm, PetscInt p, PetscInt ornt, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1527 {
1528   DM_Plex        *mesh = (DM_Plex*) dm->data;
1529   PetscInt       *closure, *fifo;
1530   const PetscInt *tmp = NULL, *tmpO = NULL;
1531   PetscInt        tmpSize, t;
1532   PetscInt        depth       = 0, maxSize;
1533   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1534   PetscErrorCode  ierr;
1535 
1536   PetscFunctionBegin;
1537   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1538   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1539   /* This is only 1-level */
1540   if (useCone) {
1541     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1542     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1543     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1544   } else {
1545     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1546     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1547   }
1548   if (depth == 1) {
1549     if (*points) {
1550       closure = *points;
1551     } else {
1552       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1553       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1554     }
1555     closure[0] = p; closure[1] = ornt;
1556     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1557       const PetscInt i = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1558       closure[closureSize]   = tmp[i];
1559       closure[closureSize+1] = tmpO ? tmpO[i] : 0;
1560     }
1561     if (numPoints) *numPoints = closureSize/2;
1562     if (points)    *points    = closure;
1563     PetscFunctionReturn(0);
1564   }
1565   maxSize = 2*PetscMax(PetscMax(PetscPowInt(mesh->maxConeSize,depth+1),PetscPowInt(mesh->maxSupportSize,depth+1)),depth+1);
1566   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1567   if (*points) {
1568     closure = *points;
1569   } else {
1570     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1571   }
1572   closure[0] = p; closure[1] = ornt;
1573   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1574     const PetscInt i  = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1575     const PetscInt cp = tmp[i];
1576     PetscInt       co = tmpO ? tmpO[i] : 0;
1577 
1578     if (ornt < 0) {
1579       PetscInt childSize, coff;
1580       ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1581       coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1582       co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1583     }
1584     closure[closureSize]   = cp;
1585     closure[closureSize+1] = co;
1586     fifo[fifoSize]         = cp;
1587     fifo[fifoSize+1]       = co;
1588   }
1589   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1590   while (fifoSize - fifoStart) {
1591     const PetscInt q   = fifo[fifoStart];
1592     const PetscInt o   = fifo[fifoStart+1];
1593     const PetscInt rev = o >= 0 ? 0 : 1;
1594     const PetscInt off = rev ? -(o+1) : o;
1595 
1596     if (useCone) {
1597       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1598       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1599       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1600     } else {
1601       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1602       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1603       tmpO = NULL;
1604     }
1605     for (t = 0; t < tmpSize; ++t) {
1606       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1607       const PetscInt cp = tmp[i];
1608       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1609       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1610        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1611       PetscInt       co = tmpO ? tmpO[i] : 0;
1612       PetscInt       c;
1613 
1614       if (rev) {
1615         PetscInt childSize, coff;
1616         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1617         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1618         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1619       }
1620       /* Check for duplicate */
1621       for (c = 0; c < closureSize; c += 2) {
1622         if (closure[c] == cp) break;
1623       }
1624       if (c == closureSize) {
1625         closure[closureSize]   = cp;
1626         closure[closureSize+1] = co;
1627         fifo[fifoSize]         = cp;
1628         fifo[fifoSize+1]       = co;
1629         closureSize           += 2;
1630         fifoSize              += 2;
1631       }
1632     }
1633     fifoStart += 2;
1634   }
1635   if (numPoints) *numPoints = closureSize/2;
1636   if (points)    *points    = closure;
1637   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1638   PetscFunctionReturn(0);
1639 }
1640 
1641 #undef __FUNCT__
1642 #define __FUNCT__ "DMPlexRestoreTransitiveClosure"
1643 /*@C
1644   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1645 
1646   Not collective
1647 
1648   Input Parameters:
1649 + mesh - The DMPlex
1650 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1651 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1652 . numPoints - The number of points in the closure, so points[] is of size 2*numPoints, zeroed on exit
1653 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...], zeroed on exit
1654 
1655   Note:
1656   If not using internal storage (points is not NULL on input), this call is unnecessary
1657 
1658   Fortran Notes:
1659   Since it returns an array, this routine is only available in Fortran 90, and you must
1660   include petsc.h90 in your code.
1661 
1662   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1663 
1664   Level: beginner
1665 
1666 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1667 @*/
1668 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1669 {
1670   PetscErrorCode ierr;
1671 
1672   PetscFunctionBegin;
1673   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1674   if (numPoints) PetscValidIntPointer(numPoints,4);
1675   if (points) PetscValidPointer(points,5);
1676   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, points);CHKERRQ(ierr);
1677   if (numPoints) *numPoints = 0;
1678   PetscFunctionReturn(0);
1679 }
1680 
1681 #undef __FUNCT__
1682 #define __FUNCT__ "DMPlexGetMaxSizes"
1683 /*@
1684   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the Sieve DAG
1685 
1686   Not collective
1687 
1688   Input Parameter:
1689 . mesh - The DMPlex
1690 
1691   Output Parameters:
1692 + maxConeSize - The maximum number of in-edges
1693 - maxSupportSize - The maximum number of out-edges
1694 
1695   Level: beginner
1696 
1697 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1698 @*/
1699 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
1700 {
1701   DM_Plex *mesh = (DM_Plex*) dm->data;
1702 
1703   PetscFunctionBegin;
1704   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1705   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
1706   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
1707   PetscFunctionReturn(0);
1708 }
1709 
1710 #undef __FUNCT__
1711 #define __FUNCT__ "DMSetUp_Plex"
1712 PetscErrorCode DMSetUp_Plex(DM dm)
1713 {
1714   DM_Plex       *mesh = (DM_Plex*) dm->data;
1715   PetscInt       size;
1716   PetscErrorCode ierr;
1717 
1718   PetscFunctionBegin;
1719   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1720   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
1721   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
1722   ierr = PetscMalloc1(size, &mesh->cones);CHKERRQ(ierr);
1723   ierr = PetscCalloc1(size, &mesh->coneOrientations);CHKERRQ(ierr);
1724   if (mesh->maxSupportSize) {
1725     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1726     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
1727     ierr = PetscMalloc1(size, &mesh->supports);CHKERRQ(ierr);
1728   }
1729   PetscFunctionReturn(0);
1730 }
1731 
1732 #undef __FUNCT__
1733 #define __FUNCT__ "DMCreateSubDM_Plex"
1734 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
1735 {
1736   PetscErrorCode ierr;
1737 
1738   PetscFunctionBegin;
1739   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
1740   ierr = DMCreateSubDM_Section_Private(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
1741   PetscFunctionReturn(0);
1742 }
1743 
1744 #undef __FUNCT__
1745 #define __FUNCT__ "DMPlexSymmetrize"
1746 /*@
1747   DMPlexSymmetrize - Creates support (out-edge) information from cone (in-edge) inoformation
1748 
1749   Not collective
1750 
1751   Input Parameter:
1752 . mesh - The DMPlex
1753 
1754   Output Parameter:
1755 
1756   Note:
1757   This should be called after all calls to DMPlexSetCone()
1758 
1759   Level: beginner
1760 
1761 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
1762 @*/
1763 PetscErrorCode DMPlexSymmetrize(DM dm)
1764 {
1765   DM_Plex       *mesh = (DM_Plex*) dm->data;
1766   PetscInt      *offsets;
1767   PetscInt       supportSize;
1768   PetscInt       pStart, pEnd, p;
1769   PetscErrorCode ierr;
1770 
1771   PetscFunctionBegin;
1772   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1773   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
1774   /* Calculate support sizes */
1775   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1776   for (p = pStart; p < pEnd; ++p) {
1777     PetscInt dof, off, c;
1778 
1779     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1780     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1781     for (c = off; c < off+dof; ++c) {
1782       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
1783     }
1784   }
1785   for (p = pStart; p < pEnd; ++p) {
1786     PetscInt dof;
1787 
1788     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1789 
1790     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
1791   }
1792   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1793   /* Calculate supports */
1794   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
1795   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
1796   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
1797   for (p = pStart; p < pEnd; ++p) {
1798     PetscInt dof, off, c;
1799 
1800     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1801     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1802     for (c = off; c < off+dof; ++c) {
1803       const PetscInt q = mesh->cones[c];
1804       PetscInt       offS;
1805 
1806       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
1807 
1808       mesh->supports[offS+offsets[q]] = p;
1809       ++offsets[q];
1810     }
1811   }
1812   ierr = PetscFree(offsets);CHKERRQ(ierr);
1813   PetscFunctionReturn(0);
1814 }
1815 
1816 #undef __FUNCT__
1817 #define __FUNCT__ "DMPlexStratify"
1818 /*@
1819   DMPlexStratify - The Sieve DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
1820   can be illustrated by Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
1821   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
1822   the DAG.
1823 
1824   Not collective
1825 
1826   Input Parameter:
1827 . mesh - The DMPlex
1828 
1829   Output Parameter:
1830 
1831   Notes:
1832   The normal association for the point grade is element dimension (or co-dimension). For instance, all vertices would
1833   have depth 0, and all edges depth 1. Likewise, all cells heights would have height 0, and all faces height 1.
1834 
1835   This should be called after all calls to DMPlexSymmetrize()
1836 
1837   Level: beginner
1838 
1839 .seealso: DMPlexCreate(), DMPlexSymmetrize()
1840 @*/
1841 PetscErrorCode DMPlexStratify(DM dm)
1842 {
1843   DMLabel        label;
1844   PetscInt       pStart, pEnd, p;
1845   PetscInt       numRoots = 0, numLeaves = 0;
1846   PetscErrorCode ierr;
1847 
1848   PetscFunctionBegin;
1849   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1850   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1851   /* Calculate depth */
1852   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1853   ierr = DMPlexCreateLabel(dm, "depth");CHKERRQ(ierr);
1854   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
1855   /* Initialize roots and count leaves */
1856   for (p = pStart; p < pEnd; ++p) {
1857     PetscInt coneSize, supportSize;
1858 
1859     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1860     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1861     if (!coneSize && supportSize) {
1862       ++numRoots;
1863       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1864     } else if (!supportSize && coneSize) {
1865       ++numLeaves;
1866     } else if (!supportSize && !coneSize) {
1867       /* Isolated points */
1868       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1869     }
1870   }
1871   if (numRoots + numLeaves == (pEnd - pStart)) {
1872     for (p = pStart; p < pEnd; ++p) {
1873       PetscInt coneSize, supportSize;
1874 
1875       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1876       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1877       if (!supportSize && coneSize) {
1878         ierr = DMLabelSetValue(label, p, 1);CHKERRQ(ierr);
1879       }
1880     }
1881   } else {
1882     IS       pointIS;
1883     PetscInt numPoints = 0, level = 0;
1884 
1885     ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1886     if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1887     while (numPoints) {
1888       const PetscInt *points;
1889       const PetscInt  newLevel = level+1;
1890 
1891       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1892       for (p = 0; p < numPoints; ++p) {
1893         const PetscInt  point = points[p];
1894         const PetscInt *support;
1895         PetscInt        supportSize, s;
1896 
1897         ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
1898         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
1899         for (s = 0; s < supportSize; ++s) {
1900           ierr = DMLabelSetValue(label, support[s], newLevel);CHKERRQ(ierr);
1901         }
1902       }
1903       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1904       ++level;
1905       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1906       ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1907       if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1908       else         {numPoints = 0;}
1909     }
1910     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1911   }
1912   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1913   PetscFunctionReturn(0);
1914 }
1915 
1916 #undef __FUNCT__
1917 #define __FUNCT__ "DMPlexGetJoin"
1918 /*@C
1919   DMPlexGetJoin - Get an array for the join of the set of points
1920 
1921   Not Collective
1922 
1923   Input Parameters:
1924 + dm - The DMPlex object
1925 . numPoints - The number of input points for the join
1926 - points - The input points
1927 
1928   Output Parameters:
1929 + numCoveredPoints - The number of points in the join
1930 - coveredPoints - The points in the join
1931 
1932   Level: intermediate
1933 
1934   Note: Currently, this is restricted to a single level join
1935 
1936   Fortran Notes:
1937   Since it returns an array, this routine is only available in Fortran 90, and you must
1938   include petsc.h90 in your code.
1939 
1940   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1941 
1942 .keywords: mesh
1943 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
1944 @*/
1945 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1946 {
1947   DM_Plex       *mesh = (DM_Plex*) dm->data;
1948   PetscInt      *join[2];
1949   PetscInt       joinSize, i = 0;
1950   PetscInt       dof, off, p, c, m;
1951   PetscErrorCode ierr;
1952 
1953   PetscFunctionBegin;
1954   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1955   PetscValidPointer(points, 2);
1956   PetscValidPointer(numCoveredPoints, 3);
1957   PetscValidPointer(coveredPoints, 4);
1958   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
1959   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
1960   /* Copy in support of first point */
1961   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
1962   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
1963   for (joinSize = 0; joinSize < dof; ++joinSize) {
1964     join[i][joinSize] = mesh->supports[off+joinSize];
1965   }
1966   /* Check each successive support */
1967   for (p = 1; p < numPoints; ++p) {
1968     PetscInt newJoinSize = 0;
1969 
1970     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
1971     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
1972     for (c = 0; c < dof; ++c) {
1973       const PetscInt point = mesh->supports[off+c];
1974 
1975       for (m = 0; m < joinSize; ++m) {
1976         if (point == join[i][m]) {
1977           join[1-i][newJoinSize++] = point;
1978           break;
1979         }
1980       }
1981     }
1982     joinSize = newJoinSize;
1983     i        = 1-i;
1984   }
1985   *numCoveredPoints = joinSize;
1986   *coveredPoints    = join[i];
1987   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
1988   PetscFunctionReturn(0);
1989 }
1990 
1991 #undef __FUNCT__
1992 #define __FUNCT__ "DMPlexRestoreJoin"
1993 /*@C
1994   DMPlexRestoreJoin - Restore an array for the join of the set of points
1995 
1996   Not Collective
1997 
1998   Input Parameters:
1999 + dm - The DMPlex object
2000 . numPoints - The number of input points for the join
2001 - points - The input points
2002 
2003   Output Parameters:
2004 + numCoveredPoints - The number of points in the join
2005 - coveredPoints - The points in the join
2006 
2007   Fortran Notes:
2008   Since it returns an array, this routine is only available in Fortran 90, and you must
2009   include petsc.h90 in your code.
2010 
2011   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2012 
2013   Level: intermediate
2014 
2015 .keywords: mesh
2016 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
2017 @*/
2018 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2019 {
2020   PetscErrorCode ierr;
2021 
2022   PetscFunctionBegin;
2023   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2024   if (points) PetscValidIntPointer(points,3);
2025   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2026   PetscValidPointer(coveredPoints, 5);
2027   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2028   if (numCoveredPoints) *numCoveredPoints = 0;
2029   PetscFunctionReturn(0);
2030 }
2031 
2032 #undef __FUNCT__
2033 #define __FUNCT__ "DMPlexGetFullJoin"
2034 /*@C
2035   DMPlexGetFullJoin - Get an array for the join of the set of points
2036 
2037   Not Collective
2038 
2039   Input Parameters:
2040 + dm - The DMPlex object
2041 . numPoints - The number of input points for the join
2042 - points - The input points
2043 
2044   Output Parameters:
2045 + numCoveredPoints - The number of points in the join
2046 - coveredPoints - The points in the join
2047 
2048   Fortran Notes:
2049   Since it returns an array, this routine is only available in Fortran 90, and you must
2050   include petsc.h90 in your code.
2051 
2052   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2053 
2054   Level: intermediate
2055 
2056 .keywords: mesh
2057 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
2058 @*/
2059 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2060 {
2061   DM_Plex       *mesh = (DM_Plex*) dm->data;
2062   PetscInt      *offsets, **closures;
2063   PetscInt      *join[2];
2064   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
2065   PetscInt       p, d, c, m;
2066   PetscErrorCode ierr;
2067 
2068   PetscFunctionBegin;
2069   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2070   PetscValidPointer(points, 2);
2071   PetscValidPointer(numCoveredPoints, 3);
2072   PetscValidPointer(coveredPoints, 4);
2073 
2074   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2075   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
2076   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2077   maxSize = PetscPowInt(mesh->maxSupportSize,depth+1);
2078   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
2079   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
2080 
2081   for (p = 0; p < numPoints; ++p) {
2082     PetscInt closureSize;
2083 
2084     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
2085 
2086     offsets[p*(depth+2)+0] = 0;
2087     for (d = 0; d < depth+1; ++d) {
2088       PetscInt pStart, pEnd, i;
2089 
2090       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
2091       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
2092         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2093           offsets[p*(depth+2)+d+1] = i;
2094           break;
2095         }
2096       }
2097       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
2098     }
2099     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);
2100   }
2101   for (d = 0; d < depth+1; ++d) {
2102     PetscInt dof;
2103 
2104     /* Copy in support of first point */
2105     dof = offsets[d+1] - offsets[d];
2106     for (joinSize = 0; joinSize < dof; ++joinSize) {
2107       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
2108     }
2109     /* Check each successive cone */
2110     for (p = 1; p < numPoints && joinSize; ++p) {
2111       PetscInt newJoinSize = 0;
2112 
2113       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
2114       for (c = 0; c < dof; ++c) {
2115         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
2116 
2117         for (m = 0; m < joinSize; ++m) {
2118           if (point == join[i][m]) {
2119             join[1-i][newJoinSize++] = point;
2120             break;
2121           }
2122         }
2123       }
2124       joinSize = newJoinSize;
2125       i        = 1-i;
2126     }
2127     if (joinSize) break;
2128   }
2129   *numCoveredPoints = joinSize;
2130   *coveredPoints    = join[i];
2131   for (p = 0; p < numPoints; ++p) {
2132     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
2133   }
2134   ierr = PetscFree(closures);CHKERRQ(ierr);
2135   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2136   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
2137   PetscFunctionReturn(0);
2138 }
2139 
2140 #undef __FUNCT__
2141 #define __FUNCT__ "DMPlexGetMeet"
2142 /*@C
2143   DMPlexGetMeet - Get an array for the meet of the set of points
2144 
2145   Not Collective
2146 
2147   Input Parameters:
2148 + dm - The DMPlex object
2149 . numPoints - The number of input points for the meet
2150 - points - The input points
2151 
2152   Output Parameters:
2153 + numCoveredPoints - The number of points in the meet
2154 - coveredPoints - The points in the meet
2155 
2156   Level: intermediate
2157 
2158   Note: Currently, this is restricted to a single level meet
2159 
2160   Fortran Notes:
2161   Since it returns an array, this routine is only available in Fortran 90, and you must
2162   include petsc.h90 in your code.
2163 
2164   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2165 
2166 .keywords: mesh
2167 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
2168 @*/
2169 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
2170 {
2171   DM_Plex       *mesh = (DM_Plex*) dm->data;
2172   PetscInt      *meet[2];
2173   PetscInt       meetSize, i = 0;
2174   PetscInt       dof, off, p, c, m;
2175   PetscErrorCode ierr;
2176 
2177   PetscFunctionBegin;
2178   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2179   PetscValidPointer(points, 2);
2180   PetscValidPointer(numCoveringPoints, 3);
2181   PetscValidPointer(coveringPoints, 4);
2182   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2183   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2184   /* Copy in cone of first point */
2185   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
2186   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
2187   for (meetSize = 0; meetSize < dof; ++meetSize) {
2188     meet[i][meetSize] = mesh->cones[off+meetSize];
2189   }
2190   /* Check each successive cone */
2191   for (p = 1; p < numPoints; ++p) {
2192     PetscInt newMeetSize = 0;
2193 
2194     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
2195     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
2196     for (c = 0; c < dof; ++c) {
2197       const PetscInt point = mesh->cones[off+c];
2198 
2199       for (m = 0; m < meetSize; ++m) {
2200         if (point == meet[i][m]) {
2201           meet[1-i][newMeetSize++] = point;
2202           break;
2203         }
2204       }
2205     }
2206     meetSize = newMeetSize;
2207     i        = 1-i;
2208   }
2209   *numCoveringPoints = meetSize;
2210   *coveringPoints    = meet[i];
2211   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2212   PetscFunctionReturn(0);
2213 }
2214 
2215 #undef __FUNCT__
2216 #define __FUNCT__ "DMPlexRestoreMeet"
2217 /*@C
2218   DMPlexRestoreMeet - Restore an array for the meet of the set of points
2219 
2220   Not Collective
2221 
2222   Input Parameters:
2223 + dm - The DMPlex object
2224 . numPoints - The number of input points for the meet
2225 - points - The input points
2226 
2227   Output Parameters:
2228 + numCoveredPoints - The number of points in the meet
2229 - coveredPoints - The points in the meet
2230 
2231   Level: intermediate
2232 
2233   Fortran Notes:
2234   Since it returns an array, this routine is only available in Fortran 90, and you must
2235   include petsc.h90 in your code.
2236 
2237   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2238 
2239 .keywords: mesh
2240 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
2241 @*/
2242 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2243 {
2244   PetscErrorCode ierr;
2245 
2246   PetscFunctionBegin;
2247   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2248   if (points) PetscValidIntPointer(points,3);
2249   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2250   PetscValidPointer(coveredPoints,5);
2251   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2252   if (numCoveredPoints) *numCoveredPoints = 0;
2253   PetscFunctionReturn(0);
2254 }
2255 
2256 #undef __FUNCT__
2257 #define __FUNCT__ "DMPlexGetFullMeet"
2258 /*@C
2259   DMPlexGetFullMeet - Get an array for the meet of the set of points
2260 
2261   Not Collective
2262 
2263   Input Parameters:
2264 + dm - The DMPlex object
2265 . numPoints - The number of input points for the meet
2266 - points - The input points
2267 
2268   Output Parameters:
2269 + numCoveredPoints - The number of points in the meet
2270 - coveredPoints - The points in the meet
2271 
2272   Level: intermediate
2273 
2274   Fortran Notes:
2275   Since it returns an array, this routine is only available in Fortran 90, and you must
2276   include petsc.h90 in your code.
2277 
2278   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2279 
2280 .keywords: mesh
2281 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
2282 @*/
2283 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2284 {
2285   DM_Plex       *mesh = (DM_Plex*) dm->data;
2286   PetscInt      *offsets, **closures;
2287   PetscInt      *meet[2];
2288   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
2289   PetscInt       p, h, c, m;
2290   PetscErrorCode ierr;
2291 
2292   PetscFunctionBegin;
2293   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2294   PetscValidPointer(points, 2);
2295   PetscValidPointer(numCoveredPoints, 3);
2296   PetscValidPointer(coveredPoints, 4);
2297 
2298   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
2299   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
2300   ierr    = DMGetWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2301   maxSize = PetscPowInt(mesh->maxConeSize,height+1);
2302   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2303   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2304 
2305   for (p = 0; p < numPoints; ++p) {
2306     PetscInt closureSize;
2307 
2308     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
2309 
2310     offsets[p*(height+2)+0] = 0;
2311     for (h = 0; h < height+1; ++h) {
2312       PetscInt pStart, pEnd, i;
2313 
2314       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
2315       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
2316         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2317           offsets[p*(height+2)+h+1] = i;
2318           break;
2319         }
2320       }
2321       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
2322     }
2323     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);
2324   }
2325   for (h = 0; h < height+1; ++h) {
2326     PetscInt dof;
2327 
2328     /* Copy in cone of first point */
2329     dof = offsets[h+1] - offsets[h];
2330     for (meetSize = 0; meetSize < dof; ++meetSize) {
2331       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
2332     }
2333     /* Check each successive cone */
2334     for (p = 1; p < numPoints && meetSize; ++p) {
2335       PetscInt newMeetSize = 0;
2336 
2337       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
2338       for (c = 0; c < dof; ++c) {
2339         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
2340 
2341         for (m = 0; m < meetSize; ++m) {
2342           if (point == meet[i][m]) {
2343             meet[1-i][newMeetSize++] = point;
2344             break;
2345           }
2346         }
2347       }
2348       meetSize = newMeetSize;
2349       i        = 1-i;
2350     }
2351     if (meetSize) break;
2352   }
2353   *numCoveredPoints = meetSize;
2354   *coveredPoints    = meet[i];
2355   for (p = 0; p < numPoints; ++p) {
2356     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
2357   }
2358   ierr = PetscFree(closures);CHKERRQ(ierr);
2359   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2360   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2361   PetscFunctionReturn(0);
2362 }
2363 
2364 #undef __FUNCT__
2365 #define __FUNCT__ "DMPlexEqual"
2366 /*@C
2367   DMPlexEqual - Determine if two DMs have the same topology
2368 
2369   Not Collective
2370 
2371   Input Parameters:
2372 + dmA - A DMPlex object
2373 - dmB - A DMPlex object
2374 
2375   Output Parameters:
2376 . equal - PETSC_TRUE if the topologies are identical
2377 
2378   Level: intermediate
2379 
2380   Notes:
2381   We are not solving graph isomorphism, so we do not permutation.
2382 
2383 .keywords: mesh
2384 .seealso: DMPlexGetCone()
2385 @*/
2386 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
2387 {
2388   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
2389   PetscErrorCode ierr;
2390 
2391   PetscFunctionBegin;
2392   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
2393   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
2394   PetscValidPointer(equal, 3);
2395 
2396   *equal = PETSC_FALSE;
2397   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
2398   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
2399   if (depth != depthB) PetscFunctionReturn(0);
2400   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
2401   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
2402   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
2403   for (p = pStart; p < pEnd; ++p) {
2404     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
2405     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
2406 
2407     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
2408     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
2409     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
2410     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
2411     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
2412     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
2413     if (coneSize != coneSizeB) PetscFunctionReturn(0);
2414     for (c = 0; c < coneSize; ++c) {
2415       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
2416       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
2417     }
2418     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
2419     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
2420     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
2421     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
2422     if (supportSize != supportSizeB) PetscFunctionReturn(0);
2423     for (s = 0; s < supportSize; ++s) {
2424       if (support[s] != supportB[s]) PetscFunctionReturn(0);
2425     }
2426   }
2427   *equal = PETSC_TRUE;
2428   PetscFunctionReturn(0);
2429 }
2430 
2431 #undef __FUNCT__
2432 #define __FUNCT__ "DMPlexGetNumFaceVertices"
2433 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
2434 {
2435   MPI_Comm       comm;
2436   PetscErrorCode ierr;
2437 
2438   PetscFunctionBegin;
2439   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2440   PetscValidPointer(numFaceVertices,3);
2441   switch (cellDim) {
2442   case 0:
2443     *numFaceVertices = 0;
2444     break;
2445   case 1:
2446     *numFaceVertices = 1;
2447     break;
2448   case 2:
2449     switch (numCorners) {
2450     case 3: /* triangle */
2451       *numFaceVertices = 2; /* Edge has 2 vertices */
2452       break;
2453     case 4: /* quadrilateral */
2454       *numFaceVertices = 2; /* Edge has 2 vertices */
2455       break;
2456     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
2457       *numFaceVertices = 3; /* Edge has 3 vertices */
2458       break;
2459     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
2460       *numFaceVertices = 3; /* Edge has 3 vertices */
2461       break;
2462     default:
2463       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2464     }
2465     break;
2466   case 3:
2467     switch (numCorners) {
2468     case 4: /* tetradehdron */
2469       *numFaceVertices = 3; /* Face has 3 vertices */
2470       break;
2471     case 6: /* tet cohesive cells */
2472       *numFaceVertices = 4; /* Face has 4 vertices */
2473       break;
2474     case 8: /* hexahedron */
2475       *numFaceVertices = 4; /* Face has 4 vertices */
2476       break;
2477     case 9: /* tet cohesive Lagrange cells */
2478       *numFaceVertices = 6; /* Face has 6 vertices */
2479       break;
2480     case 10: /* quadratic tetrahedron */
2481       *numFaceVertices = 6; /* Face has 6 vertices */
2482       break;
2483     case 12: /* hex cohesive Lagrange cells */
2484       *numFaceVertices = 6; /* Face has 6 vertices */
2485       break;
2486     case 18: /* quadratic tet cohesive Lagrange cells */
2487       *numFaceVertices = 6; /* Face has 6 vertices */
2488       break;
2489     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
2490       *numFaceVertices = 9; /* Face has 9 vertices */
2491       break;
2492     default:
2493       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2494     }
2495     break;
2496   default:
2497     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %d", cellDim);
2498   }
2499   PetscFunctionReturn(0);
2500 }
2501 
2502 #undef __FUNCT__
2503 #define __FUNCT__ "DMPlexOrient"
2504 /* Trys to give the mesh a consistent orientation */
2505 PetscErrorCode DMPlexOrient(DM dm)
2506 {
2507   PetscBT        seenCells, flippedCells, seenFaces;
2508   PetscInt      *faceFIFO, fTop, fBottom;
2509   PetscInt       dim, h, cStart, cEnd, c, fStart, fEnd, face, maxConeSize, *revcone, *revconeO;
2510   PetscErrorCode ierr;
2511 
2512   PetscFunctionBegin;
2513   /* Truth Table
2514      mismatch    flips   do action   mismatch   flipA ^ flipB   action
2515          F       0 flips     no         F             F           F
2516          F       1 flip      yes        F             T           T
2517          F       2 flips     no         T             F           T
2518          T       0 flips     yes        T             T           F
2519          T       1 flip      no
2520          T       2 flips     yes
2521   */
2522   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2523   ierr = DMPlexGetVTKCellHeight(dm, &h);CHKERRQ(ierr);
2524   ierr = DMPlexGetHeightStratum(dm, h,   &cStart, &cEnd);CHKERRQ(ierr);
2525   ierr = DMPlexGetHeightStratum(dm, h+1, &fStart, &fEnd);CHKERRQ(ierr);
2526   ierr = PetscBTCreate(cEnd - cStart, &seenCells);CHKERRQ(ierr);
2527   ierr = PetscBTMemzero(cEnd - cStart, seenCells);CHKERRQ(ierr);
2528   ierr = PetscBTCreate(cEnd - cStart, &flippedCells);CHKERRQ(ierr);
2529   ierr = PetscBTMemzero(cEnd - cStart, flippedCells);CHKERRQ(ierr);
2530   ierr = PetscBTCreate(fEnd - fStart, &seenFaces);CHKERRQ(ierr);
2531   ierr = PetscBTMemzero(fEnd - fStart, seenFaces);CHKERRQ(ierr);
2532   ierr = PetscMalloc1((fEnd - fStart), &faceFIFO);CHKERRQ(ierr);
2533   fTop = fBottom = 0;
2534   /* Initialize FIFO with first cell */
2535   if (cEnd > cStart) {
2536     const PetscInt *cone;
2537     PetscInt        coneSize;
2538 
2539     ierr = DMPlexGetConeSize(dm, cStart, &coneSize);CHKERRQ(ierr);
2540     ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr);
2541     for (c = 0; c < coneSize; ++c) {
2542       faceFIFO[fBottom++] = cone[c];
2543       ierr = PetscBTSet(seenFaces, cone[c]-fStart);CHKERRQ(ierr);
2544     }
2545   }
2546   /* Consider each face in FIFO */
2547   while (fTop < fBottom) {
2548     const PetscInt *support, *coneA, *coneB, *coneOA, *coneOB;
2549     PetscInt        supportSize, coneSizeA, coneSizeB, posA = -1, posB = -1;
2550     PetscInt        seenA, flippedA, seenB, flippedB, mismatch;
2551 
2552     face = faceFIFO[fTop++];
2553     ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2554     ierr = DMPlexGetSupport(dm, face, &support);CHKERRQ(ierr);
2555     if (supportSize < 2) continue;
2556     if (supportSize != 2) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Faces should separate only two cells, not %d", supportSize);
2557     seenA    = PetscBTLookup(seenCells,    support[0]-cStart);
2558     flippedA = PetscBTLookup(flippedCells, support[0]-cStart) ? 1 : 0;
2559     seenB    = PetscBTLookup(seenCells,    support[1]-cStart);
2560     flippedB = PetscBTLookup(flippedCells, support[1]-cStart) ? 1 : 0;
2561 
2562     ierr = DMPlexGetConeSize(dm, support[0], &coneSizeA);CHKERRQ(ierr);
2563     ierr = DMPlexGetConeSize(dm, support[1], &coneSizeB);CHKERRQ(ierr);
2564     ierr = DMPlexGetCone(dm, support[0], &coneA);CHKERRQ(ierr);
2565     ierr = DMPlexGetCone(dm, support[1], &coneB);CHKERRQ(ierr);
2566     ierr = DMPlexGetConeOrientation(dm, support[0], &coneOA);CHKERRQ(ierr);
2567     ierr = DMPlexGetConeOrientation(dm, support[1], &coneOB);CHKERRQ(ierr);
2568     for (c = 0; c < coneSizeA; ++c) {
2569       if (!PetscBTLookup(seenFaces, coneA[c]-fStart)) {
2570         faceFIFO[fBottom++] = coneA[c];
2571         ierr = PetscBTSet(seenFaces, coneA[c]-fStart);CHKERRQ(ierr);
2572       }
2573       if (coneA[c] == face) posA = c;
2574       if (fBottom > fEnd-fStart) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Face %d was pushed exceeding capacity %d > %d", coneA[c], fBottom, fEnd-fStart);
2575     }
2576     if (posA < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d could not be located in cell %d", face, support[0]);
2577     for (c = 0; c < coneSizeB; ++c) {
2578       if (!PetscBTLookup(seenFaces, coneB[c]-fStart)) {
2579         faceFIFO[fBottom++] = coneB[c];
2580         ierr = PetscBTSet(seenFaces, coneB[c]-fStart);CHKERRQ(ierr);
2581       }
2582       if (coneB[c] == face) posB = c;
2583       if (fBottom > fEnd-fStart) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Face %d was pushed exceeding capacity %d > %d", coneA[c], fBottom, fEnd-fStart);
2584     }
2585     if (posB < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d could not be located in cell %d", face, support[1]);
2586 
2587     if (dim == 1) {
2588       mismatch = posA == posB;
2589     } else {
2590       mismatch = coneOA[posA] == coneOB[posB];
2591     }
2592 
2593     if (mismatch ^ (flippedA ^ flippedB)) {
2594       if (seenA && seenB) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Previously seen cells %d and %d do not match: Fault mesh is non-orientable", support[0], support[1]);
2595       if (!seenA && !flippedA) {
2596         ierr = PetscBTSet(flippedCells, support[0]-cStart);CHKERRQ(ierr);
2597       } else if (!seenB && !flippedB) {
2598         ierr = PetscBTSet(flippedCells, support[1]-cStart);CHKERRQ(ierr);
2599       } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Inconsistent mesh orientation: Fault mesh is non-orientable");
2600     } else if (mismatch && flippedA && flippedB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Attempt to flip already flipped cell: Fault mesh is non-orientable");
2601     ierr = PetscBTSet(seenCells, support[0]-cStart);CHKERRQ(ierr);
2602     ierr = PetscBTSet(seenCells, support[1]-cStart);CHKERRQ(ierr);
2603   }
2604   /* Now all subdomains are oriented, but we need a consistent parallel orientation */
2605   {
2606     /* Find a representative face (edge) separating pairs of procs */
2607     PetscSF            sf;
2608     const PetscInt    *lpoints;
2609     const PetscSFNode *rpoints;
2610     PetscInt          *neighbors, *nranks;
2611     PetscInt           numLeaves, numRoots, numNeighbors = 0, l, n;
2612 
2613     ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
2614     ierr = PetscSFGetGraph(sf, &numRoots, &numLeaves, &lpoints, &rpoints);CHKERRQ(ierr);
2615     if (numLeaves >= 0) {
2616       const PetscInt *cone, *ornt, *support;
2617       PetscInt        coneSize, supportSize;
2618       int            *rornt, *lornt; /* PetscSF cannot handle smaller than int */
2619       PetscBool      *match, flipped = PETSC_FALSE;
2620 
2621       ierr = PetscMalloc1(numLeaves,&neighbors);CHKERRQ(ierr);
2622       /* I know this is p^2 time in general, but for bounded degree its alright */
2623       for (l = 0; l < numLeaves; ++l) {
2624         const PetscInt face = lpoints[l];
2625         if ((face >= fStart) && (face < fEnd)) {
2626           const PetscInt rank = rpoints[l].rank;
2627           for (n = 0; n < numNeighbors; ++n) if (rank == rpoints[neighbors[n]].rank) break;
2628           if (n >= numNeighbors) {
2629             PetscInt supportSize;
2630             ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2631             if (supportSize != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Boundary faces should see one cell, not %d", supportSize);
2632             neighbors[numNeighbors++] = l;
2633           }
2634         }
2635       }
2636       ierr = PetscCalloc4(numNeighbors,&match,numNeighbors,&nranks,numRoots,&rornt,numRoots,&lornt);CHKERRQ(ierr);
2637       for (face = fStart; face < fEnd; ++face) {
2638         ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2639         if (supportSize != 1) continue;
2640         ierr = DMPlexGetSupport(dm, face, &support);CHKERRQ(ierr);
2641 
2642         ierr = DMPlexGetCone(dm, support[0], &cone);CHKERRQ(ierr);
2643         ierr = DMPlexGetConeSize(dm, support[0], &coneSize);CHKERRQ(ierr);
2644         ierr = DMPlexGetConeOrientation(dm, support[0], &ornt);CHKERRQ(ierr);
2645         for (c = 0; c < coneSize; ++c) if (cone[c] == face) break;
2646         if (dim == 1) {
2647           /* Use cone position instead, shifted to -1 or 1 */
2648           rornt[face] = c*2-1;
2649         } else {
2650           if (PetscBTLookup(flippedCells, support[0]-cStart)) rornt[face] = ornt[c] < 0 ? -1 :  1;
2651           else                                                rornt[face] = ornt[c] < 0 ?  1 : -1;
2652         }
2653       }
2654       /* Mark each edge with match or nomatch */
2655       ierr = PetscSFBcastBegin(sf, MPI_INT, rornt, lornt);CHKERRQ(ierr);
2656       ierr = PetscSFBcastEnd(sf, MPI_INT, rornt, lornt);CHKERRQ(ierr);
2657       for (n = 0; n < numNeighbors; ++n) {
2658         const PetscInt face = lpoints[neighbors[n]];
2659 
2660         if (rornt[face]*lornt[face] < 0) match[n] = PETSC_TRUE;
2661         else                             match[n] = PETSC_FALSE;
2662         nranks[n] = rpoints[neighbors[n]].rank;
2663       }
2664       /* Collect the graph on 0 */
2665       {
2666         MPI_Comm     comm = PetscObjectComm((PetscObject) sf);
2667         PetscBT      seenProcs, flippedProcs;
2668         PetscInt    *procFIFO, pTop, pBottom;
2669         PetscInt    *adj = NULL;
2670         PetscBool   *val = NULL;
2671         PetscMPIInt *recvcounts = NULL, *displs = NULL, p;
2672         PetscMPIInt  N = numNeighbors, numProcs = 0, rank;
2673         PetscInt     debug = 0;
2674 
2675         ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2676         if (!rank) {ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);}
2677         ierr = PetscCalloc2(numProcs,&recvcounts,numProcs+1,&displs);CHKERRQ(ierr);
2678         ierr = MPI_Gather(&N, 1, MPI_INT, recvcounts, 1, MPI_INT, 0, comm);CHKERRQ(ierr);
2679         for (p = 0; p < numProcs; ++p) {
2680           displs[p+1] = displs[p] + recvcounts[p];
2681         }
2682         if (!rank) {ierr = PetscMalloc2(displs[numProcs],&adj,displs[numProcs],&val);CHKERRQ(ierr);}
2683         ierr = MPI_Gatherv(nranks, numNeighbors, MPIU_INT, adj, recvcounts, displs, MPIU_INT, 0, comm);CHKERRQ(ierr);
2684         ierr = MPI_Gatherv(match, numNeighbors, MPIU_BOOL, val, recvcounts, displs, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
2685         if (debug) {
2686           for (p = 0; p < numProcs; ++p) {
2687             ierr = PetscPrintf(comm, "Proc %d:\n", p);
2688             for (n = 0; n < recvcounts[p]; ++n) {
2689               ierr = PetscPrintf(comm, "  edge %d (%d):\n", adj[displs[p]+n], val[displs[p]+n]);
2690             }
2691           }
2692         }
2693         ierr = PetscBTCreate(numProcs, &seenProcs);CHKERRQ(ierr);
2694         ierr = PetscBTMemzero(numProcs, seenProcs);CHKERRQ(ierr);
2695         ierr = PetscBTCreate(numProcs, &flippedProcs);CHKERRQ(ierr);
2696         ierr = PetscBTMemzero(numProcs, flippedProcs);CHKERRQ(ierr);
2697         ierr = PetscMalloc1(numProcs,&procFIFO);CHKERRQ(ierr);
2698         pTop = pBottom = 0;
2699         for (p = 0; p < numProcs; ++p) {
2700           if (PetscBTLookup(seenProcs, p)) continue;
2701           /* Initialize FIFO with next proc */
2702           procFIFO[pBottom++] = p;
2703           ierr = PetscBTSet(seenProcs, p);CHKERRQ(ierr);
2704           /* Consider each proc in FIFO */
2705           while (pTop < pBottom) {
2706             PetscInt proc, nproc, seen, flippedA, flippedB, mismatch;
2707 
2708             proc     = procFIFO[pTop++];
2709             flippedA = PetscBTLookup(flippedProcs, proc) ? 1 : 0;
2710             /* Loop over neighboring procs */
2711             for (n = 0; n < recvcounts[proc]; ++n) {
2712               nproc    = adj[displs[proc]+n];
2713               mismatch = val[displs[proc]+n] ? 0 : 1;
2714               seen     = PetscBTLookup(seenProcs, nproc);
2715               flippedB = PetscBTLookup(flippedProcs, nproc) ? 1 : 0;
2716 
2717               if (mismatch ^ (flippedA ^ flippedB)) {
2718                 if (seen) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Previously seen procs %d and %d do not match: Fault mesh is non-orientable", proc, nproc);
2719                 if (!flippedB) {
2720                   ierr = PetscBTSet(flippedProcs, nproc);CHKERRQ(ierr);
2721               } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Inconsistent mesh orientation: Fault mesh is non-orientable");
2722               } else if (mismatch && flippedA && flippedB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Attempt to flip already flipped cell: Fault mesh is non-orientable");
2723               if (!seen) {
2724                 procFIFO[pBottom++] = nproc;
2725                 ierr = PetscBTSet(seenProcs, nproc);CHKERRQ(ierr);
2726               }
2727             }
2728           }
2729         }
2730         ierr = PetscFree(procFIFO);CHKERRQ(ierr);
2731 
2732         ierr = PetscFree2(recvcounts,displs);CHKERRQ(ierr);
2733         ierr = PetscFree2(adj,val);CHKERRQ(ierr);
2734         {
2735           PetscBool *flips;
2736 
2737           ierr = PetscMalloc1(numProcs,&flips);CHKERRQ(ierr);
2738           for (p = 0; p < numProcs; ++p) {
2739             flips[p] = PetscBTLookup(flippedProcs, p) ? PETSC_TRUE : PETSC_FALSE;
2740             if (debug && flips[p]) {ierr = PetscPrintf(comm, "Flipping Proc %d:\n", p);}
2741           }
2742           ierr = MPI_Scatter(flips, 1, MPIU_BOOL, &flipped, 1, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
2743           ierr = PetscFree(flips);CHKERRQ(ierr);
2744         }
2745         ierr = PetscBTDestroy(&seenProcs);CHKERRQ(ierr);
2746         ierr = PetscBTDestroy(&flippedProcs);CHKERRQ(ierr);
2747       }
2748       ierr = PetscFree4(match,nranks,rornt,lornt);CHKERRQ(ierr);
2749       ierr = PetscFree(neighbors);CHKERRQ(ierr);
2750       if (flipped) {for (c = cStart; c < cEnd; ++c) {ierr = PetscBTNegate(flippedCells, c-cStart);CHKERRQ(ierr);}}
2751     }
2752   }
2753   /* Reverse flipped cells in the mesh */
2754   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2755   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2756   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2757   for (c = cStart; c < cEnd; ++c) {
2758     const PetscInt *cone, *coneO, *support;
2759     PetscInt        coneSize, supportSize, faceSize, cp, sp;
2760 
2761     if (!PetscBTLookup(flippedCells, c-cStart)) continue;
2762     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
2763     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
2764     ierr = DMPlexGetConeOrientation(dm, c, &coneO);CHKERRQ(ierr);
2765     for (cp = 0; cp < coneSize; ++cp) {
2766       const PetscInt rcp = coneSize-cp-1;
2767 
2768       ierr = DMPlexGetConeSize(dm, cone[rcp], &faceSize);CHKERRQ(ierr);
2769       revcone[cp]  = cone[rcp];
2770       revconeO[cp] = coneO[rcp] >= 0 ? -(faceSize-coneO[rcp]) : faceSize+coneO[rcp];
2771     }
2772     ierr = DMPlexSetCone(dm, c, revcone);CHKERRQ(ierr);
2773     ierr = DMPlexSetConeOrientation(dm, c, revconeO);CHKERRQ(ierr);
2774     /* Reverse orientations of support */
2775     faceSize = coneSize;
2776     ierr = DMPlexGetSupportSize(dm, c, &supportSize);CHKERRQ(ierr);
2777     ierr = DMPlexGetSupport(dm, c, &support);CHKERRQ(ierr);
2778     for (sp = 0; sp < supportSize; ++sp) {
2779       ierr = DMPlexGetConeSize(dm, support[sp], &coneSize);CHKERRQ(ierr);
2780       ierr = DMPlexGetCone(dm, support[sp], &cone);CHKERRQ(ierr);
2781       ierr = DMPlexGetConeOrientation(dm, support[sp], &coneO);CHKERRQ(ierr);
2782       for (cp = 0; cp < coneSize; ++cp) {
2783         if (cone[cp] != c) continue;
2784         ierr = DMPlexInsertConeOrientation(dm, support[sp], cp, coneO[cp] >= 0 ? -(faceSize-coneO[cp]) : faceSize+coneO[cp]);CHKERRQ(ierr);
2785       }
2786     }
2787   }
2788   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2789   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2790   ierr = PetscBTDestroy(&seenCells);CHKERRQ(ierr);
2791   ierr = PetscBTDestroy(&flippedCells);CHKERRQ(ierr);
2792   ierr = PetscBTDestroy(&seenFaces);CHKERRQ(ierr);
2793   ierr = PetscFree(faceFIFO);CHKERRQ(ierr);
2794   PetscFunctionReturn(0);
2795 }
2796 
2797 #undef __FUNCT__
2798 #define __FUNCT__ "DMPlexInvertCell"
2799 /*@C
2800   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
2801 
2802   Input Parameters:
2803 + numCorners - The number of vertices in a cell
2804 - cone - The incoming cone
2805 
2806   Output Parameter:
2807 . cone - The inverted cone (in-place)
2808 
2809   Level: developer
2810 
2811 .seealso: DMPlexGenerate()
2812 @*/
2813 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
2814 {
2815   int tmpc;
2816 
2817   PetscFunctionBegin;
2818   if (dim != 3) PetscFunctionReturn(0);
2819   switch (numCorners) {
2820   case 4:
2821     tmpc    = cone[0];
2822     cone[0] = cone[1];
2823     cone[1] = tmpc;
2824     break;
2825   case 8:
2826     tmpc    = cone[1];
2827     cone[1] = cone[3];
2828     cone[3] = tmpc;
2829     break;
2830   default: break;
2831   }
2832   PetscFunctionReturn(0);
2833 }
2834 
2835 #undef __FUNCT__
2836 #define __FUNCT__ "DMPlexInvertCells_Internal"
2837 /* This is to fix the tetrahedron orientation from TetGen */
2838 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
2839 {
2840   PetscInt       bound = numCells*numCorners, coff;
2841   PetscErrorCode ierr;
2842 
2843   PetscFunctionBegin;
2844   for (coff = 0; coff < bound; coff += numCorners) {
2845     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
2846   }
2847   PetscFunctionReturn(0);
2848 }
2849 
2850 #if defined(PETSC_HAVE_TRIANGLE)
2851 #include <triangle.h>
2852 
2853 #undef __FUNCT__
2854 #define __FUNCT__ "InitInput_Triangle"
2855 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
2856 {
2857   PetscFunctionBegin;
2858   inputCtx->numberofpoints             = 0;
2859   inputCtx->numberofpointattributes    = 0;
2860   inputCtx->pointlist                  = NULL;
2861   inputCtx->pointattributelist         = NULL;
2862   inputCtx->pointmarkerlist            = NULL;
2863   inputCtx->numberofsegments           = 0;
2864   inputCtx->segmentlist                = NULL;
2865   inputCtx->segmentmarkerlist          = NULL;
2866   inputCtx->numberoftriangleattributes = 0;
2867   inputCtx->trianglelist               = NULL;
2868   inputCtx->numberofholes              = 0;
2869   inputCtx->holelist                   = NULL;
2870   inputCtx->numberofregions            = 0;
2871   inputCtx->regionlist                 = NULL;
2872   PetscFunctionReturn(0);
2873 }
2874 
2875 #undef __FUNCT__
2876 #define __FUNCT__ "InitOutput_Triangle"
2877 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
2878 {
2879   PetscFunctionBegin;
2880   outputCtx->numberofpoints        = 0;
2881   outputCtx->pointlist             = NULL;
2882   outputCtx->pointattributelist    = NULL;
2883   outputCtx->pointmarkerlist       = NULL;
2884   outputCtx->numberoftriangles     = 0;
2885   outputCtx->trianglelist          = NULL;
2886   outputCtx->triangleattributelist = NULL;
2887   outputCtx->neighborlist          = NULL;
2888   outputCtx->segmentlist           = NULL;
2889   outputCtx->segmentmarkerlist     = NULL;
2890   outputCtx->numberofedges         = 0;
2891   outputCtx->edgelist              = NULL;
2892   outputCtx->edgemarkerlist        = NULL;
2893   PetscFunctionReturn(0);
2894 }
2895 
2896 #undef __FUNCT__
2897 #define __FUNCT__ "FiniOutput_Triangle"
2898 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
2899 {
2900   PetscFunctionBegin;
2901   free(outputCtx->pointlist);
2902   free(outputCtx->pointmarkerlist);
2903   free(outputCtx->segmentlist);
2904   free(outputCtx->segmentmarkerlist);
2905   free(outputCtx->edgelist);
2906   free(outputCtx->edgemarkerlist);
2907   free(outputCtx->trianglelist);
2908   free(outputCtx->neighborlist);
2909   PetscFunctionReturn(0);
2910 }
2911 
2912 #undef __FUNCT__
2913 #define __FUNCT__ "DMPlexGenerate_Triangle"
2914 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
2915 {
2916   MPI_Comm             comm;
2917   PetscInt             dim              = 2;
2918   const PetscBool      createConvexHull = PETSC_FALSE;
2919   const PetscBool      constrained      = PETSC_FALSE;
2920   struct triangulateio in;
2921   struct triangulateio out;
2922   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
2923   PetscMPIInt          rank;
2924   PetscErrorCode       ierr;
2925 
2926   PetscFunctionBegin;
2927   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
2928   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2929   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
2930   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
2931   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
2932 
2933   in.numberofpoints = vEnd - vStart;
2934   if (in.numberofpoints > 0) {
2935     PetscSection coordSection;
2936     Vec          coordinates;
2937     PetscScalar *array;
2938 
2939     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
2940     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
2941     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
2942     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
2943     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
2944     for (v = vStart; v < vEnd; ++v) {
2945       const PetscInt idx = v - vStart;
2946       PetscInt       off, d;
2947 
2948       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
2949       for (d = 0; d < dim; ++d) {
2950         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
2951       }
2952       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
2953     }
2954     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
2955   }
2956   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
2957   in.numberofsegments = eEnd - eStart;
2958   if (in.numberofsegments > 0) {
2959     ierr = PetscMalloc1(in.numberofsegments*2, &in.segmentlist);CHKERRQ(ierr);
2960     ierr = PetscMalloc1(in.numberofsegments, &in.segmentmarkerlist);CHKERRQ(ierr);
2961     for (e = eStart; e < eEnd; ++e) {
2962       const PetscInt  idx = e - eStart;
2963       const PetscInt *cone;
2964 
2965       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
2966 
2967       in.segmentlist[idx*2+0] = cone[0] - vStart;
2968       in.segmentlist[idx*2+1] = cone[1] - vStart;
2969 
2970       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
2971     }
2972   }
2973 #if 0 /* Do not currently support holes */
2974   PetscReal *holeCoords;
2975   PetscInt   h, d;
2976 
2977   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
2978   if (in.numberofholes > 0) {
2979     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
2980     for (h = 0; h < in.numberofholes; ++h) {
2981       for (d = 0; d < dim; ++d) {
2982         in.holelist[h*dim+d] = holeCoords[h*dim+d];
2983       }
2984     }
2985   }
2986 #endif
2987   if (!rank) {
2988     char args[32];
2989 
2990     /* Take away 'Q' for verbose output */
2991     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
2992     if (createConvexHull) {
2993       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
2994     }
2995     if (constrained) {
2996       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
2997     }
2998     triangulate(args, &in, &out, NULL);
2999   }
3000   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3001   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3002   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3003   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3004   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3005 
3006   {
3007     const PetscInt numCorners  = 3;
3008     const PetscInt numCells    = out.numberoftriangles;
3009     const PetscInt numVertices = out.numberofpoints;
3010     const int     *cells      = out.trianglelist;
3011     const double  *meshCoords = out.pointlist;
3012 
3013     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3014     /* Set labels */
3015     for (v = 0; v < numVertices; ++v) {
3016       if (out.pointmarkerlist[v]) {
3017         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3018       }
3019     }
3020     if (interpolate) {
3021       for (e = 0; e < out.numberofedges; e++) {
3022         if (out.edgemarkerlist[e]) {
3023           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3024           const PetscInt *edges;
3025           PetscInt        numEdges;
3026 
3027           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3028           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3029           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3030           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3031         }
3032       }
3033     }
3034     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3035   }
3036 #if 0 /* Do not currently support holes */
3037   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3038 #endif
3039   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3040   PetscFunctionReturn(0);
3041 }
3042 
3043 #undef __FUNCT__
3044 #define __FUNCT__ "DMPlexRefine_Triangle"
3045 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3046 {
3047   MPI_Comm             comm;
3048   PetscInt             dim  = 2;
3049   struct triangulateio in;
3050   struct triangulateio out;
3051   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3052   PetscMPIInt          rank;
3053   PetscErrorCode       ierr;
3054 
3055   PetscFunctionBegin;
3056   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3057   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3058   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3059   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3060   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3061   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3062   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3063 
3064   in.numberofpoints = vEnd - vStart;
3065   if (in.numberofpoints > 0) {
3066     PetscSection coordSection;
3067     Vec          coordinates;
3068     PetscScalar *array;
3069 
3070     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3071     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3072     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3073     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3074     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3075     for (v = vStart; v < vEnd; ++v) {
3076       const PetscInt idx = v - vStart;
3077       PetscInt       off, d;
3078 
3079       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3080       for (d = 0; d < dim; ++d) {
3081         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3082       }
3083       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3084     }
3085     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3086   }
3087   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3088 
3089   in.numberofcorners   = 3;
3090   in.numberoftriangles = cEnd - cStart;
3091 
3092   in.trianglearealist  = (double*) maxVolumes;
3093   if (in.numberoftriangles > 0) {
3094     ierr = PetscMalloc1(in.numberoftriangles*in.numberofcorners, &in.trianglelist);CHKERRQ(ierr);
3095     for (c = cStart; c < cEnd; ++c) {
3096       const PetscInt idx      = c - cStart;
3097       PetscInt      *closure = NULL;
3098       PetscInt       closureSize;
3099 
3100       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3101       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3102       for (v = 0; v < 3; ++v) {
3103         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3104       }
3105       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3106     }
3107   }
3108   /* TODO: Segment markers are missing on input */
3109 #if 0 /* Do not currently support holes */
3110   PetscReal *holeCoords;
3111   PetscInt   h, d;
3112 
3113   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3114   if (in.numberofholes > 0) {
3115     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3116     for (h = 0; h < in.numberofholes; ++h) {
3117       for (d = 0; d < dim; ++d) {
3118         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3119       }
3120     }
3121   }
3122 #endif
3123   if (!rank) {
3124     char args[32];
3125 
3126     /* Take away 'Q' for verbose output */
3127     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3128     triangulate(args, &in, &out, NULL);
3129   }
3130   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3131   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3132   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3133   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3134   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3135 
3136   {
3137     const PetscInt numCorners  = 3;
3138     const PetscInt numCells    = out.numberoftriangles;
3139     const PetscInt numVertices = out.numberofpoints;
3140     const int     *cells      = out.trianglelist;
3141     const double  *meshCoords = out.pointlist;
3142     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3143 
3144     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3145     /* Set labels */
3146     for (v = 0; v < numVertices; ++v) {
3147       if (out.pointmarkerlist[v]) {
3148         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3149       }
3150     }
3151     if (interpolate) {
3152       PetscInt e;
3153 
3154       for (e = 0; e < out.numberofedges; e++) {
3155         if (out.edgemarkerlist[e]) {
3156           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3157           const PetscInt *edges;
3158           PetscInt        numEdges;
3159 
3160           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3161           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3162           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3163           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3164         }
3165       }
3166     }
3167     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3168   }
3169 #if 0 /* Do not currently support holes */
3170   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3171 #endif
3172   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3173   PetscFunctionReturn(0);
3174 }
3175 #endif
3176 
3177 #if defined(PETSC_HAVE_TETGEN)
3178 #include <tetgen.h>
3179 #undef __FUNCT__
3180 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3181 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3182 {
3183   MPI_Comm       comm;
3184   const PetscInt dim  = 3;
3185   ::tetgenio     in;
3186   ::tetgenio     out;
3187   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3188   PetscMPIInt    rank;
3189   PetscErrorCode ierr;
3190 
3191   PetscFunctionBegin;
3192   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3193   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3194   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3195   in.numberofpoints = vEnd - vStart;
3196   if (in.numberofpoints > 0) {
3197     PetscSection coordSection;
3198     Vec          coordinates;
3199     PetscScalar *array;
3200 
3201     in.pointlist       = new double[in.numberofpoints*dim];
3202     in.pointmarkerlist = new int[in.numberofpoints];
3203 
3204     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3205     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3206     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3207     for (v = vStart; v < vEnd; ++v) {
3208       const PetscInt idx = v - vStart;
3209       PetscInt       off, d;
3210 
3211       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3212       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3213       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3214     }
3215     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3216   }
3217   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3218 
3219   in.numberoffacets = fEnd - fStart;
3220   if (in.numberoffacets > 0) {
3221     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3222     in.facetmarkerlist = new int[in.numberoffacets];
3223     for (f = fStart; f < fEnd; ++f) {
3224       const PetscInt idx     = f - fStart;
3225       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3226 
3227       in.facetlist[idx].numberofpolygons = 1;
3228       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3229       in.facetlist[idx].numberofholes    = 0;
3230       in.facetlist[idx].holelist         = NULL;
3231 
3232       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3233       for (p = 0; p < numPoints*2; p += 2) {
3234         const PetscInt point = points[p];
3235         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3236       }
3237 
3238       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3239       poly->numberofvertices = numVertices;
3240       poly->vertexlist       = new int[poly->numberofvertices];
3241       for (v = 0; v < numVertices; ++v) {
3242         const PetscInt vIdx = points[v] - vStart;
3243         poly->vertexlist[v] = vIdx;
3244       }
3245       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3246       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3247     }
3248   }
3249   if (!rank) {
3250     char args[32];
3251 
3252     /* Take away 'Q' for verbose output */
3253     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3254     ::tetrahedralize(args, &in, &out);
3255   }
3256   {
3257     const PetscInt numCorners  = 4;
3258     const PetscInt numCells    = out.numberoftetrahedra;
3259     const PetscInt numVertices = out.numberofpoints;
3260     const double   *meshCoords = out.pointlist;
3261     int            *cells      = out.tetrahedronlist;
3262 
3263     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3264     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3265     /* Set labels */
3266     for (v = 0; v < numVertices; ++v) {
3267       if (out.pointmarkerlist[v]) {
3268         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3269       }
3270     }
3271     if (interpolate) {
3272       PetscInt e;
3273 
3274       for (e = 0; e < out.numberofedges; e++) {
3275         if (out.edgemarkerlist[e]) {
3276           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3277           const PetscInt *edges;
3278           PetscInt        numEdges;
3279 
3280           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3281           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3282           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3283           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3284         }
3285       }
3286       for (f = 0; f < out.numberoftrifaces; f++) {
3287         if (out.trifacemarkerlist[f]) {
3288           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3289           const PetscInt *faces;
3290           PetscInt        numFaces;
3291 
3292           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3293           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3294           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3295           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3296         }
3297       }
3298     }
3299     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3300   }
3301   PetscFunctionReturn(0);
3302 }
3303 
3304 #undef __FUNCT__
3305 #define __FUNCT__ "DMPlexRefine_Tetgen"
3306 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3307 {
3308   MPI_Comm       comm;
3309   const PetscInt dim  = 3;
3310   ::tetgenio     in;
3311   ::tetgenio     out;
3312   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3313   PetscMPIInt    rank;
3314   PetscErrorCode ierr;
3315 
3316   PetscFunctionBegin;
3317   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3318   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3319   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3320   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3321   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3322 
3323   in.numberofpoints = vEnd - vStart;
3324   if (in.numberofpoints > 0) {
3325     PetscSection coordSection;
3326     Vec          coordinates;
3327     PetscScalar *array;
3328 
3329     in.pointlist       = new double[in.numberofpoints*dim];
3330     in.pointmarkerlist = new int[in.numberofpoints];
3331 
3332     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3333     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3334     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3335     for (v = vStart; v < vEnd; ++v) {
3336       const PetscInt idx = v - vStart;
3337       PetscInt       off, d;
3338 
3339       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3340       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3341       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3342     }
3343     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3344   }
3345   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3346 
3347   in.numberofcorners       = 4;
3348   in.numberoftetrahedra    = cEnd - cStart;
3349   in.tetrahedronvolumelist = (double*) maxVolumes;
3350   if (in.numberoftetrahedra > 0) {
3351     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3352     for (c = cStart; c < cEnd; ++c) {
3353       const PetscInt idx      = c - cStart;
3354       PetscInt      *closure = NULL;
3355       PetscInt       closureSize;
3356 
3357       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3358       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3359       for (v = 0; v < 4; ++v) {
3360         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3361       }
3362       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3363     }
3364   }
3365   /* TODO: Put in boundary faces with markers */
3366   if (!rank) {
3367     char args[32];
3368 
3369     /* Take away 'Q' for verbose output */
3370     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3371     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3372     ::tetrahedralize(args, &in, &out);
3373   }
3374   in.tetrahedronvolumelist = NULL;
3375 
3376   {
3377     const PetscInt numCorners  = 4;
3378     const PetscInt numCells    = out.numberoftetrahedra;
3379     const PetscInt numVertices = out.numberofpoints;
3380     const double   *meshCoords = out.pointlist;
3381     int            *cells      = out.tetrahedronlist;
3382 
3383     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3384 
3385     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3386     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3387     /* Set labels */
3388     for (v = 0; v < numVertices; ++v) {
3389       if (out.pointmarkerlist[v]) {
3390         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3391       }
3392     }
3393     if (interpolate) {
3394       PetscInt e, f;
3395 
3396       for (e = 0; e < out.numberofedges; e++) {
3397         if (out.edgemarkerlist[e]) {
3398           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3399           const PetscInt *edges;
3400           PetscInt        numEdges;
3401 
3402           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3403           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3404           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3405           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3406         }
3407       }
3408       for (f = 0; f < out.numberoftrifaces; f++) {
3409         if (out.trifacemarkerlist[f]) {
3410           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3411           const PetscInt *faces;
3412           PetscInt        numFaces;
3413 
3414           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3415           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3416           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3417           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3418         }
3419       }
3420     }
3421     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3422   }
3423   PetscFunctionReturn(0);
3424 }
3425 #endif
3426 
3427 #if defined(PETSC_HAVE_CTETGEN)
3428 #include <ctetgen.h>
3429 
3430 #undef __FUNCT__
3431 #define __FUNCT__ "DMPlexGenerate_CTetgen"
3432 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
3433 {
3434   MPI_Comm       comm;
3435   const PetscInt dim  = 3;
3436   PLC           *in, *out;
3437   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
3438   PetscMPIInt    rank;
3439   PetscErrorCode ierr;
3440 
3441   PetscFunctionBegin;
3442   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3443   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3444   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3445   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3446   ierr = PLCCreate(&in);CHKERRQ(ierr);
3447   ierr = PLCCreate(&out);CHKERRQ(ierr);
3448 
3449   in->numberofpoints = vEnd - vStart;
3450   if (in->numberofpoints > 0) {
3451     PetscSection coordSection;
3452     Vec          coordinates;
3453     PetscScalar *array;
3454 
3455     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
3456     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
3457     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3458     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3459     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3460     for (v = vStart; v < vEnd; ++v) {
3461       const PetscInt idx = v - vStart;
3462       PetscInt       off, d, m;
3463 
3464       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3465       for (d = 0; d < dim; ++d) {
3466         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3467       }
3468       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
3469 
3470       in->pointmarkerlist[idx] = (int) m;
3471     }
3472     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3473   }
3474   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3475 
3476   in->numberoffacets = fEnd - fStart;
3477   if (in->numberoffacets > 0) {
3478     ierr = PetscMalloc1(in->numberoffacets, &in->facetlist);CHKERRQ(ierr);
3479     ierr = PetscMalloc1(in->numberoffacets,   &in->facetmarkerlist);CHKERRQ(ierr);
3480     for (f = fStart; f < fEnd; ++f) {
3481       const PetscInt idx     = f - fStart;
3482       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
3483       polygon       *poly;
3484 
3485       in->facetlist[idx].numberofpolygons = 1;
3486 
3487       ierr = PetscMalloc1(in->facetlist[idx].numberofpolygons, &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
3488 
3489       in->facetlist[idx].numberofholes    = 0;
3490       in->facetlist[idx].holelist         = NULL;
3491 
3492       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3493       for (p = 0; p < numPoints*2; p += 2) {
3494         const PetscInt point = points[p];
3495         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3496       }
3497 
3498       poly                   = in->facetlist[idx].polygonlist;
3499       poly->numberofvertices = numVertices;
3500       ierr                   = PetscMalloc1(poly->numberofvertices, &poly->vertexlist);CHKERRQ(ierr);
3501       for (v = 0; v < numVertices; ++v) {
3502         const PetscInt vIdx = points[v] - vStart;
3503         poly->vertexlist[v] = vIdx;
3504       }
3505       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
3506       in->facetmarkerlist[idx] = (int) m;
3507       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3508     }
3509   }
3510   if (!rank) {
3511     TetGenOpts t;
3512 
3513     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3514     t.in        = boundary; /* Should go away */
3515     t.plc       = 1;
3516     t.quality   = 1;
3517     t.edgesout  = 1;
3518     t.zeroindex = 1;
3519     t.quiet     = 1;
3520     t.verbose   = verbose;
3521     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
3522     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3523   }
3524   {
3525     const PetscInt numCorners  = 4;
3526     const PetscInt numCells    = out->numberoftetrahedra;
3527     const PetscInt numVertices = out->numberofpoints;
3528     const double   *meshCoords = out->pointlist;
3529     int            *cells      = out->tetrahedronlist;
3530 
3531     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3532     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3533     /* Set labels */
3534     for (v = 0; v < numVertices; ++v) {
3535       if (out->pointmarkerlist[v]) {
3536         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3537       }
3538     }
3539     if (interpolate) {
3540       PetscInt e;
3541 
3542       for (e = 0; e < out->numberofedges; e++) {
3543         if (out->edgemarkerlist[e]) {
3544           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3545           const PetscInt *edges;
3546           PetscInt        numEdges;
3547 
3548           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3549           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3550           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3551           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3552         }
3553       }
3554       for (f = 0; f < out->numberoftrifaces; f++) {
3555         if (out->trifacemarkerlist[f]) {
3556           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3557           const PetscInt *faces;
3558           PetscInt        numFaces;
3559 
3560           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3561           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3562           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
3563           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3564         }
3565       }
3566     }
3567     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3568   }
3569 
3570   ierr = PLCDestroy(&in);CHKERRQ(ierr);
3571   ierr = PLCDestroy(&out);CHKERRQ(ierr);
3572   PetscFunctionReturn(0);
3573 }
3574 
3575 #undef __FUNCT__
3576 #define __FUNCT__ "DMPlexRefine_CTetgen"
3577 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
3578 {
3579   MPI_Comm       comm;
3580   const PetscInt dim  = 3;
3581   PLC           *in, *out;
3582   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3583   PetscMPIInt    rank;
3584   PetscErrorCode ierr;
3585 
3586   PetscFunctionBegin;
3587   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3588   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3589   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3590   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3591   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3592   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3593   ierr = PLCCreate(&in);CHKERRQ(ierr);
3594   ierr = PLCCreate(&out);CHKERRQ(ierr);
3595 
3596   in->numberofpoints = vEnd - vStart;
3597   if (in->numberofpoints > 0) {
3598     PetscSection coordSection;
3599     Vec          coordinates;
3600     PetscScalar *array;
3601 
3602     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
3603     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
3604     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3605     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3606     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3607     for (v = vStart; v < vEnd; ++v) {
3608       const PetscInt idx = v - vStart;
3609       PetscInt       off, d, m;
3610 
3611       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3612       for (d = 0; d < dim; ++d) {
3613         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3614       }
3615       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
3616 
3617       in->pointmarkerlist[idx] = (int) m;
3618     }
3619     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3620   }
3621   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3622 
3623   in->numberofcorners       = 4;
3624   in->numberoftetrahedra    = cEnd - cStart;
3625   in->tetrahedronvolumelist = maxVolumes;
3626   if (in->numberoftetrahedra > 0) {
3627     ierr = PetscMalloc1(in->numberoftetrahedra*in->numberofcorners, &in->tetrahedronlist);CHKERRQ(ierr);
3628     for (c = cStart; c < cEnd; ++c) {
3629       const PetscInt idx      = c - cStart;
3630       PetscInt      *closure = NULL;
3631       PetscInt       closureSize;
3632 
3633       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3634       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3635       for (v = 0; v < 4; ++v) {
3636         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3637       }
3638       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3639     }
3640   }
3641   if (!rank) {
3642     TetGenOpts t;
3643 
3644     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3645 
3646     t.in        = dm; /* Should go away */
3647     t.refine    = 1;
3648     t.varvolume = 1;
3649     t.quality   = 1;
3650     t.edgesout  = 1;
3651     t.zeroindex = 1;
3652     t.quiet     = 1;
3653     t.verbose   = verbose; /* Change this */
3654 
3655     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
3656     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3657   }
3658   {
3659     const PetscInt numCorners  = 4;
3660     const PetscInt numCells    = out->numberoftetrahedra;
3661     const PetscInt numVertices = out->numberofpoints;
3662     const double   *meshCoords = out->pointlist;
3663     int            *cells      = out->tetrahedronlist;
3664     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3665 
3666     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3667     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3668     /* Set labels */
3669     for (v = 0; v < numVertices; ++v) {
3670       if (out->pointmarkerlist[v]) {
3671         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3672       }
3673     }
3674     if (interpolate) {
3675       PetscInt e, f;
3676 
3677       for (e = 0; e < out->numberofedges; e++) {
3678         if (out->edgemarkerlist[e]) {
3679           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3680           const PetscInt *edges;
3681           PetscInt        numEdges;
3682 
3683           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3684           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3685           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3686           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3687         }
3688       }
3689       for (f = 0; f < out->numberoftrifaces; f++) {
3690         if (out->trifacemarkerlist[f]) {
3691           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3692           const PetscInt *faces;
3693           PetscInt        numFaces;
3694 
3695           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3696           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3697           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
3698           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3699         }
3700       }
3701     }
3702     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3703   }
3704   ierr = PLCDestroy(&in);CHKERRQ(ierr);
3705   ierr = PLCDestroy(&out);CHKERRQ(ierr);
3706   PetscFunctionReturn(0);
3707 }
3708 #endif
3709 
3710 #undef __FUNCT__
3711 #define __FUNCT__ "DMPlexGenerate"
3712 /*@C
3713   DMPlexGenerate - Generates a mesh.
3714 
3715   Not Collective
3716 
3717   Input Parameters:
3718 + boundary - The DMPlex boundary object
3719 . name - The mesh generation package name
3720 - interpolate - Flag to create intermediate mesh elements
3721 
3722   Output Parameter:
3723 . mesh - The DMPlex object
3724 
3725   Level: intermediate
3726 
3727 .keywords: mesh, elements
3728 .seealso: DMPlexCreate(), DMRefine()
3729 @*/
3730 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
3731 {
3732   PetscInt       dim;
3733   char           genname[1024];
3734   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
3735   PetscErrorCode ierr;
3736 
3737   PetscFunctionBegin;
3738   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
3739   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
3740   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
3741   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
3742   if (flg) name = genname;
3743   if (name) {
3744     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
3745     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
3746     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
3747   }
3748   switch (dim) {
3749   case 1:
3750     if (!name || isTriangle) {
3751 #if defined(PETSC_HAVE_TRIANGLE)
3752       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
3753 #else
3754       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
3755 #endif
3756     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
3757     break;
3758   case 2:
3759     if (!name || isCTetgen) {
3760 #if defined(PETSC_HAVE_CTETGEN)
3761       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
3762 #else
3763       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
3764 #endif
3765     } else if (isTetgen) {
3766 #if defined(PETSC_HAVE_TETGEN)
3767       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
3768 #else
3769       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
3770 #endif
3771     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
3772     break;
3773   default:
3774     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
3775   }
3776   PetscFunctionReturn(0);
3777 }
3778 
3779 #undef __FUNCT__
3780 #define __FUNCT__ "DMRefine_Plex"
3781 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
3782 {
3783   PetscReal      refinementLimit;
3784   PetscInt       dim, cStart, cEnd;
3785   char           genname[1024], *name = NULL;
3786   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
3787   PetscErrorCode ierr;
3788 
3789   PetscFunctionBegin;
3790   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
3791   if (isUniform) {
3792     CellRefiner cellRefiner;
3793 
3794     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
3795     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
3796     PetscFunctionReturn(0);
3797   }
3798   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
3799   if (refinementLimit == 0.0) PetscFunctionReturn(0);
3800   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
3801   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3802   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
3803   if (flg) name = genname;
3804   if (name) {
3805     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
3806     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
3807     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
3808   }
3809   switch (dim) {
3810   case 2:
3811     if (!name || isTriangle) {
3812 #if defined(PETSC_HAVE_TRIANGLE)
3813       double  *maxVolumes;
3814       PetscInt c;
3815 
3816       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
3817       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
3818       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
3819       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
3820 #else
3821       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
3822 #endif
3823     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
3824     break;
3825   case 3:
3826     if (!name || isCTetgen) {
3827 #if defined(PETSC_HAVE_CTETGEN)
3828       PetscReal *maxVolumes;
3829       PetscInt   c;
3830 
3831       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
3832       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
3833       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
3834 #else
3835       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
3836 #endif
3837     } else if (isTetgen) {
3838 #if defined(PETSC_HAVE_TETGEN)
3839       double  *maxVolumes;
3840       PetscInt c;
3841 
3842       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
3843       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
3844       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
3845 #else
3846       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
3847 #endif
3848     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
3849     break;
3850   default:
3851     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
3852   }
3853   PetscFunctionReturn(0);
3854 }
3855 
3856 #undef __FUNCT__
3857 #define __FUNCT__ "DMRefineHierarchy_Plex"
3858 PetscErrorCode DMRefineHierarchy_Plex(DM dm, PetscInt nlevels, DM dmRefined[])
3859 {
3860   DM             cdm = dm;
3861   PetscInt       r;
3862   PetscBool      isUniform;
3863   PetscErrorCode ierr;
3864 
3865   PetscFunctionBegin;
3866   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
3867   if (!isUniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Non-uniform refinement is incompatible with the hierarchy");
3868   for (r = 0; r < nlevels; ++r) {
3869     CellRefiner cellRefiner;
3870 
3871     ierr = DMPlexGetCellRefiner_Internal(cdm, &cellRefiner);CHKERRQ(ierr);
3872     ierr = DMPlexRefineUniform_Internal(cdm, cellRefiner, &dmRefined[r]);CHKERRQ(ierr);
3873     ierr = DMPlexSetCoarseDM(dmRefined[r], cdm);CHKERRQ(ierr);
3874     cdm  = dmRefined[r];
3875   }
3876   PetscFunctionReturn(0);
3877 }
3878 
3879 #undef __FUNCT__
3880 #define __FUNCT__ "DMCoarsen_Plex"
3881 PetscErrorCode DMCoarsen_Plex(DM dm, MPI_Comm comm, DM *dmCoarsened)
3882 {
3883   DM_Plex       *mesh = (DM_Plex*) dm->data;
3884   PetscErrorCode ierr;
3885 
3886   PetscFunctionBegin;
3887   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
3888   *dmCoarsened = mesh->coarseMesh;
3889   PetscFunctionReturn(0);
3890 }
3891 
3892 #undef __FUNCT__
3893 #define __FUNCT__ "DMPlexGetDepthLabel"
3894 /*@
3895   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
3896 
3897   Not Collective
3898 
3899   Input Parameter:
3900 . dm    - The DMPlex object
3901 
3902   Output Parameter:
3903 . depthLabel - The DMLabel recording point depth
3904 
3905   Level: developer
3906 
3907 .keywords: mesh, points
3908 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
3909 @*/
3910 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
3911 {
3912   DM_Plex       *mesh = (DM_Plex*) dm->data;
3913   PetscErrorCode ierr;
3914 
3915   PetscFunctionBegin;
3916   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3917   PetscValidPointer(depthLabel, 2);
3918   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
3919   *depthLabel = mesh->depthLabel;
3920   PetscFunctionReturn(0);
3921 }
3922 
3923 #undef __FUNCT__
3924 #define __FUNCT__ "DMPlexGetDepth"
3925 /*@
3926   DMPlexGetDepth - Get the depth of the DAG representing this mesh
3927 
3928   Not Collective
3929 
3930   Input Parameter:
3931 . dm    - The DMPlex object
3932 
3933   Output Parameter:
3934 . depth - The number of strata (breadth first levels) in the DAG
3935 
3936   Level: developer
3937 
3938 .keywords: mesh, points
3939 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
3940 @*/
3941 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
3942 {
3943   DMLabel        label;
3944   PetscInt       d = 0;
3945   PetscErrorCode ierr;
3946 
3947   PetscFunctionBegin;
3948   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3949   PetscValidPointer(depth, 2);
3950   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3951   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
3952   *depth = d-1;
3953   PetscFunctionReturn(0);
3954 }
3955 
3956 #undef __FUNCT__
3957 #define __FUNCT__ "DMPlexGetDepthStratum"
3958 /*@
3959   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
3960 
3961   Not Collective
3962 
3963   Input Parameters:
3964 + dm           - The DMPlex object
3965 - stratumValue - The requested depth
3966 
3967   Output Parameters:
3968 + start - The first point at this depth
3969 - end   - One beyond the last point at this depth
3970 
3971   Level: developer
3972 
3973 .keywords: mesh, points
3974 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
3975 @*/
3976 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3977 {
3978   DMLabel        label;
3979   PetscInt       pStart, pEnd;
3980   PetscErrorCode ierr;
3981 
3982   PetscFunctionBegin;
3983   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3984   if (start) {PetscValidPointer(start, 3); *start = 0;}
3985   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3986   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3987   if (pStart == pEnd) PetscFunctionReturn(0);
3988   if (stratumValue < 0) {
3989     if (start) *start = pStart;
3990     if (end)   *end   = pEnd;
3991     PetscFunctionReturn(0);
3992   }
3993   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3994   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3995   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
3996   PetscFunctionReturn(0);
3997 }
3998 
3999 #undef __FUNCT__
4000 #define __FUNCT__ "DMPlexGetHeightStratum"
4001 /*@
4002   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4003 
4004   Not Collective
4005 
4006   Input Parameters:
4007 + dm           - The DMPlex object
4008 - stratumValue - The requested height
4009 
4010   Output Parameters:
4011 + start - The first point at this height
4012 - end   - One beyond the last point at this height
4013 
4014   Level: developer
4015 
4016 .keywords: mesh, points
4017 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4018 @*/
4019 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4020 {
4021   DMLabel        label;
4022   PetscInt       depth, pStart, pEnd;
4023   PetscErrorCode ierr;
4024 
4025   PetscFunctionBegin;
4026   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4027   if (start) {PetscValidPointer(start, 3); *start = 0;}
4028   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4029   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4030   if (pStart == pEnd) PetscFunctionReturn(0);
4031   if (stratumValue < 0) {
4032     if (start) *start = pStart;
4033     if (end)   *end   = pEnd;
4034     PetscFunctionReturn(0);
4035   }
4036   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4037   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4038   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4039   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4040   PetscFunctionReturn(0);
4041 }
4042 
4043 #undef __FUNCT__
4044 #define __FUNCT__ "DMPlexCreateSectionInitial"
4045 /* Set the number of dof on each point and separate by fields */
4046 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4047 {
4048   PetscInt      *numDofTot;
4049   PetscInt       depth, pStart = 0, pEnd = 0;
4050   PetscInt       p, d, dep, f;
4051   PetscErrorCode ierr;
4052 
4053   PetscFunctionBegin;
4054   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
4055   for (d = 0; d <= dim; ++d) {
4056     numDofTot[d] = 0;
4057     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4058   }
4059   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4060   if (numFields > 0) {
4061     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4062     if (numComp) {
4063       for (f = 0; f < numFields; ++f) {
4064         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4065       }
4066     }
4067   }
4068   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4069   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4070   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4071   for (dep = 0; dep <= depth; ++dep) {
4072     d    = dim == depth ? dep : (!dep ? 0 : dim);
4073     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
4074     for (p = pStart; p < pEnd; ++p) {
4075       for (f = 0; f < numFields; ++f) {
4076         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4077       }
4078       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4079     }
4080   }
4081   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4082   PetscFunctionReturn(0);
4083 }
4084 
4085 #undef __FUNCT__
4086 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4087 /* Set the number of dof on each point and separate by fields
4088    If constDof is PETSC_DETERMINE, constrain every dof on the point
4089 */
4090 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4091 {
4092   PetscInt       numFields;
4093   PetscInt       bc;
4094   PetscErrorCode ierr;
4095 
4096   PetscFunctionBegin;
4097   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4098   for (bc = 0; bc < numBC; ++bc) {
4099     PetscInt        field = 0;
4100     const PetscInt *idx;
4101     PetscInt        n, i;
4102 
4103     if (numFields) field = bcField[bc];
4104     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4105     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4106     for (i = 0; i < n; ++i) {
4107       const PetscInt p        = idx[i];
4108       PetscInt       numConst = constDof;
4109 
4110       /* Constrain every dof on the point */
4111       if (numConst < 0) {
4112         if (numFields) {
4113           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4114         } else {
4115           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4116         }
4117       }
4118       if (numFields) {
4119         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4120       }
4121       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4122     }
4123     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4124   }
4125   PetscFunctionReturn(0);
4126 }
4127 
4128 #undef __FUNCT__
4129 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4130 /* Set the constrained indices on each point and separate by fields */
4131 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4132 {
4133   PetscInt      *maxConstraints;
4134   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4135   PetscErrorCode ierr;
4136 
4137   PetscFunctionBegin;
4138   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4139   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4140   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
4141   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4142   for (p = pStart; p < pEnd; ++p) {
4143     PetscInt cdof;
4144 
4145     if (numFields) {
4146       for (f = 0; f < numFields; ++f) {
4147         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4148         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4149       }
4150     } else {
4151       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4152       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4153     }
4154   }
4155   for (f = 0; f < numFields; ++f) {
4156     maxConstraints[numFields] += maxConstraints[f];
4157   }
4158   if (maxConstraints[numFields]) {
4159     PetscInt *indices;
4160 
4161     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
4162     for (p = pStart; p < pEnd; ++p) {
4163       PetscInt cdof, d;
4164 
4165       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4166       if (cdof) {
4167         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4168         if (numFields) {
4169           PetscInt numConst = 0, foff = 0;
4170 
4171           for (f = 0; f < numFields; ++f) {
4172             PetscInt cfdof, fdof;
4173 
4174             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4175             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4176             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4177             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4178             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4179             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4180             numConst += cfdof;
4181             foff     += fdof;
4182           }
4183           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4184         } else {
4185           for (d = 0; d < cdof; ++d) indices[d] = d;
4186         }
4187         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4188       }
4189     }
4190     ierr = PetscFree(indices);CHKERRQ(ierr);
4191   }
4192   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4193   PetscFunctionReturn(0);
4194 }
4195 
4196 #undef __FUNCT__
4197 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4198 /* Set the constrained field indices on each point */
4199 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4200 {
4201   const PetscInt *points, *indices;
4202   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4203   PetscErrorCode  ierr;
4204 
4205   PetscFunctionBegin;
4206   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4207   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4208 
4209   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4210   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4211   if (!constraintIndices) {
4212     PetscInt *idx, i;
4213 
4214     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4215     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
4216     for (i = 0; i < maxDof; ++i) idx[i] = i;
4217     for (p = 0; p < numPoints; ++p) {
4218       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4219     }
4220     ierr = PetscFree(idx);CHKERRQ(ierr);
4221   } else {
4222     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4223     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4224     for (p = 0; p < numPoints; ++p) {
4225       PetscInt fcdof;
4226 
4227       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4228       if (fcdof != numConstraints) SETERRQ4(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Section point %d field %d has %d constraints, but yo ugave %d indices", p, field, fcdof, numConstraints);
4229       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4230     }
4231     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4232   }
4233   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4234   PetscFunctionReturn(0);
4235 }
4236 
4237 #undef __FUNCT__
4238 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4239 /* Set the constrained indices on each point and separate by fields */
4240 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4241 {
4242   PetscInt      *indices;
4243   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4244   PetscErrorCode ierr;
4245 
4246   PetscFunctionBegin;
4247   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4248   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
4249   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4250   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4251   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4252   for (p = pStart; p < pEnd; ++p) {
4253     PetscInt cdof, d;
4254 
4255     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4256     if (cdof) {
4257       PetscInt numConst = 0, foff = 0;
4258 
4259       for (f = 0; f < numFields; ++f) {
4260         const PetscInt *fcind;
4261         PetscInt        fdof, fcdof;
4262 
4263         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4264         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4265         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4266         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4267         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4268         foff     += fdof;
4269         numConst += fcdof;
4270       }
4271       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4272       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4273     }
4274   }
4275   ierr = PetscFree(indices);CHKERRQ(ierr);
4276   PetscFunctionReturn(0);
4277 }
4278 
4279 #undef __FUNCT__
4280 #define __FUNCT__ "DMPlexCreateSection"
4281 /*@C
4282   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4283 
4284   Not Collective
4285 
4286   Input Parameters:
4287 + dm        - The DMPlex object
4288 . dim       - The spatial dimension of the problem
4289 . numFields - The number of fields in the problem
4290 . numComp   - An array of size numFields that holds the number of components for each field
4291 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4292 . numBC     - The number of boundary conditions
4293 . bcField   - An array of size numBC giving the field number for each boundry condition
4294 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4295 
4296   Output Parameter:
4297 . section - The PetscSection object
4298 
4299   Notes: numDof[f*(dim+1)+d] gives the number of dof for field f on sieve points of dimension d. For instance, numDof[1] is the
4300   nubmer of dof for field 0 on each edge.
4301 
4302   Level: developer
4303 
4304   Fortran Notes:
4305   A Fortran 90 version is available as DMPlexCreateSectionF90()
4306 
4307 .keywords: mesh, elements
4308 .seealso: DMPlexCreate(), PetscSectionCreate()
4309 @*/
4310 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
4311 {
4312   PetscErrorCode ierr;
4313 
4314   PetscFunctionBegin;
4315   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4316   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4317   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4318   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4319   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
4320   PetscFunctionReturn(0);
4321 }
4322 
4323 #undef __FUNCT__
4324 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4325 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4326 {
4327   PetscSection   section;
4328   PetscErrorCode ierr;
4329 
4330   PetscFunctionBegin;
4331   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4332   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4333   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4334   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4335   PetscFunctionReturn(0);
4336 }
4337 
4338 #undef __FUNCT__
4339 #define __FUNCT__ "DMPlexGetConeSection"
4340 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4341 {
4342   DM_Plex *mesh = (DM_Plex*) dm->data;
4343 
4344   PetscFunctionBegin;
4345   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4346   if (section) *section = mesh->coneSection;
4347   PetscFunctionReturn(0);
4348 }
4349 
4350 #undef __FUNCT__
4351 #define __FUNCT__ "DMPlexGetSupportSection"
4352 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4353 {
4354   DM_Plex *mesh = (DM_Plex*) dm->data;
4355 
4356   PetscFunctionBegin;
4357   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4358   if (section) *section = mesh->supportSection;
4359   PetscFunctionReturn(0);
4360 }
4361 
4362 #undef __FUNCT__
4363 #define __FUNCT__ "DMPlexGetCones"
4364 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4365 {
4366   DM_Plex *mesh = (DM_Plex*) dm->data;
4367 
4368   PetscFunctionBegin;
4369   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4370   if (cones) *cones = mesh->cones;
4371   PetscFunctionReturn(0);
4372 }
4373 
4374 #undef __FUNCT__
4375 #define __FUNCT__ "DMPlexGetConeOrientations"
4376 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4377 {
4378   DM_Plex *mesh = (DM_Plex*) dm->data;
4379 
4380   PetscFunctionBegin;
4381   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4382   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4383   PetscFunctionReturn(0);
4384 }
4385 
4386 /******************************** FEM Support **********************************/
4387 
4388 #undef __FUNCT__
4389 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
4390 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4391 {
4392   PetscScalar    *array, *vArray;
4393   const PetscInt *cone, *coneO;
4394   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4395   PetscErrorCode  ierr;
4396 
4397   PetscFunctionBeginHot;
4398   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4399   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4400   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4401   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4402   if (!values || !*values) {
4403     if ((point >= pStart) && (point < pEnd)) {
4404       PetscInt dof;
4405 
4406       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4407       size += dof;
4408     }
4409     for (p = 0; p < numPoints; ++p) {
4410       const PetscInt cp = cone[p];
4411       PetscInt       dof;
4412 
4413       if ((cp < pStart) || (cp >= pEnd)) continue;
4414       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4415       size += dof;
4416     }
4417     if (!values) {
4418       if (csize) *csize = size;
4419       PetscFunctionReturn(0);
4420     }
4421     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
4422   } else {
4423     array = *values;
4424   }
4425   size = 0;
4426   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4427   if ((point >= pStart) && (point < pEnd)) {
4428     PetscInt     dof, off, d;
4429     PetscScalar *varr;
4430 
4431     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4432     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4433     varr = &vArray[off];
4434     for (d = 0; d < dof; ++d, ++offset) {
4435       array[offset] = varr[d];
4436     }
4437     size += dof;
4438   }
4439   for (p = 0; p < numPoints; ++p) {
4440     const PetscInt cp = cone[p];
4441     PetscInt       o  = coneO[p];
4442     PetscInt       dof, off, d;
4443     PetscScalar   *varr;
4444 
4445     if ((cp < pStart) || (cp >= pEnd)) continue;
4446     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4447     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
4448     varr = &vArray[off];
4449     if (o >= 0) {
4450       for (d = 0; d < dof; ++d, ++offset) {
4451         array[offset] = varr[d];
4452       }
4453     } else {
4454       for (d = dof-1; d >= 0; --d, ++offset) {
4455         array[offset] = varr[d];
4456       }
4457     }
4458     size += dof;
4459   }
4460   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4461   if (!*values) {
4462     if (csize) *csize = size;
4463     *values = array;
4464   } else {
4465     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
4466     *csize = size;
4467   }
4468   PetscFunctionReturn(0);
4469 }
4470 
4471 #undef __FUNCT__
4472 #define __FUNCT__ "DMPlexVecGetClosure_Static"
4473 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4474 {
4475   PetscInt       offset = 0, p;
4476   PetscErrorCode ierr;
4477 
4478   PetscFunctionBeginHot;
4479   *size = 0;
4480   for (p = 0; p < numPoints*2; p += 2) {
4481     const PetscInt point = points[p];
4482     const PetscInt o     = points[p+1];
4483     PetscInt       dof, off, d;
4484     const PetscScalar *varr;
4485 
4486     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4487     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4488     varr = &vArray[off];
4489     if (o >= 0) {
4490       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
4491     } else {
4492       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
4493     }
4494   }
4495   *size = offset;
4496   PetscFunctionReturn(0);
4497 }
4498 
4499 #undef __FUNCT__
4500 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
4501 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4502 {
4503   PetscInt       offset = 0, f;
4504   PetscErrorCode ierr;
4505 
4506   PetscFunctionBeginHot;
4507   *size = 0;
4508   for (f = 0; f < numFields; ++f) {
4509     PetscInt fcomp, p;
4510 
4511     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
4512     for (p = 0; p < numPoints*2; p += 2) {
4513       const PetscInt point = points[p];
4514       const PetscInt o     = points[p+1];
4515       PetscInt       fdof, foff, d, c;
4516       const PetscScalar *varr;
4517 
4518       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4519       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4520       varr = &vArray[foff];
4521       if (o >= 0) {
4522         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
4523       } else {
4524         for (d = fdof/fcomp-1; d >= 0; --d) {
4525           for (c = 0; c < fcomp; ++c, ++offset) {
4526             array[offset] = varr[d*fcomp+c];
4527           }
4528         }
4529       }
4530     }
4531   }
4532   *size = offset;
4533   PetscFunctionReturn(0);
4534 }
4535 
4536 #undef __FUNCT__
4537 #define __FUNCT__ "DMPlexVecGetClosure"
4538 /*@C
4539   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4540 
4541   Not collective
4542 
4543   Input Parameters:
4544 + dm - The DM
4545 . section - The section describing the layout in v, or NULL to use the default section
4546 . v - The local vector
4547 - point - The sieve point in the DM
4548 
4549   Output Parameters:
4550 + csize - The number of values in the closure, or NULL
4551 - values - The array of values, which is a borrowed array and should not be freed
4552 
4553   Fortran Notes:
4554   Since it returns an array, this routine is only available in Fortran 90, and you must
4555   include petsc.h90 in your code.
4556 
4557   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4558 
4559   Level: intermediate
4560 
4561 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4562 @*/
4563 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4564 {
4565   PetscSection    clSection;
4566   IS              clPoints;
4567   PetscScalar    *array, *vArray;
4568   PetscInt       *points = NULL;
4569   const PetscInt *clp;
4570   PetscInt        depth, numFields, numPoints, size;
4571   PetscErrorCode  ierr;
4572 
4573   PetscFunctionBeginHot;
4574   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4575   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4576   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4577   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4578   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4579   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4580   if (depth == 1 && numFields < 2) {
4581     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4582     PetscFunctionReturn(0);
4583   }
4584   /* Get points */
4585   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
4586   if (!clPoints) {
4587     PetscInt pStart, pEnd, p, q;
4588 
4589     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4590     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4591     /* Compress out points not in the section */
4592     for (p = 0, q = 0; p < numPoints*2; p += 2) {
4593       if ((points[p] >= pStart) && (points[p] < pEnd)) {
4594         points[q*2]   = points[p];
4595         points[q*2+1] = points[p+1];
4596         ++q;
4597       }
4598     }
4599     numPoints = q;
4600   } else {
4601     PetscInt dof, off;
4602 
4603     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4604     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4605     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
4606     numPoints = dof/2;
4607     points    = (PetscInt *) &clp[off];
4608   }
4609   /* Get array */
4610   if (!values || !*values) {
4611     PetscInt asize = 0, dof, p;
4612 
4613     for (p = 0; p < numPoints*2; p += 2) {
4614       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4615       asize += dof;
4616     }
4617     if (!values) {
4618       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
4619       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
4620       if (csize) *csize = asize;
4621       PetscFunctionReturn(0);
4622     }
4623     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
4624   } else {
4625     array = *values;
4626   }
4627   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4628   /* Get values */
4629   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
4630   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
4631   /* Cleanup points */
4632   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
4633   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
4634   /* Cleanup array */
4635   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4636   if (!*values) {
4637     if (csize) *csize = size;
4638     *values = array;
4639   } else {
4640     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
4641     *csize = size;
4642   }
4643   PetscFunctionReturn(0);
4644 }
4645 
4646 #undef __FUNCT__
4647 #define __FUNCT__ "DMPlexVecRestoreClosure"
4648 /*@C
4649   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
4650 
4651   Not collective
4652 
4653   Input Parameters:
4654 + dm - The DM
4655 . section - The section describing the layout in v, or NULL to use the default section
4656 . v - The local vector
4657 . point - The sieve point in the DM
4658 . csize - The number of values in the closure, or NULL
4659 - values - The array of values, which is a borrowed array and should not be freed
4660 
4661   Fortran Notes:
4662   Since it returns an array, this routine is only available in Fortran 90, and you must
4663   include petsc.h90 in your code.
4664 
4665   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4666 
4667   Level: intermediate
4668 
4669 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4670 @*/
4671 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4672 {
4673   PetscInt       size = 0;
4674   PetscErrorCode ierr;
4675 
4676   PetscFunctionBegin;
4677   /* Should work without recalculating size */
4678   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
4679   PetscFunctionReturn(0);
4680 }
4681 
4682 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
4683 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4684 
4685 #undef __FUNCT__
4686 #define __FUNCT__ "updatePoint_private"
4687 PETSC_STATIC_INLINE PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
4688 {
4689   PetscInt        cdof;   /* The number of constraints on this point */
4690   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4691   PetscScalar    *a;
4692   PetscInt        off, cind = 0, k;
4693   PetscErrorCode  ierr;
4694 
4695   PetscFunctionBegin;
4696   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4697   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4698   a    = &array[off];
4699   if (!cdof || setBC) {
4700     if (orientation >= 0) {
4701       for (k = 0; k < dof; ++k) {
4702         fuse(&a[k], values[k]);
4703       }
4704     } else {
4705       for (k = 0; k < dof; ++k) {
4706         fuse(&a[k], values[dof-k-1]);
4707       }
4708     }
4709   } else {
4710     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4711     if (orientation >= 0) {
4712       for (k = 0; k < dof; ++k) {
4713         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4714         fuse(&a[k], values[k]);
4715       }
4716     } else {
4717       for (k = 0; k < dof; ++k) {
4718         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4719         fuse(&a[k], values[dof-k-1]);
4720       }
4721     }
4722   }
4723   PetscFunctionReturn(0);
4724 }
4725 
4726 #undef __FUNCT__
4727 #define __FUNCT__ "updatePointBC_private"
4728 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
4729 {
4730   PetscInt        cdof;   /* The number of constraints on this point */
4731   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4732   PetscScalar    *a;
4733   PetscInt        off, cind = 0, k;
4734   PetscErrorCode  ierr;
4735 
4736   PetscFunctionBegin;
4737   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4738   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4739   a    = &array[off];
4740   if (cdof) {
4741     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4742     if (orientation >= 0) {
4743       for (k = 0; k < dof; ++k) {
4744         if ((cind < cdof) && (k == cdofs[cind])) {
4745           fuse(&a[k], values[k]);
4746           ++cind;
4747         }
4748       }
4749     } else {
4750       for (k = 0; k < dof; ++k) {
4751         if ((cind < cdof) && (k == cdofs[cind])) {
4752           fuse(&a[k], values[dof-k-1]);
4753           ++cind;
4754         }
4755       }
4756     }
4757   }
4758   PetscFunctionReturn(0);
4759 }
4760 
4761 #undef __FUNCT__
4762 #define __FUNCT__ "updatePointFields_private"
4763 PETSC_STATIC_INLINE PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt o, PetscInt f, PetscInt fcomp, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscScalar values[], PetscInt *offset, PetscScalar array[])
4764 {
4765   PetscScalar    *a;
4766   PetscInt        fdof, foff, fcdof, foffset = *offset;
4767   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4768   PetscInt        cind = 0, k, c;
4769   PetscErrorCode  ierr;
4770 
4771   PetscFunctionBegin;
4772   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4773   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4774   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4775   a    = &array[foff];
4776   if (!fcdof || setBC) {
4777     if (o >= 0) {
4778       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
4779     } else {
4780       for (k = fdof/fcomp-1; k >= 0; --k) {
4781         for (c = 0; c < fcomp; ++c) {
4782           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
4783         }
4784       }
4785     }
4786   } else {
4787     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4788     if (o >= 0) {
4789       for (k = 0; k < fdof; ++k) {
4790         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
4791         fuse(&a[k], values[foffset+k]);
4792       }
4793     } else {
4794       for (k = fdof/fcomp-1; k >= 0; --k) {
4795         for (c = 0; c < fcomp; ++c) {
4796           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
4797           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
4798         }
4799       }
4800     }
4801   }
4802   *offset += fdof;
4803   PetscFunctionReturn(0);
4804 }
4805 
4806 #undef __FUNCT__
4807 #define __FUNCT__ "updatePointFieldsBC_private"
4808 PETSC_STATIC_INLINE PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, PetscInt o, PetscInt f, PetscInt fcomp, void (*fuse)(PetscScalar*, PetscScalar), const PetscScalar values[], PetscInt *offset, PetscScalar array[])
4809 {
4810   PetscScalar    *a;
4811   PetscInt        fdof, foff, fcdof, foffset = *offset;
4812   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4813   PetscInt        cind = 0, k, c;
4814   PetscErrorCode  ierr;
4815 
4816   PetscFunctionBegin;
4817   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4818   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4819   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4820   a    = &array[foff];
4821   if (fcdof) {
4822     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4823     if (o >= 0) {
4824       for (k = 0; k < fdof; ++k) {
4825         if ((cind < fcdof) && (k == fcdofs[cind])) {
4826           fuse(&a[k], values[foffset+k]);
4827           ++cind;
4828         }
4829       }
4830     } else {
4831       for (k = fdof/fcomp-1; k >= 0; --k) {
4832         for (c = 0; c < fcomp; ++c) {
4833           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
4834             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
4835             ++cind;
4836           }
4837         }
4838       }
4839     }
4840   }
4841   *offset += fdof;
4842   PetscFunctionReturn(0);
4843 }
4844 
4845 #undef __FUNCT__
4846 #define __FUNCT__ "DMPlexVecSetClosure_Static"
4847 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4848 {
4849   PetscScalar    *array;
4850   const PetscInt *cone, *coneO;
4851   PetscInt        pStart, pEnd, p, numPoints, off, dof;
4852   PetscErrorCode  ierr;
4853 
4854   PetscFunctionBeginHot;
4855   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4856   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4857   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4858   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4859   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4860   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
4861     const PetscInt cp = !p ? point : cone[p-1];
4862     const PetscInt o  = !p ? 0     : coneO[p-1];
4863 
4864     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
4865     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4866     /* ADD_VALUES */
4867     {
4868       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4869       PetscScalar    *a;
4870       PetscInt        cdof, coff, cind = 0, k;
4871 
4872       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
4873       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
4874       a    = &array[coff];
4875       if (!cdof) {
4876         if (o >= 0) {
4877           for (k = 0; k < dof; ++k) {
4878             a[k] += values[off+k];
4879           }
4880         } else {
4881           for (k = 0; k < dof; ++k) {
4882             a[k] += values[off+dof-k-1];
4883           }
4884         }
4885       } else {
4886         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
4887         if (o >= 0) {
4888           for (k = 0; k < dof; ++k) {
4889             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4890             a[k] += values[off+k];
4891           }
4892         } else {
4893           for (k = 0; k < dof; ++k) {
4894             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4895             a[k] += values[off+dof-k-1];
4896           }
4897         }
4898       }
4899     }
4900   }
4901   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4902   PetscFunctionReturn(0);
4903 }
4904 
4905 #undef __FUNCT__
4906 #define __FUNCT__ "DMPlexVecSetClosure"
4907 /*@C
4908   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
4909 
4910   Not collective
4911 
4912   Input Parameters:
4913 + dm - The DM
4914 . section - The section describing the layout in v, or NULL to use the default section
4915 . v - The local vector
4916 . point - The sieve point in the DM
4917 . values - The array of values
4918 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
4919 
4920   Fortran Notes:
4921   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4922 
4923   Level: intermediate
4924 
4925 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
4926 @*/
4927 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4928 {
4929   PetscSection    clSection;
4930   IS              clPoints;
4931   PetscScalar    *array;
4932   PetscInt       *points = NULL;
4933   const PetscInt *clp;
4934   PetscInt        depth, numFields, numPoints, p;
4935   PetscErrorCode  ierr;
4936 
4937   PetscFunctionBeginHot;
4938   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4939   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4940   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4941   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4942   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4943   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4944   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
4945     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
4946     PetscFunctionReturn(0);
4947   }
4948   /* Get points */
4949   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
4950   if (!clPoints) {
4951     PetscInt pStart, pEnd, q;
4952 
4953     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4954     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4955     /* Compress out points not in the section */
4956     for (p = 0, q = 0; p < numPoints*2; p += 2) {
4957       if ((points[p] >= pStart) && (points[p] < pEnd)) {
4958         points[q*2]   = points[p];
4959         points[q*2+1] = points[p+1];
4960         ++q;
4961       }
4962     }
4963     numPoints = q;
4964   } else {
4965     PetscInt dof, off;
4966 
4967     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4968     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4969     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
4970     numPoints = dof/2;
4971     points    = (PetscInt *) &clp[off];
4972   }
4973   /* Get array */
4974   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4975   /* Get values */
4976   if (numFields > 0) {
4977     PetscInt offset = 0, fcomp, f;
4978     for (f = 0; f < numFields; ++f) {
4979       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
4980       switch (mode) {
4981       case INSERT_VALUES:
4982         for (p = 0; p < numPoints*2; p += 2) {
4983           const PetscInt point = points[p];
4984           const PetscInt o     = points[p+1];
4985           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
4986         } break;
4987       case INSERT_ALL_VALUES:
4988         for (p = 0; p < numPoints*2; p += 2) {
4989           const PetscInt point = points[p];
4990           const PetscInt o     = points[p+1];
4991           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
4992         } break;
4993       case INSERT_BC_VALUES:
4994         for (p = 0; p < numPoints*2; p += 2) {
4995           const PetscInt point = points[p];
4996           const PetscInt o     = points[p+1];
4997           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
4998         } break;
4999       case ADD_VALUES:
5000         for (p = 0; p < numPoints*2; p += 2) {
5001           const PetscInt point = points[p];
5002           const PetscInt o     = points[p+1];
5003           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
5004         } break;
5005       case ADD_ALL_VALUES:
5006         for (p = 0; p < numPoints*2; p += 2) {
5007           const PetscInt point = points[p];
5008           const PetscInt o     = points[p+1];
5009           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
5010         } break;
5011       default:
5012         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5013       }
5014     }
5015   } else {
5016     PetscInt dof, off;
5017 
5018     switch (mode) {
5019     case INSERT_VALUES:
5020       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5021         PetscInt o = points[p+1];
5022         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5023         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5024       } break;
5025     case INSERT_ALL_VALUES:
5026       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5027         PetscInt o = points[p+1];
5028         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5029         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5030       } break;
5031     case INSERT_BC_VALUES:
5032       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5033         PetscInt o = points[p+1];
5034         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5035         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5036       } break;
5037     case ADD_VALUES:
5038       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5039         PetscInt o = points[p+1];
5040         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5041         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5042       } break;
5043     case ADD_ALL_VALUES:
5044       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5045         PetscInt o = points[p+1];
5046         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5047         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5048       } break;
5049     default:
5050       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5051     }
5052   }
5053   /* Cleanup points */
5054   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5055   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5056   /* Cleanup array */
5057   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5058   PetscFunctionReturn(0);
5059 }
5060 
5061 #undef __FUNCT__
5062 #define __FUNCT__ "DMPlexPrintMatSetValues"
5063 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5064 {
5065   PetscMPIInt    rank;
5066   PetscInt       i, j;
5067   PetscErrorCode ierr;
5068 
5069   PetscFunctionBegin;
5070   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5071   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5072   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5073   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5074   numCIndices = numCIndices ? numCIndices : numRIndices;
5075   for (i = 0; i < numRIndices; i++) {
5076     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5077     for (j = 0; j < numCIndices; j++) {
5078 #if defined(PETSC_USE_COMPLEX)
5079       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5080 #else
5081       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5082 #endif
5083     }
5084     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5085   }
5086   PetscFunctionReturn(0);
5087 }
5088 
5089 #undef __FUNCT__
5090 #define __FUNCT__ "indicesPoint_private"
5091 /* . off - The global offset of this point */
5092 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5093 {
5094   PetscInt        dof;    /* The number of unknowns on this point */
5095   PetscInt        cdof;   /* The number of constraints on this point */
5096   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5097   PetscInt        cind = 0, k;
5098   PetscErrorCode  ierr;
5099 
5100   PetscFunctionBegin;
5101   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5102   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5103   if (!cdof || setBC) {
5104     if (orientation >= 0) {
5105       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5106     } else {
5107       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5108     }
5109   } else {
5110     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5111     if (orientation >= 0) {
5112       for (k = 0; k < dof; ++k) {
5113         if ((cind < cdof) && (k == cdofs[cind])) {
5114           /* Insert check for returning constrained indices */
5115           indices[*loff+k] = -(off+k+1);
5116           ++cind;
5117         } else {
5118           indices[*loff+k] = off+k-cind;
5119         }
5120       }
5121     } else {
5122       for (k = 0; k < dof; ++k) {
5123         if ((cind < cdof) && (k == cdofs[cind])) {
5124           /* Insert check for returning constrained indices */
5125           indices[*loff+dof-k-1] = -(off+k+1);
5126           ++cind;
5127         } else {
5128           indices[*loff+dof-k-1] = off+k-cind;
5129         }
5130       }
5131     }
5132   }
5133   *loff += dof;
5134   PetscFunctionReturn(0);
5135 }
5136 
5137 #undef __FUNCT__
5138 #define __FUNCT__ "indicesPointFields_private"
5139 /* . off - The global offset of this point */
5140 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5141 {
5142   PetscInt       numFields, foff, f;
5143   PetscErrorCode ierr;
5144 
5145   PetscFunctionBegin;
5146   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5147   for (f = 0, foff = 0; f < numFields; ++f) {
5148     PetscInt        fdof, fcomp, cfdof;
5149     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5150     PetscInt        cind = 0, k, c;
5151 
5152     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5153     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5154     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5155     if (!cfdof || setBC) {
5156       if (orientation >= 0) {
5157         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5158       } else {
5159         for (k = fdof/fcomp-1; k >= 0; --k) {
5160           for (c = 0; c < fcomp; ++c) {
5161             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5162           }
5163         }
5164       }
5165     } else {
5166       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5167       if (orientation >= 0) {
5168         for (k = 0; k < fdof; ++k) {
5169           if ((cind < cfdof) && (k == fcdofs[cind])) {
5170             indices[foffs[f]+k] = -(off+foff+k+1);
5171             ++cind;
5172           } else {
5173             indices[foffs[f]+k] = off+foff+k-cind;
5174           }
5175         }
5176       } else {
5177         for (k = fdof/fcomp-1; k >= 0; --k) {
5178           for (c = 0; c < fcomp; ++c) {
5179             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5180               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5181               ++cind;
5182             } else {
5183               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5184             }
5185           }
5186         }
5187       }
5188     }
5189     foff     += fdof - cfdof;
5190     foffs[f] += fdof;
5191   }
5192   PetscFunctionReturn(0);
5193 }
5194 
5195 #undef __FUNCT__
5196 #define __FUNCT__ "DMPlexMatSetClosure"
5197 /*@C
5198   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5199 
5200   Not collective
5201 
5202   Input Parameters:
5203 + dm - The DM
5204 . section - The section describing the layout in v, or NULL to use the default section
5205 . globalSection - The section describing the layout in v, or NULL to use the default global section
5206 . A - The matrix
5207 . point - The sieve point in the DM
5208 . values - The array of values
5209 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5210 
5211   Fortran Notes:
5212   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5213 
5214   Level: intermediate
5215 
5216 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5217 @*/
5218 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5219 {
5220   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5221   PetscSection    clSection;
5222   IS              clPoints;
5223   PetscInt       *points = NULL;
5224   const PetscInt *clp;
5225   PetscInt       *indices;
5226   PetscInt        offsets[32];
5227   PetscInt        numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5228   PetscErrorCode  ierr;
5229 
5230   PetscFunctionBegin;
5231   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5232   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5233   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5234   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5235   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5236   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5237   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5238   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5239   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5240   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5241   if (!clPoints) {
5242     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5243     /* Compress out points not in the section */
5244     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5245     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5246       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5247         points[q*2]   = points[p];
5248         points[q*2+1] = points[p+1];
5249         ++q;
5250       }
5251     }
5252     numPoints = q;
5253   } else {
5254     PetscInt dof, off;
5255 
5256     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5257     numPoints = dof/2;
5258     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5259     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5260     points = (PetscInt *) &clp[off];
5261   }
5262   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5263     PetscInt fdof;
5264 
5265     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5266     for (f = 0; f < numFields; ++f) {
5267       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5268       offsets[f+1] += fdof;
5269     }
5270     numIndices += dof;
5271   }
5272   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5273 
5274   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5275   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5276   if (numFields) {
5277     for (p = 0; p < numPoints*2; p += 2) {
5278       PetscInt o = points[p+1];
5279       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5280       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5281     }
5282   } else {
5283     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5284       PetscInt o = points[p+1];
5285       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5286       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5287     }
5288   }
5289   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5290   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5291   if (ierr) {
5292     PetscMPIInt    rank;
5293     PetscErrorCode ierr2;
5294 
5295     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5296     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5297     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5298     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5299     CHKERRQ(ierr);
5300   }
5301   if (!clPoints) {
5302     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5303   } else {
5304     ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5305   }
5306   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5307   PetscFunctionReturn(0);
5308 }
5309 
5310 #undef __FUNCT__
5311 #define __FUNCT__ "DMPlexMatSetClosureRefined"
5312 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5313 {
5314   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5315   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5316   PetscInt       *cpoints = NULL;
5317   PetscInt       *findices, *cindices;
5318   PetscInt        foffsets[32], coffsets[32];
5319   CellRefiner     cellRefiner;
5320   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5321   PetscErrorCode  ierr;
5322 
5323   PetscFunctionBegin;
5324   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5325   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5326   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5327   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5328   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5329   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5330   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5331   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5332   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5333   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5334   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5335   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5336   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5337   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5338   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5339   /* Column indices */
5340   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5341   maxFPoints = numCPoints;
5342   /* Compress out points not in the section */
5343   /*   TODO: Squeeze out points with 0 dof as well */
5344   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5345   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5346     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5347       cpoints[q*2]   = cpoints[p];
5348       cpoints[q*2+1] = cpoints[p+1];
5349       ++q;
5350     }
5351   }
5352   numCPoints = q;
5353   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5354     PetscInt fdof;
5355 
5356     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5357     if (!dof) continue;
5358     for (f = 0; f < numFields; ++f) {
5359       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5360       coffsets[f+1] += fdof;
5361     }
5362     numCIndices += dof;
5363   }
5364   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5365   /* Row indices */
5366   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5367   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5368   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5369   for (r = 0, q = 0; r < numSubcells; ++r) {
5370     /* TODO Map from coarse to fine cells */
5371     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5372     /* Compress out points not in the section */
5373     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5374     for (p = 0; p < numFPoints*2; p += 2) {
5375       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5376         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5377         if (!dof) continue;
5378         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5379         if (s < q) continue;
5380         ftotpoints[q*2]   = fpoints[p];
5381         ftotpoints[q*2+1] = fpoints[p+1];
5382         ++q;
5383       }
5384     }
5385     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5386   }
5387   numFPoints = q;
5388   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5389     PetscInt fdof;
5390 
5391     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5392     if (!dof) continue;
5393     for (f = 0; f < numFields; ++f) {
5394       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5395       foffsets[f+1] += fdof;
5396     }
5397     numFIndices += dof;
5398   }
5399   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5400 
5401   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
5402   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
5403   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5404   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5405   if (numFields) {
5406     for (p = 0; p < numFPoints*2; p += 2) {
5407       PetscInt o = ftotpoints[p+1];
5408       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5409       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
5410     }
5411     for (p = 0; p < numCPoints*2; p += 2) {
5412       PetscInt o = cpoints[p+1];
5413       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5414       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
5415     }
5416   } else {
5417     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
5418       PetscInt o = ftotpoints[p+1];
5419       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5420       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
5421     }
5422     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
5423       PetscInt o = cpoints[p+1];
5424       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5425       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
5426     }
5427   }
5428   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5429   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5430   if (ierr) {
5431     PetscMPIInt    rank;
5432     PetscErrorCode ierr2;
5433 
5434     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5435     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5436     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5437     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
5438     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
5439     CHKERRQ(ierr);
5440   }
5441   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5442   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5443   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5444   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5445   PetscFunctionReturn(0);
5446 }
5447 
5448 #undef __FUNCT__
5449 #define __FUNCT__ "DMPlexGetHybridBounds"
5450 /*@
5451   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5452 
5453   Input Parameter:
5454 . dm - The DMPlex object
5455 
5456   Output Parameters:
5457 + cMax - The first hybrid cell
5458 . cMax - The first hybrid face
5459 . cMax - The first hybrid edge
5460 - cMax - The first hybrid vertex
5461 
5462   Level: developer
5463 
5464 .seealso DMPlexCreateHybridMesh()
5465 @*/
5466 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5467 {
5468   DM_Plex       *mesh = (DM_Plex*) dm->data;
5469   PetscInt       dim;
5470   PetscErrorCode ierr;
5471 
5472   PetscFunctionBegin;
5473   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5474   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5475   if (cMax) *cMax = mesh->hybridPointMax[dim];
5476   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5477   if (eMax) *eMax = mesh->hybridPointMax[1];
5478   if (vMax) *vMax = mesh->hybridPointMax[0];
5479   PetscFunctionReturn(0);
5480 }
5481 
5482 #undef __FUNCT__
5483 #define __FUNCT__ "DMPlexSetHybridBounds"
5484 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5485 {
5486   DM_Plex       *mesh = (DM_Plex*) dm->data;
5487   PetscInt       dim;
5488   PetscErrorCode ierr;
5489 
5490   PetscFunctionBegin;
5491   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5492   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5493   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5494   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5495   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5496   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5497   PetscFunctionReturn(0);
5498 }
5499 
5500 #undef __FUNCT__
5501 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5502 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5503 {
5504   DM_Plex *mesh = (DM_Plex*) dm->data;
5505 
5506   PetscFunctionBegin;
5507   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5508   PetscValidPointer(cellHeight, 2);
5509   *cellHeight = mesh->vtkCellHeight;
5510   PetscFunctionReturn(0);
5511 }
5512 
5513 #undef __FUNCT__
5514 #define __FUNCT__ "DMPlexSetVTKCellHeight"
5515 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5516 {
5517   DM_Plex *mesh = (DM_Plex*) dm->data;
5518 
5519   PetscFunctionBegin;
5520   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5521   mesh->vtkCellHeight = cellHeight;
5522   PetscFunctionReturn(0);
5523 }
5524 
5525 #undef __FUNCT__
5526 #define __FUNCT__ "DMPlexCreateNumbering_Private"
5527 /* We can easily have a form that takes an IS instead */
5528 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
5529 {
5530   PetscSection   section, globalSection;
5531   PetscInt      *numbers, p;
5532   PetscErrorCode ierr;
5533 
5534   PetscFunctionBegin;
5535   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
5536   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
5537   for (p = pStart; p < pEnd; ++p) {
5538     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
5539   }
5540   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
5541   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
5542   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
5543   for (p = pStart; p < pEnd; ++p) {
5544     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
5545   }
5546   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
5547   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5548   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
5549   PetscFunctionReturn(0);
5550 }
5551 
5552 #undef __FUNCT__
5553 #define __FUNCT__ "DMPlexGetCellNumbering"
5554 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
5555 {
5556   DM_Plex       *mesh = (DM_Plex*) dm->data;
5557   PetscInt       cellHeight, cStart, cEnd, cMax;
5558   PetscErrorCode ierr;
5559 
5560   PetscFunctionBegin;
5561   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5562   if (!mesh->globalCellNumbers) {
5563     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
5564     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5565     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5566     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
5567     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
5568   }
5569   *globalCellNumbers = mesh->globalCellNumbers;
5570   PetscFunctionReturn(0);
5571 }
5572 
5573 #undef __FUNCT__
5574 #define __FUNCT__ "DMPlexGetVertexNumbering"
5575 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
5576 {
5577   DM_Plex       *mesh = (DM_Plex*) dm->data;
5578   PetscInt       vStart, vEnd, vMax;
5579   PetscErrorCode ierr;
5580 
5581   PetscFunctionBegin;
5582   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5583   if (!mesh->globalVertexNumbers) {
5584     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5585     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
5586     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
5587     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
5588   }
5589   *globalVertexNumbers = mesh->globalVertexNumbers;
5590   PetscFunctionReturn(0);
5591 }
5592 
5593 
5594 #undef __FUNCT__
5595 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
5596 /*@C
5597   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
5598   the local section and an SF describing the section point overlap.
5599 
5600   Input Parameters:
5601   + s - The PetscSection for the local field layout
5602   . sf - The SF describing parallel layout of the section points
5603   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
5604   . label - The label specifying the points
5605   - labelValue - The label stratum specifying the points
5606 
5607   Output Parameter:
5608   . gsection - The PetscSection for the global field layout
5609 
5610   Note: This gives negative sizes and offsets to points not owned by this process
5611 
5612   Level: developer
5613 
5614 .seealso: PetscSectionCreate()
5615 @*/
5616 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
5617 {
5618   PetscInt      *neg = NULL, *tmpOff = NULL;
5619   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
5620   PetscErrorCode ierr;
5621 
5622   PetscFunctionBegin;
5623   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
5624   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
5625   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
5626   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
5627   if (nroots >= 0) {
5628     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
5629     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
5630     if (nroots > pEnd-pStart) {
5631       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
5632     } else {
5633       tmpOff = &(*gsection)->atlasDof[-pStart];
5634     }
5635   }
5636   /* Mark ghost points with negative dof */
5637   for (p = pStart; p < pEnd; ++p) {
5638     PetscInt value;
5639 
5640     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
5641     if (value != labelValue) continue;
5642     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
5643     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
5644     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
5645     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
5646     if (neg) neg[p] = -(dof+1);
5647   }
5648   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
5649   if (nroots >= 0) {
5650     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5651     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5652     if (nroots > pEnd-pStart) {
5653       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
5654     }
5655   }
5656   /* Calculate new sizes, get proccess offset, and calculate point offsets */
5657   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5658     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
5659     (*gsection)->atlasOff[p] = off;
5660     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
5661   }
5662   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
5663   globalOff -= off;
5664   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5665     (*gsection)->atlasOff[p] += globalOff;
5666     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
5667   }
5668   /* Put in negative offsets for ghost points */
5669   if (nroots >= 0) {
5670     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5671     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5672     if (nroots > pEnd-pStart) {
5673       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
5674     }
5675   }
5676   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
5677   ierr = PetscFree(neg);CHKERRQ(ierr);
5678   PetscFunctionReturn(0);
5679 }
5680 
5681 #undef __FUNCT__
5682 #define __FUNCT__ "DMPlexCheckSymmetry"
5683 /*@
5684   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
5685 
5686   Input Parameters:
5687   + dm - The DMPlex object
5688 
5689   Note: This is a useful diagnostic when creating meshes programmatically.
5690 
5691   Level: developer
5692 
5693 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
5694 @*/
5695 PetscErrorCode DMPlexCheckSymmetry(DM dm)
5696 {
5697   PetscSection    coneSection, supportSection;
5698   const PetscInt *cone, *support;
5699   PetscInt        coneSize, c, supportSize, s;
5700   PetscInt        pStart, pEnd, p, csize, ssize;
5701   PetscErrorCode  ierr;
5702 
5703   PetscFunctionBegin;
5704   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5705   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
5706   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
5707   /* Check that point p is found in the support of its cone points, and vice versa */
5708   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
5709   for (p = pStart; p < pEnd; ++p) {
5710     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
5711     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
5712     for (c = 0; c < coneSize; ++c) {
5713       PetscBool dup = PETSC_FALSE;
5714       PetscInt  d;
5715       for (d = c-1; d >= 0; --d) {
5716         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
5717       }
5718       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
5719       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
5720       for (s = 0; s < supportSize; ++s) {
5721         if (support[s] == p) break;
5722       }
5723       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
5724         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
5725         for (s = 0; s < coneSize; ++s) {
5726           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
5727         }
5728         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5729         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
5730         for (s = 0; s < supportSize; ++s) {
5731           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
5732         }
5733         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5734         if (dup) {
5735           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
5736         } else {
5737           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
5738         }
5739       }
5740     }
5741     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
5742     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
5743     for (s = 0; s < supportSize; ++s) {
5744       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5745       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5746       for (c = 0; c < coneSize; ++c) {
5747         if (cone[c] == p) break;
5748       }
5749       if (c >= coneSize) {
5750         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
5751         for (c = 0; c < supportSize; ++c) {
5752           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
5753         }
5754         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5755         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
5756         for (c = 0; c < coneSize; ++c) {
5757           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
5758         }
5759         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5760         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
5761       }
5762     }
5763   }
5764   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
5765   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
5766   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
5767   PetscFunctionReturn(0);
5768 }
5769 
5770 #undef __FUNCT__
5771 #define __FUNCT__ "DMPlexCheckSkeleton"
5772 /*@
5773   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
5774 
5775   Input Parameters:
5776 + dm - The DMPlex object
5777 . isSimplex - Are the cells simplices or tensor products
5778 - cellHeight - Normally 0
5779 
5780   Note: This is a useful diagnostic when creating meshes programmatically.
5781 
5782   Level: developer
5783 
5784 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
5785 @*/
5786 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5787 {
5788   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
5789   PetscErrorCode ierr;
5790 
5791   PetscFunctionBegin;
5792   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5793   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5794   switch (dim) {
5795   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
5796   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
5797   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
5798   default:
5799     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
5800   }
5801   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5802   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5803   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5804   cMax = cMax >= 0 ? cMax : cEnd;
5805   for (c = cStart; c < cMax; ++c) {
5806     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5807 
5808     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5809     for (cl = 0; cl < closureSize*2; cl += 2) {
5810       const PetscInt p = closure[cl];
5811       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5812     }
5813     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5814     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
5815   }
5816   for (c = cMax; c < cEnd; ++c) {
5817     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5818 
5819     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5820     for (cl = 0; cl < closureSize*2; cl += 2) {
5821       const PetscInt p = closure[cl];
5822       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5823     }
5824     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5825     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
5826   }
5827   PetscFunctionReturn(0);
5828 }
5829 
5830 #undef __FUNCT__
5831 #define __FUNCT__ "DMPlexCheckFaces"
5832 /*@
5833   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
5834 
5835   Input Parameters:
5836 + dm - The DMPlex object
5837 . isSimplex - Are the cells simplices or tensor products
5838 - cellHeight - Normally 0
5839 
5840   Note: This is a useful diagnostic when creating meshes programmatically.
5841 
5842   Level: developer
5843 
5844 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
5845 @*/
5846 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5847 {
5848   PetscInt       pMax[4];
5849   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
5850   PetscErrorCode ierr;
5851 
5852   PetscFunctionBegin;
5853   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5854   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5855   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5856   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
5857   for (h = cellHeight; h < dim; ++h) {
5858     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
5859     for (c = cStart; c < cEnd; ++c) {
5860       const PetscInt *cone, *ornt, *faces;
5861       PetscInt        numFaces, faceSize, coneSize,f;
5862       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
5863 
5864       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
5865       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
5866       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5867       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5868       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5869       for (cl = 0; cl < closureSize*2; cl += 2) {
5870         const PetscInt p = closure[cl];
5871         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
5872       }
5873       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5874       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
5875       for (f = 0; f < numFaces; ++f) {
5876         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
5877 
5878         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5879         for (cl = 0; cl < fclosureSize*2; cl += 2) {
5880           const PetscInt p = fclosure[cl];
5881           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
5882         }
5883         if (fnumCorners != faceSize) SETERRQ5(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d (%d) of cell %d has %d vertices but should have %d", cone[f], f, c, fnumCorners, faceSize);
5884         for (v = 0; v < fnumCorners; ++v) {
5885           if (fclosure[v] != faces[f*faceSize+v]) SETERRQ6(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d (%d) of cell %d vertex %d, %d != %d", cone[f], f, c, v, fclosure[v], faces[f*faceSize+v]);
5886         }
5887         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5888       }
5889       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5890       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5891     }
5892   }
5893   PetscFunctionReturn(0);
5894 }
5895 
5896 #undef __FUNCT__
5897 #define __FUNCT__ "DMCreateInterpolation_Plex"
5898 /* Pointwise interpolation
5899      Just code FEM for now
5900      u^f = I u^c
5901      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
5902      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
5903      I_{ij} = psi^f_i phi^c_j
5904 */
5905 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
5906 {
5907   PetscSection   gsc, gsf;
5908   PetscInt       m, n;
5909   void          *ctx;
5910   PetscErrorCode ierr;
5911 
5912   PetscFunctionBegin;
5913   /*
5914   Loop over coarse cells
5915     Loop over coarse basis functions
5916       Loop over fine cells in coarse cell
5917         Loop over fine dual basis functions
5918           Evaluate coarse basis on fine dual basis quad points
5919           Sum
5920           Update local element matrix
5921     Accumulate to interpolation matrix
5922 
5923    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
5924   */
5925   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
5926   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
5927   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
5928   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
5929   /* We need to preallocate properly */
5930   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
5931   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
5932   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
5933   ierr = MatSetUp(*interpolation);CHKERRQ(ierr);
5934   ierr = MatSetFromOptions(*interpolation);CHKERRQ(ierr);
5935   ierr = MatSetOption(*interpolation, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
5936   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
5937   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
5938   /* Use naive scaling */
5939   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
5940   PetscFunctionReturn(0);
5941 }
5942 
5943 #undef __FUNCT__
5944 #define __FUNCT__ "DMCreateInjection_Plex"
5945 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
5946 {
5947   Vec             cv,  fv;
5948   IS              cis, fis, fpointIS;
5949   PetscSection    sc, gsc, gsf;
5950   const PetscInt *fpoints;
5951   PetscInt       *cindices, *findices;
5952   PetscInt        cpStart, cpEnd, m, off, cp;
5953   PetscErrorCode  ierr;
5954 
5955   PetscFunctionBegin;
5956   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
5957   ierr = DMGetGlobalVector(dmFine, &fv);CHKERRQ(ierr);
5958   ierr = DMGetDefaultSection(dmCoarse, &sc);CHKERRQ(ierr);
5959   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
5960   ierr = DMGetGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
5961   ierr = DMPlexCreateCoarsePointIS(dmCoarse, &fpointIS);CHKERRQ(ierr);
5962   ierr = PetscSectionGetConstrainedStorageSize(gsc, &m);CHKERRQ(ierr);
5963   ierr = PetscMalloc2(m,&cindices,m,&findices);CHKERRQ(ierr);
5964   ierr = PetscSectionGetChart(gsc, &cpStart, &cpEnd);CHKERRQ(ierr);
5965   ierr = ISGetIndices(fpointIS, &fpoints);CHKERRQ(ierr);
5966   for (cp = cpStart, off = 0; cp < cpEnd; ++cp) {
5967     const PetscInt *cdofsC = NULL;
5968     PetscInt        fp     = fpoints[cp-cpStart], dofC, cdofC, dofF, offC, offF, d, e;
5969 
5970     ierr = PetscSectionGetDof(gsc, cp, &dofC);CHKERRQ(ierr);
5971     if (dofC <= 0) continue;
5972     ierr = PetscSectionGetConstraintDof(sc, cp, &cdofC);CHKERRQ(ierr);
5973     ierr = PetscSectionGetDof(gsf, fp, &dofF);CHKERRQ(ierr);
5974     ierr = PetscSectionGetOffset(gsc, cp, &offC);CHKERRQ(ierr);
5975     ierr = PetscSectionGetOffset(gsf, fp, &offF);CHKERRQ(ierr);
5976     if (cdofC) {ierr = PetscSectionGetConstraintIndices(sc, cp, &cdofsC);CHKERRQ(ierr);}
5977     if (dofC != dofF) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d (%d) has %d coarse dofs != %d fine dofs", cp, fp, dofC, dofF);
5978     if (offC < 0 || offF < 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Coarse point %d has invalid offset %d (%d)", cp, offC, offF);
5979     for (d = 0, e = 0; d < dofC; ++d) {
5980       if (cdofsC && cdofsC[e] == d) {++e; continue;}
5981       cindices[off+d-e] = offC+d; findices[off+d-e] = offF+d;
5982     }
5983     if (e != cdofC) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d (%d) has invalid number of constraints %d != %d", cp, fp, e, cdofC);
5984     off += dofC-cdofC;
5985   }
5986   ierr = ISRestoreIndices(fpointIS, &fpoints);CHKERRQ(ierr);
5987   if (off != m) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of coarse dofs %d != %d", off, m);
5988   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
5989   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
5990   ierr = VecScatterCreate(cv, cis, fv, fis, ctx);CHKERRQ(ierr);
5991   ierr = ISDestroy(&cis);CHKERRQ(ierr);
5992   ierr = ISDestroy(&fis);CHKERRQ(ierr);
5993   ierr = DMRestoreGlobalVector(dmFine, &fv);CHKERRQ(ierr);
5994   ierr = DMRestoreGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
5995   ierr = ISDestroy(&fpointIS);CHKERRQ(ierr);
5996   PetscFunctionReturn(0);
5997 }
5998 
5999 #undef __FUNCT__
6000 #define __FUNCT__ "DMCreateDefaultSection_Plex"
6001 /* Pointwise interpolation
6002      Just code FEM for now
6003      u^f = I u^c
6004      sum_k u^f_k phi^f_k = I sum_l u^c_l phi^c_l
6005      u^f_i = sum_l int psi^f_i I phi^c_l u^c_l
6006      I_{ij} = int psi^f_i phi^c_j
6007 */
6008 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6009 {
6010   PetscSection   section;
6011   IS            *bcPoints;
6012   PetscInt      *bcFields, *numComp, *numDof;
6013   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc, f;
6014   PetscErrorCode ierr;
6015 
6016   PetscFunctionBegin;
6017   /* Handle boundary conditions */
6018   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6019   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6020   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
6021   for (bd = 0; bd < numBd; ++bd) {
6022     PetscBool isEssential;
6023     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6024     if (isEssential) ++numBC;
6025   }
6026   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
6027   for (bd = 0, bc = 0; bd < numBd; ++bd) {
6028     const char     *bdLabel;
6029     DMLabel         label;
6030     const PetscInt *values;
6031     PetscInt        field, numValues;
6032     PetscBool       isEssential, has;
6033 
6034     ierr = DMPlexGetBoundary(dm, bd, &isEssential, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6035     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
6036     ierr = DMPlexHasLabel(dm, bdLabel, &has);CHKERRQ(ierr);
6037     if (!has) {
6038       ierr = DMPlexCreateLabel(dm, bdLabel);CHKERRQ(ierr);
6039       ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6040       ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
6041     }
6042     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6043     ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6044     if (isEssential) {
6045       bcFields[bc] = field;
6046       ierr = DMPlexGetStratumIS(dm, bdLabel, values[0], &bcPoints[bc++]);CHKERRQ(ierr);
6047     }
6048   }
6049   /* Handle discretization */
6050   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6051   ierr = PetscMalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6052   for (f = 0; f < numFields; ++f) {
6053     PetscFE         fe;
6054     const PetscInt *numFieldDof;
6055     PetscInt        d;
6056 
6057     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6058     ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6059     ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6060     for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6061   }
6062   for (f = 0; f < numFields; ++f) {
6063     PetscInt d;
6064     for (d = 1; d < dim; ++d) {
6065       if ((numDof[f*(dim+1)+d] > 0) && (depth < dim)) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Mesh must be interpolated when unknowns are specified on edges or faces.");
6066     }
6067   }
6068   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, &section);CHKERRQ(ierr);
6069   for (f = 0; f < numFields; ++f) {
6070     PetscFE     fe;
6071     const char *name;
6072 
6073     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6074     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6075     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6076   }
6077   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6078   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6079   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
6080   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
6081   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6082   PetscFunctionReturn(0);
6083 }
6084 
6085 #undef __FUNCT__
6086 #define __FUNCT__ "DMPlexGetCoarseDM"
6087 /*@
6088   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
6089 
6090   Input Parameter:
6091 . dm - The DMPlex object
6092 
6093   Output Parameter:
6094 . cdm - The coarse DM
6095 
6096   Level: intermediate
6097 
6098 .seealso: DMPlexSetCoarseDM()
6099 @*/
6100 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
6101 {
6102   PetscFunctionBegin;
6103   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6104   PetscValidPointer(cdm, 2);
6105   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
6106   PetscFunctionReturn(0);
6107 }
6108 
6109 #undef __FUNCT__
6110 #define __FUNCT__ "DMPlexSetCoarseDM"
6111 /*@
6112   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
6113 
6114   Input Parameters:
6115 + dm - The DMPlex object
6116 - cdm - The coarse DM
6117 
6118   Level: intermediate
6119 
6120 .seealso: DMPlexGetCoarseDM()
6121 @*/
6122 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
6123 {
6124   DM_Plex       *mesh;
6125   PetscErrorCode ierr;
6126 
6127   PetscFunctionBegin;
6128   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6129   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
6130   mesh = (DM_Plex *) dm->data;
6131   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
6132   mesh->coarseMesh = cdm;
6133   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
6134   PetscFunctionReturn(0);
6135 }
6136