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