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