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