xref: /petsc/src/dm/impls/plex/plex.c (revision f9426fe092dba0ba2fdf65dfec8d938c4b10a31c)
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;
279     PetscInt    locDepth, depth, dim, d;
280     PetscInt    pStart, pEnd, p;
281     PetscInt    numLabels, l;
282     PetscMPIInt size;
283 
284     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
285     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
286     ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
287     ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimensions:\n", dim);CHKERRQ(ierr);
288     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
289     ierr = MPI_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
290     ierr = PetscMalloc(size * sizeof(PetscInt), &sizes);CHKERRQ(ierr);
291     if (depth == 1) {
292       ierr = DMPlexGetDepthStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
293       pEnd = pEnd - pStart;
294       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
295       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", 0);CHKERRQ(ierr);
296       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
297       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
298       ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
299       pEnd = pEnd - pStart;
300       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
301       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", dim);CHKERRQ(ierr);
302       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
303       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
304     } else {
305       for (d = 0; d <= dim; d++) {
306         ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
307         pEnd = pEnd - pStart;
308         ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
309         ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", d);CHKERRQ(ierr);
310         for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
311         ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
312       }
313     }
314     ierr = PetscFree(sizes);CHKERRQ(ierr);
315     ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
316     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
317     for (l = 0; l < numLabels; ++l) {
318       DMLabel         label;
319       const char     *name;
320       IS              valueIS;
321       const PetscInt *values;
322       PetscInt        numValues, v;
323 
324       ierr = DMPlexGetLabelName(dm, l, &name);CHKERRQ(ierr);
325       ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
326       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
327       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %d strata of sizes (", name, numValues);CHKERRQ(ierr);
328       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
329       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
330       for (v = 0; v < numValues; ++v) {
331         PetscInt size;
332 
333         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
334         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
335         ierr = PetscViewerASCIIPrintf(viewer, "%d", size);CHKERRQ(ierr);
336       }
337       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
338       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
339       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
340     }
341   }
342   PetscFunctionReturn(0);
343 }
344 
345 #undef __FUNCT__
346 #define __FUNCT__ "DMView_Plex"
347 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
348 {
349   PetscBool      iascii, isbinary;
350   PetscErrorCode ierr;
351 
352   PetscFunctionBegin;
353   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
354   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
355   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
356   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
357   if (iascii) {
358     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
359 #if 0
360   } else if (isbinary) {
361     ierr = DMPlexView_Binary(dm, viewer);CHKERRQ(ierr);
362 #endif
363   }
364   PetscFunctionReturn(0);
365 }
366 
367 #undef __FUNCT__
368 #define __FUNCT__ "DMDestroy_Plex"
369 PetscErrorCode DMDestroy_Plex(DM dm)
370 {
371   DM_Plex       *mesh = (DM_Plex*) dm->data;
372   DMLabel        next  = mesh->labels;
373   PetscErrorCode ierr;
374 
375   PetscFunctionBegin;
376   if (--mesh->refct > 0) PetscFunctionReturn(0);
377   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
378   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
379   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
380   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
381   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
382   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
383   while (next) {
384     DMLabel tmp = next->next;
385 
386     ierr = DMLabelDestroy(&next);CHKERRQ(ierr);
387     next = tmp;
388   }
389   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
390   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
391   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
392   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
393   ierr = PetscFree(mesh);CHKERRQ(ierr);
394   PetscFunctionReturn(0);
395 }
396 
397 #undef __FUNCT__
398 #define __FUNCT__ "DMCreateMatrix_Plex"
399 PetscErrorCode DMCreateMatrix_Plex(DM dm, MatType mtype, Mat *J)
400 {
401   PetscSection   section, sectionGlobal;
402   PetscInt       bs = -1;
403   PetscInt       localSize;
404   PetscBool      isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock;
405   PetscErrorCode ierr;
406 
407   PetscFunctionBegin;
408 #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
409   ierr = MatInitializePackage();CHKERRQ(ierr);
410 #endif
411   if (!mtype) mtype = MATAIJ;
412   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
413   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
414   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
415   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
416   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
417   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
418   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
419   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
420   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
421   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
422   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
423   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
424   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
425   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
426   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
427   if (!isShell) {
428     PetscBool fillMatrix = (PetscBool) !dm->prealloc_only;
429     PetscInt *dnz, *onz, *dnzu, *onzu, bsLocal, bsMax, bsMin;
430 
431     if (bs < 0) {
432       if (isBlock || isSeqBlock || isMPIBlock || isSymBlock || isSymSeqBlock || isSymMPIBlock) {
433         PetscInt pStart, pEnd, p, dof, cdof;
434 
435         ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
436         for (p = pStart; p < pEnd; ++p) {
437           ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
438           ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
439           if (dof-cdof) {
440             if (bs < 0) {
441               bs = dof-cdof;
442             } else if (bs != dof-cdof) {
443               /* Layout does not admit a pointwise block size */
444               bs = 1;
445               break;
446             }
447           }
448         }
449         /* Must have same blocksize on all procs (some might have no points) */
450         bsLocal = bs;
451         ierr = MPI_Allreduce(&bsLocal, &bsMax, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
452         bsLocal = bs < 0 ? bsMax : bs;
453         ierr = MPI_Allreduce(&bsLocal, &bsMin, 1, MPIU_INT, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
454         if (bsMin != bsMax) {
455           bs = 1;
456         } else {
457           bs = bsMax;
458         }
459       } else {
460         bs = 1;
461       }
462     }
463     ierr = PetscMalloc4(localSize/bs, PetscInt, &dnz, localSize/bs, PetscInt, &onz, localSize/bs, PetscInt, &dnzu, localSize/bs, PetscInt, &onzu);CHKERRQ(ierr);
464     ierr = PetscMemzero(dnz,  localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
465     ierr = PetscMemzero(onz,  localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
466     ierr = PetscMemzero(dnzu, localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
467     ierr = PetscMemzero(onzu, localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
468     ierr = DMPlexPreallocateOperator(dm, bs, section, sectionGlobal, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
469     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
470   }
471   PetscFunctionReturn(0);
472 }
473 
474 #undef __FUNCT__
475 #define __FUNCT__ "DMPlexGetDimension"
476 /*@
477   DMPlexGetDimension - Return the topological mesh dimension
478 
479   Not collective
480 
481   Input Parameter:
482 . mesh - The DMPlex
483 
484   Output Parameter:
485 . dim - The topological mesh dimension
486 
487   Level: beginner
488 
489 .seealso: DMPlexCreate()
490 @*/
491 PetscErrorCode DMPlexGetDimension(DM dm, PetscInt *dim)
492 {
493   DM_Plex *mesh = (DM_Plex*) dm->data;
494 
495   PetscFunctionBegin;
496   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
497   PetscValidPointer(dim, 2);
498   *dim = mesh->dim;
499   PetscFunctionReturn(0);
500 }
501 
502 #undef __FUNCT__
503 #define __FUNCT__ "DMPlexSetDimension"
504 /*@
505   DMPlexSetDimension - Set the topological mesh dimension
506 
507   Collective on mesh
508 
509   Input Parameters:
510 + mesh - The DMPlex
511 - dim - The topological mesh dimension
512 
513   Level: beginner
514 
515 .seealso: DMPlexCreate()
516 @*/
517 PetscErrorCode DMPlexSetDimension(DM dm, PetscInt dim)
518 {
519   DM_Plex *mesh = (DM_Plex*) dm->data;
520 
521   PetscFunctionBegin;
522   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
523   PetscValidLogicalCollectiveInt(dm, dim, 2);
524   mesh->dim               = dim;
525   mesh->preallocCenterDim = dim;
526   PetscFunctionReturn(0);
527 }
528 
529 #undef __FUNCT__
530 #define __FUNCT__ "DMPlexGetChart"
531 /*@
532   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
533 
534   Not collective
535 
536   Input Parameter:
537 . mesh - The DMPlex
538 
539   Output Parameters:
540 + pStart - The first mesh point
541 - pEnd   - The upper bound for mesh points
542 
543   Level: beginner
544 
545 .seealso: DMPlexCreate(), DMPlexSetChart()
546 @*/
547 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
548 {
549   DM_Plex       *mesh = (DM_Plex*) dm->data;
550   PetscErrorCode ierr;
551 
552   PetscFunctionBegin;
553   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
554   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
555   PetscFunctionReturn(0);
556 }
557 
558 #undef __FUNCT__
559 #define __FUNCT__ "DMPlexSetChart"
560 /*@
561   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
562 
563   Not collective
564 
565   Input Parameters:
566 + mesh - The DMPlex
567 . pStart - The first mesh point
568 - pEnd   - The upper bound for mesh points
569 
570   Output Parameters:
571 
572   Level: beginner
573 
574 .seealso: DMPlexCreate(), DMPlexGetChart()
575 @*/
576 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
577 {
578   DM_Plex       *mesh = (DM_Plex*) dm->data;
579   PetscErrorCode ierr;
580 
581   PetscFunctionBegin;
582   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
583   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
584   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
585   PetscFunctionReturn(0);
586 }
587 
588 #undef __FUNCT__
589 #define __FUNCT__ "DMPlexGetConeSize"
590 /*@
591   DMPlexGetConeSize - Return the number of in-edges for this point in the Sieve DAG
592 
593   Not collective
594 
595   Input Parameters:
596 + mesh - The DMPlex
597 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
598 
599   Output Parameter:
600 . size - The cone size for point p
601 
602   Level: beginner
603 
604 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
605 @*/
606 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
607 {
608   DM_Plex       *mesh = (DM_Plex*) dm->data;
609   PetscErrorCode ierr;
610 
611   PetscFunctionBegin;
612   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
613   PetscValidPointer(size, 3);
614   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
615   PetscFunctionReturn(0);
616 }
617 
618 #undef __FUNCT__
619 #define __FUNCT__ "DMPlexSetConeSize"
620 /*@
621   DMPlexSetConeSize - Set the number of in-edges for this point in the Sieve DAG
622 
623   Not collective
624 
625   Input Parameters:
626 + mesh - The DMPlex
627 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
628 - size - The cone size for point p
629 
630   Output Parameter:
631 
632   Note:
633   This should be called after DMPlexSetChart().
634 
635   Level: beginner
636 
637 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
638 @*/
639 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
640 {
641   DM_Plex       *mesh = (DM_Plex*) dm->data;
642   PetscErrorCode ierr;
643 
644   PetscFunctionBegin;
645   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
646   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
647 
648   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
649   PetscFunctionReturn(0);
650 }
651 
652 #undef __FUNCT__
653 #define __FUNCT__ "DMPlexGetCone"
654 /*@C
655   DMPlexGetCone - Return the points on the in-edges for this point in the Sieve DAG
656 
657   Not collective
658 
659   Input Parameters:
660 + mesh - The DMPlex
661 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
662 
663   Output Parameter:
664 . cone - An array of points which are on the in-edges for point p
665 
666   Level: beginner
667 
668   Fortran Notes:
669   Since it returns an array, this routine is only available in Fortran 90, and you must
670   include petsc.h90 in your code.
671 
672   You must also call DMPlexRestoreCone() after you finish using the returned array.
673 
674 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart()
675 @*/
676 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
677 {
678   DM_Plex       *mesh = (DM_Plex*) dm->data;
679   PetscInt       off;
680   PetscErrorCode ierr;
681 
682   PetscFunctionBegin;
683   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
684   PetscValidPointer(cone, 3);
685   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
686   *cone = &mesh->cones[off];
687   PetscFunctionReturn(0);
688 }
689 
690 #undef __FUNCT__
691 #define __FUNCT__ "DMPlexSetCone"
692 /*@
693   DMPlexSetCone - Set the points on the in-edges for this point in the Sieve DAG
694 
695   Not collective
696 
697   Input Parameters:
698 + mesh - The DMPlex
699 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
700 - cone - An array of points which are on the in-edges for point p
701 
702   Output Parameter:
703 
704   Note:
705   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
706 
707   Level: beginner
708 
709 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
710 @*/
711 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
712 {
713   DM_Plex       *mesh = (DM_Plex*) dm->data;
714   PetscInt       pStart, pEnd;
715   PetscInt       dof, off, c;
716   PetscErrorCode ierr;
717 
718   PetscFunctionBegin;
719   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
720   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
721   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
722   if (dof) PetscValidPointer(cone, 3);
723   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
724   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);
725   for (c = 0; c < dof; ++c) {
726     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);
727     mesh->cones[off+c] = cone[c];
728   }
729   PetscFunctionReturn(0);
730 }
731 
732 #undef __FUNCT__
733 #define __FUNCT__ "DMPlexGetConeOrientation"
734 /*@C
735   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the Sieve DAG
736 
737   Not collective
738 
739   Input Parameters:
740 + mesh - The DMPlex
741 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
742 
743   Output Parameter:
744 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
745                     integer giving the prescription for cone traversal. If it is negative, the cone is
746                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
747                     the index of the cone point on which to start.
748 
749   Level: beginner
750 
751   Fortran Notes:
752   Since it returns an array, this routine is only available in Fortran 90, and you must
753   include petsc.h90 in your code.
754 
755   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
756 
757 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
758 @*/
759 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
760 {
761   DM_Plex       *mesh = (DM_Plex*) dm->data;
762   PetscInt       off;
763   PetscErrorCode ierr;
764 
765   PetscFunctionBegin;
766   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
767 #if defined(PETSC_USE_DEBUG)
768   {
769     PetscInt dof;
770     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
771     if (dof) PetscValidPointer(coneOrientation, 3);
772   }
773 #endif
774   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
775 
776   *coneOrientation = &mesh->coneOrientations[off];
777   PetscFunctionReturn(0);
778 }
779 
780 #undef __FUNCT__
781 #define __FUNCT__ "DMPlexSetConeOrientation"
782 /*@
783   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the Sieve DAG
784 
785   Not collective
786 
787   Input Parameters:
788 + mesh - The DMPlex
789 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
790 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
791                     integer giving the prescription for cone traversal. If it is negative, the cone is
792                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
793                     the index of the cone point on which to start.
794 
795   Output Parameter:
796 
797   Note:
798   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
799 
800   Level: beginner
801 
802 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
803 @*/
804 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
805 {
806   DM_Plex       *mesh = (DM_Plex*) dm->data;
807   PetscInt       pStart, pEnd;
808   PetscInt       dof, off, c;
809   PetscErrorCode ierr;
810 
811   PetscFunctionBegin;
812   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
813   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
814   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
815   if (dof) PetscValidPointer(coneOrientation, 3);
816   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
817   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);
818   for (c = 0; c < dof; ++c) {
819     PetscInt cdof, o = coneOrientation[c];
820 
821     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
822     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);
823     mesh->coneOrientations[off+c] = o;
824   }
825   PetscFunctionReturn(0);
826 }
827 
828 #undef __FUNCT__
829 #define __FUNCT__ "DMPlexInsertCone"
830 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
831 {
832   DM_Plex       *mesh = (DM_Plex*) dm->data;
833   PetscInt       pStart, pEnd;
834   PetscInt       dof, off;
835   PetscErrorCode ierr;
836 
837   PetscFunctionBegin;
838   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
839   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
840   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);
841   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);
842   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
843   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
844   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);
845   mesh->cones[off+conePos] = conePoint;
846   PetscFunctionReturn(0);
847 }
848 
849 #undef __FUNCT__
850 #define __FUNCT__ "DMPlexInsertConeOrientation"
851 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
852 {
853   DM_Plex       *mesh = (DM_Plex*) dm->data;
854   PetscInt       pStart, pEnd;
855   PetscInt       dof, off;
856   PetscErrorCode ierr;
857 
858   PetscFunctionBegin;
859   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
860   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
861   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);
862   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
863   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
864   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);
865   mesh->coneOrientations[off+conePos] = coneOrientation;
866   PetscFunctionReturn(0);
867 }
868 
869 #undef __FUNCT__
870 #define __FUNCT__ "DMPlexGetSupportSize"
871 /*@
872   DMPlexGetSupportSize - Return the number of out-edges for this point in the Sieve DAG
873 
874   Not collective
875 
876   Input Parameters:
877 + mesh - The DMPlex
878 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
879 
880   Output Parameter:
881 . size - The support size for point p
882 
883   Level: beginner
884 
885 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
886 @*/
887 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
888 {
889   DM_Plex       *mesh = (DM_Plex*) dm->data;
890   PetscErrorCode ierr;
891 
892   PetscFunctionBegin;
893   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
894   PetscValidPointer(size, 3);
895   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
896   PetscFunctionReturn(0);
897 }
898 
899 #undef __FUNCT__
900 #define __FUNCT__ "DMPlexSetSupportSize"
901 /*@
902   DMPlexSetSupportSize - Set the number of out-edges for this point in the Sieve DAG
903 
904   Not collective
905 
906   Input Parameters:
907 + mesh - The DMPlex
908 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
909 - size - The support size for point p
910 
911   Output Parameter:
912 
913   Note:
914   This should be called after DMPlexSetChart().
915 
916   Level: beginner
917 
918 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
919 @*/
920 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
921 {
922   DM_Plex       *mesh = (DM_Plex*) dm->data;
923   PetscErrorCode ierr;
924 
925   PetscFunctionBegin;
926   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
927   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
928 
929   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
930   PetscFunctionReturn(0);
931 }
932 
933 #undef __FUNCT__
934 #define __FUNCT__ "DMPlexGetSupport"
935 /*@C
936   DMPlexGetSupport - Return the points on the out-edges for this point in the Sieve DAG
937 
938   Not collective
939 
940   Input Parameters:
941 + mesh - The DMPlex
942 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
943 
944   Output Parameter:
945 . support - An array of points which are on the out-edges for point p
946 
947   Level: beginner
948 
949   Fortran Notes:
950   Since it returns an array, this routine is only available in Fortran 90, and you must
951   include petsc.h90 in your code.
952 
953   You must also call DMPlexRestoreSupport() after you finish using the returned array.
954 
955 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
956 @*/
957 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
958 {
959   DM_Plex       *mesh = (DM_Plex*) dm->data;
960   PetscInt       off;
961   PetscErrorCode ierr;
962 
963   PetscFunctionBegin;
964   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
965   PetscValidPointer(support, 3);
966   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
967   *support = &mesh->supports[off];
968   PetscFunctionReturn(0);
969 }
970 
971 #undef __FUNCT__
972 #define __FUNCT__ "DMPlexSetSupport"
973 /*@
974   DMPlexSetSupport - Set the points on the out-edges for this point in the Sieve DAG
975 
976   Not collective
977 
978   Input Parameters:
979 + mesh - The DMPlex
980 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
981 - support - An array of points which are on the in-edges for point p
982 
983   Output Parameter:
984 
985   Note:
986   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
987 
988   Level: beginner
989 
990 .seealso: DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
991 @*/
992 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
993 {
994   DM_Plex       *mesh = (DM_Plex*) dm->data;
995   PetscInt       pStart, pEnd;
996   PetscInt       dof, off, c;
997   PetscErrorCode ierr;
998 
999   PetscFunctionBegin;
1000   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1001   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1002   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1003   if (dof) PetscValidPointer(support, 3);
1004   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1005   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);
1006   for (c = 0; c < dof; ++c) {
1007     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);
1008     mesh->supports[off+c] = support[c];
1009   }
1010   PetscFunctionReturn(0);
1011 }
1012 
1013 #undef __FUNCT__
1014 #define __FUNCT__ "DMPlexInsertSupport"
1015 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
1016 {
1017   DM_Plex       *mesh = (DM_Plex*) dm->data;
1018   PetscInt       pStart, pEnd;
1019   PetscInt       dof, off;
1020   PetscErrorCode ierr;
1021 
1022   PetscFunctionBegin;
1023   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1024   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1025   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1026   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1027   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);
1028   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);
1029   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);
1030   mesh->supports[off+supportPos] = supportPoint;
1031   PetscFunctionReturn(0);
1032 }
1033 
1034 #undef __FUNCT__
1035 #define __FUNCT__ "DMPlexGetTransitiveClosure"
1036 /*@C
1037   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1038 
1039   Not collective
1040 
1041   Input Parameters:
1042 + mesh - The DMPlex
1043 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1044 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1045 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1046 
1047   Output Parameters:
1048 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1049 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1050 
1051   Note:
1052   If using internal storage (points is NULL on input), each call overwrites the last output.
1053 
1054   Fortran Notes:
1055   Since it returns an array, this routine is only available in Fortran 90, and you must
1056   include petsc.h90 in your code.
1057 
1058   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1059 
1060   Level: beginner
1061 
1062 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1063 @*/
1064 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1065 {
1066   DM_Plex        *mesh = (DM_Plex*) dm->data;
1067   PetscInt       *closure, *fifo;
1068   const PetscInt *tmp = NULL, *tmpO = NULL;
1069   PetscInt        tmpSize, t;
1070   PetscInt        depth       = 0, maxSize;
1071   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1072   PetscErrorCode  ierr;
1073 
1074   PetscFunctionBegin;
1075   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1076   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1077   /* This is only 1-level */
1078   if (useCone) {
1079     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1080     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1081     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1082   } else {
1083     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1084     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1085   }
1086   if (depth == 1) {
1087     if (*points) {
1088       closure = *points;
1089     } else {
1090       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1091       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1092     }
1093     closure[0] = p; closure[1] = 0;
1094     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1095       closure[closureSize]   = tmp[t];
1096       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
1097     }
1098     if (numPoints) *numPoints = closureSize/2;
1099     if (points)    *points    = closure;
1100     PetscFunctionReturn(0);
1101   }
1102   maxSize = 2*PetscMax(PetscMax(PetscPowInt(mesh->maxConeSize,depth+1),PetscPowInt(mesh->maxSupportSize,depth+1)),depth+1);
1103   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1104   if (*points) {
1105     closure = *points;
1106   } else {
1107     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1108   }
1109   closure[0] = p; closure[1] = 0;
1110   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1111     const PetscInt cp = tmp[t];
1112     const PetscInt co = tmpO ? tmpO[t] : 0;
1113 
1114     closure[closureSize]   = cp;
1115     closure[closureSize+1] = co;
1116     fifo[fifoSize]         = cp;
1117     fifo[fifoSize+1]       = co;
1118   }
1119   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1120   while (fifoSize - fifoStart) {
1121     const PetscInt q   = fifo[fifoStart];
1122     const PetscInt o   = fifo[fifoStart+1];
1123     const PetscInt rev = o >= 0 ? 0 : 1;
1124     const PetscInt off = rev ? -(o+1) : o;
1125 
1126     if (useCone) {
1127       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1128       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1129       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1130     } else {
1131       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1132       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1133       tmpO = NULL;
1134     }
1135     for (t = 0; t < tmpSize; ++t) {
1136       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1137       const PetscInt cp = tmp[i];
1138       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1139       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1140        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1141       PetscInt       co = tmpO ? tmpO[i] : 0;
1142       PetscInt       c;
1143 
1144       if (rev) {
1145         PetscInt childSize, coff;
1146         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1147         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1148         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1149       }
1150       /* Check for duplicate */
1151       for (c = 0; c < closureSize; c += 2) {
1152         if (closure[c] == cp) break;
1153       }
1154       if (c == closureSize) {
1155         closure[closureSize]   = cp;
1156         closure[closureSize+1] = co;
1157         fifo[fifoSize]         = cp;
1158         fifo[fifoSize+1]       = co;
1159         closureSize           += 2;
1160         fifoSize              += 2;
1161       }
1162     }
1163     fifoStart += 2;
1164   }
1165   if (numPoints) *numPoints = closureSize/2;
1166   if (points)    *points    = closure;
1167   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1168   PetscFunctionReturn(0);
1169 }
1170 
1171 #undef __FUNCT__
1172 #define __FUNCT__ "DMPlexRestoreTransitiveClosure"
1173 /*@C
1174   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1175 
1176   Not collective
1177 
1178   Input Parameters:
1179 + mesh - The DMPlex
1180 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1181 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1182 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1183 
1184   Output Parameters:
1185 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1186 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1187 
1188   Note:
1189   If not using internal storage (points is not NULL on input), this call is unnecessary
1190 
1191   Fortran Notes:
1192   Since it returns an array, this routine is only available in Fortran 90, and you must
1193   include petsc.h90 in your code.
1194 
1195   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1196 
1197   Level: beginner
1198 
1199 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1200 @*/
1201 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1202 {
1203   PetscErrorCode ierr;
1204 
1205   PetscFunctionBegin;
1206   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1207   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, points);CHKERRQ(ierr);
1208   PetscFunctionReturn(0);
1209 }
1210 
1211 #undef __FUNCT__
1212 #define __FUNCT__ "DMPlexGetMaxSizes"
1213 /*@
1214   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the Sieve DAG
1215 
1216   Not collective
1217 
1218   Input Parameter:
1219 . mesh - The DMPlex
1220 
1221   Output Parameters:
1222 + maxConeSize - The maximum number of in-edges
1223 - maxSupportSize - The maximum number of out-edges
1224 
1225   Level: beginner
1226 
1227 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1228 @*/
1229 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
1230 {
1231   DM_Plex *mesh = (DM_Plex*) dm->data;
1232 
1233   PetscFunctionBegin;
1234   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1235   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
1236   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
1237   PetscFunctionReturn(0);
1238 }
1239 
1240 #undef __FUNCT__
1241 #define __FUNCT__ "DMSetUp_Plex"
1242 PetscErrorCode DMSetUp_Plex(DM dm)
1243 {
1244   DM_Plex       *mesh = (DM_Plex*) dm->data;
1245   PetscInt       size;
1246   PetscErrorCode ierr;
1247 
1248   PetscFunctionBegin;
1249   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1250   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
1251   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
1252   ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->cones);CHKERRQ(ierr);
1253   ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->coneOrientations);CHKERRQ(ierr);
1254   ierr = PetscMemzero(mesh->coneOrientations, size * sizeof(PetscInt));CHKERRQ(ierr);
1255   if (mesh->maxSupportSize) {
1256     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1257     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
1258     ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->supports);CHKERRQ(ierr);
1259   }
1260   PetscFunctionReturn(0);
1261 }
1262 
1263 #undef __FUNCT__
1264 #define __FUNCT__ "DMCreateSubDM_Plex"
1265 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
1266 {
1267   PetscErrorCode ierr;
1268 
1269   PetscFunctionBegin;
1270   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
1271   ierr = DMCreateSubDM_Section_Private(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
1272   PetscFunctionReturn(0);
1273 }
1274 
1275 #undef __FUNCT__
1276 #define __FUNCT__ "DMPlexSymmetrize"
1277 /*@
1278   DMPlexSymmetrize - Creates support (out-edge) information from cone (in-edge) inoformation
1279 
1280   Not collective
1281 
1282   Input Parameter:
1283 . mesh - The DMPlex
1284 
1285   Output Parameter:
1286 
1287   Note:
1288   This should be called after all calls to DMPlexSetCone()
1289 
1290   Level: beginner
1291 
1292 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
1293 @*/
1294 PetscErrorCode DMPlexSymmetrize(DM dm)
1295 {
1296   DM_Plex       *mesh = (DM_Plex*) dm->data;
1297   PetscInt      *offsets;
1298   PetscInt       supportSize;
1299   PetscInt       pStart, pEnd, p;
1300   PetscErrorCode ierr;
1301 
1302   PetscFunctionBegin;
1303   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1304   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
1305   /* Calculate support sizes */
1306   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1307   for (p = pStart; p < pEnd; ++p) {
1308     PetscInt dof, off, c;
1309 
1310     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1311     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1312     for (c = off; c < off+dof; ++c) {
1313       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
1314     }
1315   }
1316   for (p = pStart; p < pEnd; ++p) {
1317     PetscInt dof;
1318 
1319     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1320 
1321     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
1322   }
1323   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1324   /* Calculate supports */
1325   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
1326   ierr = PetscMalloc(supportSize * sizeof(PetscInt), &mesh->supports);CHKERRQ(ierr);
1327   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &offsets);CHKERRQ(ierr);
1328   ierr = PetscMemzero(offsets, (pEnd - pStart) * sizeof(PetscInt));CHKERRQ(ierr);
1329   for (p = pStart; p < pEnd; ++p) {
1330     PetscInt dof, off, c;
1331 
1332     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1333     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1334     for (c = off; c < off+dof; ++c) {
1335       const PetscInt q = mesh->cones[c];
1336       PetscInt       offS;
1337 
1338       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
1339 
1340       mesh->supports[offS+offsets[q]] = p;
1341       ++offsets[q];
1342     }
1343   }
1344   ierr = PetscFree(offsets);CHKERRQ(ierr);
1345   PetscFunctionReturn(0);
1346 }
1347 
1348 #undef __FUNCT__
1349 #define __FUNCT__ "DMPlexStratify"
1350 /*@
1351   DMPlexStratify - The Sieve DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
1352   can be illustrated by Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
1353   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
1354   the DAG.
1355 
1356   Not collective
1357 
1358   Input Parameter:
1359 . mesh - The DMPlex
1360 
1361   Output Parameter:
1362 
1363   Notes:
1364   The normal association for the point grade is element dimension (or co-dimension). For instance, all vertices would
1365   have depth 0, and all edges depth 1. Likewise, all cells heights would have height 0, and all faces height 1.
1366 
1367   This should be called after all calls to DMPlexSymmetrize()
1368 
1369   Level: beginner
1370 
1371 .seealso: DMPlexCreate(), DMPlexSymmetrize()
1372 @*/
1373 PetscErrorCode DMPlexStratify(DM dm)
1374 {
1375   DMLabel        label;
1376   PetscInt       pStart, pEnd, p;
1377   PetscInt       numRoots = 0, numLeaves = 0;
1378   PetscErrorCode ierr;
1379 
1380   PetscFunctionBegin;
1381   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1382   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1383   /* Calculate depth */
1384   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1385   ierr = DMPlexCreateLabel(dm, "depth");CHKERRQ(ierr);
1386   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
1387   /* Initialize roots and count leaves */
1388   for (p = pStart; p < pEnd; ++p) {
1389     PetscInt coneSize, supportSize;
1390 
1391     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1392     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1393     if (!coneSize && supportSize) {
1394       ++numRoots;
1395       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1396     } else if (!supportSize && coneSize) {
1397       ++numLeaves;
1398     } else if (!supportSize && !coneSize) {
1399       /* Isolated points */
1400       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1401     }
1402   }
1403   if (numRoots + numLeaves == (pEnd - pStart)) {
1404     for (p = pStart; p < pEnd; ++p) {
1405       PetscInt coneSize, supportSize;
1406 
1407       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1408       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1409       if (!supportSize && coneSize) {
1410         ierr = DMLabelSetValue(label, p, 1);CHKERRQ(ierr);
1411       }
1412     }
1413   } else {
1414     IS       pointIS;
1415     PetscInt numPoints = 0, level = 0;
1416 
1417     ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1418     if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1419     while (numPoints) {
1420       const PetscInt *points;
1421       const PetscInt  newLevel = level+1;
1422 
1423       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1424       for (p = 0; p < numPoints; ++p) {
1425         const PetscInt  point = points[p];
1426         const PetscInt *support;
1427         PetscInt        supportSize, s;
1428 
1429         ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
1430         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
1431         for (s = 0; s < supportSize; ++s) {
1432           ierr = DMLabelSetValue(label, support[s], newLevel);CHKERRQ(ierr);
1433         }
1434       }
1435       ++level;
1436       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1437       ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1438       if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1439       else         {numPoints = 0;}
1440     }
1441     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1442   }
1443   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1444   PetscFunctionReturn(0);
1445 }
1446 
1447 #undef __FUNCT__
1448 #define __FUNCT__ "DMPlexGetJoin"
1449 /*@C
1450   DMPlexGetJoin - Get an array for the join of the set of points
1451 
1452   Not Collective
1453 
1454   Input Parameters:
1455 + dm - The DMPlex object
1456 . numPoints - The number of input points for the join
1457 - points - The input points
1458 
1459   Output Parameters:
1460 + numCoveredPoints - The number of points in the join
1461 - coveredPoints - The points in the join
1462 
1463   Level: intermediate
1464 
1465   Note: Currently, this is restricted to a single level join
1466 
1467   Fortran Notes:
1468   Since it returns an array, this routine is only available in Fortran 90, and you must
1469   include petsc.h90 in your code.
1470 
1471   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1472 
1473 .keywords: mesh
1474 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
1475 @*/
1476 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1477 {
1478   DM_Plex       *mesh = (DM_Plex*) dm->data;
1479   PetscInt      *join[2];
1480   PetscInt       joinSize, i = 0;
1481   PetscInt       dof, off, p, c, m;
1482   PetscErrorCode ierr;
1483 
1484   PetscFunctionBegin;
1485   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1486   PetscValidPointer(points, 2);
1487   PetscValidPointer(numCoveredPoints, 3);
1488   PetscValidPointer(coveredPoints, 4);
1489   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
1490   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
1491   /* Copy in support of first point */
1492   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
1493   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
1494   for (joinSize = 0; joinSize < dof; ++joinSize) {
1495     join[i][joinSize] = mesh->supports[off+joinSize];
1496   }
1497   /* Check each successive support */
1498   for (p = 1; p < numPoints; ++p) {
1499     PetscInt newJoinSize = 0;
1500 
1501     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
1502     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
1503     for (c = 0; c < dof; ++c) {
1504       const PetscInt point = mesh->supports[off+c];
1505 
1506       for (m = 0; m < joinSize; ++m) {
1507         if (point == join[i][m]) {
1508           join[1-i][newJoinSize++] = point;
1509           break;
1510         }
1511       }
1512     }
1513     joinSize = newJoinSize;
1514     i        = 1-i;
1515   }
1516   *numCoveredPoints = joinSize;
1517   *coveredPoints    = join[i];
1518   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
1519   PetscFunctionReturn(0);
1520 }
1521 
1522 #undef __FUNCT__
1523 #define __FUNCT__ "DMPlexRestoreJoin"
1524 /*@C
1525   DMPlexRestoreJoin - Restore an array for the join of the set of points
1526 
1527   Not Collective
1528 
1529   Input Parameters:
1530 + dm - The DMPlex object
1531 . numPoints - The number of input points for the join
1532 - points - The input points
1533 
1534   Output Parameters:
1535 + numCoveredPoints - The number of points in the join
1536 - coveredPoints - The points in the join
1537 
1538   Fortran Notes:
1539   Since it returns an array, this routine is only available in Fortran 90, and you must
1540   include petsc.h90 in your code.
1541 
1542   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1543 
1544   Level: intermediate
1545 
1546 .keywords: mesh
1547 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
1548 @*/
1549 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1550 {
1551   PetscErrorCode ierr;
1552 
1553   PetscFunctionBegin;
1554   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1555   PetscValidPointer(coveredPoints, 4);
1556   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
1557   PetscFunctionReturn(0);
1558 }
1559 
1560 #undef __FUNCT__
1561 #define __FUNCT__ "DMPlexGetFullJoin"
1562 /*@C
1563   DMPlexGetFullJoin - Get an array for the join of the set of points
1564 
1565   Not Collective
1566 
1567   Input Parameters:
1568 + dm - The DMPlex object
1569 . numPoints - The number of input points for the join
1570 - points - The input points
1571 
1572   Output Parameters:
1573 + numCoveredPoints - The number of points in the join
1574 - coveredPoints - The points in the join
1575 
1576   Fortran Notes:
1577   Since it returns an array, this routine is only available in Fortran 90, and you must
1578   include petsc.h90 in your code.
1579 
1580   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1581 
1582   Level: intermediate
1583 
1584 .keywords: mesh
1585 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
1586 @*/
1587 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1588 {
1589   DM_Plex       *mesh = (DM_Plex*) dm->data;
1590   PetscInt      *offsets, **closures;
1591   PetscInt      *join[2];
1592   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
1593   PetscInt       p, d, c, m;
1594   PetscErrorCode ierr;
1595 
1596   PetscFunctionBegin;
1597   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1598   PetscValidPointer(points, 2);
1599   PetscValidPointer(numCoveredPoints, 3);
1600   PetscValidPointer(coveredPoints, 4);
1601 
1602   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1603   ierr    = PetscMalloc(numPoints * sizeof(PetscInt*), &closures);CHKERRQ(ierr);
1604   ierr    = PetscMemzero(closures,numPoints*sizeof(PetscInt*));CHKERRQ(ierr);
1605   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1606   maxSize = PetscPowInt(mesh->maxSupportSize,depth+1);
1607   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
1608   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
1609 
1610   for (p = 0; p < numPoints; ++p) {
1611     PetscInt closureSize;
1612 
1613     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
1614 
1615     offsets[p*(depth+2)+0] = 0;
1616     for (d = 0; d < depth+1; ++d) {
1617       PetscInt pStart, pEnd, i;
1618 
1619       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
1620       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
1621         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
1622           offsets[p*(depth+2)+d+1] = i;
1623           break;
1624         }
1625       }
1626       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
1627     }
1628     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);
1629   }
1630   for (d = 0; d < depth+1; ++d) {
1631     PetscInt dof;
1632 
1633     /* Copy in support of first point */
1634     dof = offsets[d+1] - offsets[d];
1635     for (joinSize = 0; joinSize < dof; ++joinSize) {
1636       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
1637     }
1638     /* Check each successive cone */
1639     for (p = 1; p < numPoints && joinSize; ++p) {
1640       PetscInt newJoinSize = 0;
1641 
1642       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
1643       for (c = 0; c < dof; ++c) {
1644         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
1645 
1646         for (m = 0; m < joinSize; ++m) {
1647           if (point == join[i][m]) {
1648             join[1-i][newJoinSize++] = point;
1649             break;
1650           }
1651         }
1652       }
1653       joinSize = newJoinSize;
1654       i        = 1-i;
1655     }
1656     if (joinSize) break;
1657   }
1658   *numCoveredPoints = joinSize;
1659   *coveredPoints    = join[i];
1660   for (p = 0; p < numPoints; ++p) {
1661     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
1662   }
1663   ierr = PetscFree(closures);CHKERRQ(ierr);
1664   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1665   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
1666   PetscFunctionReturn(0);
1667 }
1668 
1669 #undef __FUNCT__
1670 #define __FUNCT__ "DMPlexGetMeet"
1671 /*@C
1672   DMPlexGetMeet - Get an array for the meet of the set of points
1673 
1674   Not Collective
1675 
1676   Input Parameters:
1677 + dm - The DMPlex object
1678 . numPoints - The number of input points for the meet
1679 - points - The input points
1680 
1681   Output Parameters:
1682 + numCoveredPoints - The number of points in the meet
1683 - coveredPoints - The points in the meet
1684 
1685   Level: intermediate
1686 
1687   Note: Currently, this is restricted to a single level meet
1688 
1689   Fortran Notes:
1690   Since it returns an array, this routine is only available in Fortran 90, and you must
1691   include petsc.h90 in your code.
1692 
1693   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1694 
1695 .keywords: mesh
1696 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
1697 @*/
1698 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
1699 {
1700   DM_Plex       *mesh = (DM_Plex*) dm->data;
1701   PetscInt      *meet[2];
1702   PetscInt       meetSize, i = 0;
1703   PetscInt       dof, off, p, c, m;
1704   PetscErrorCode ierr;
1705 
1706   PetscFunctionBegin;
1707   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1708   PetscValidPointer(points, 2);
1709   PetscValidPointer(numCoveringPoints, 3);
1710   PetscValidPointer(coveringPoints, 4);
1711   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
1712   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
1713   /* Copy in cone of first point */
1714   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
1715   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
1716   for (meetSize = 0; meetSize < dof; ++meetSize) {
1717     meet[i][meetSize] = mesh->cones[off+meetSize];
1718   }
1719   /* Check each successive cone */
1720   for (p = 1; p < numPoints; ++p) {
1721     PetscInt newMeetSize = 0;
1722 
1723     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
1724     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
1725     for (c = 0; c < dof; ++c) {
1726       const PetscInt point = mesh->cones[off+c];
1727 
1728       for (m = 0; m < meetSize; ++m) {
1729         if (point == meet[i][m]) {
1730           meet[1-i][newMeetSize++] = point;
1731           break;
1732         }
1733       }
1734     }
1735     meetSize = newMeetSize;
1736     i        = 1-i;
1737   }
1738   *numCoveringPoints = meetSize;
1739   *coveringPoints    = meet[i];
1740   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
1741   PetscFunctionReturn(0);
1742 }
1743 
1744 #undef __FUNCT__
1745 #define __FUNCT__ "DMPlexRestoreMeet"
1746 /*@C
1747   DMPlexRestoreMeet - Restore an array for the meet of the set of points
1748 
1749   Not Collective
1750 
1751   Input Parameters:
1752 + dm - The DMPlex object
1753 . numPoints - The number of input points for the meet
1754 - points - The input points
1755 
1756   Output Parameters:
1757 + numCoveredPoints - The number of points in the meet
1758 - coveredPoints - The points in the meet
1759 
1760   Level: intermediate
1761 
1762   Fortran Notes:
1763   Since it returns an array, this routine is only available in Fortran 90, and you must
1764   include petsc.h90 in your code.
1765 
1766   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1767 
1768 .keywords: mesh
1769 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
1770 @*/
1771 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1772 {
1773   PetscErrorCode ierr;
1774 
1775   PetscFunctionBegin;
1776   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1777   PetscValidPointer(coveredPoints, 4);
1778   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
1779   PetscFunctionReturn(0);
1780 }
1781 
1782 #undef __FUNCT__
1783 #define __FUNCT__ "DMPlexGetFullMeet"
1784 /*@C
1785   DMPlexGetFullMeet - Get an array for the meet of the set of points
1786 
1787   Not Collective
1788 
1789   Input Parameters:
1790 + dm - The DMPlex object
1791 . numPoints - The number of input points for the meet
1792 - points - The input points
1793 
1794   Output Parameters:
1795 + numCoveredPoints - The number of points in the meet
1796 - coveredPoints - The points in the meet
1797 
1798   Level: intermediate
1799 
1800   Fortran Notes:
1801   Since it returns an array, this routine is only available in Fortran 90, and you must
1802   include petsc.h90 in your code.
1803 
1804   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1805 
1806 .keywords: mesh
1807 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
1808 @*/
1809 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1810 {
1811   DM_Plex       *mesh = (DM_Plex*) dm->data;
1812   PetscInt      *offsets, **closures;
1813   PetscInt      *meet[2];
1814   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
1815   PetscInt       p, h, c, m;
1816   PetscErrorCode ierr;
1817 
1818   PetscFunctionBegin;
1819   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1820   PetscValidPointer(points, 2);
1821   PetscValidPointer(numCoveredPoints, 3);
1822   PetscValidPointer(coveredPoints, 4);
1823 
1824   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
1825   ierr    = PetscMalloc(numPoints * sizeof(PetscInt*), &closures);CHKERRQ(ierr);
1826   ierr    = DMGetWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1827   maxSize = PetscPowInt(mesh->maxConeSize,height+1);
1828   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
1829   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
1830 
1831   for (p = 0; p < numPoints; ++p) {
1832     PetscInt closureSize;
1833 
1834     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
1835 
1836     offsets[p*(height+2)+0] = 0;
1837     for (h = 0; h < height+1; ++h) {
1838       PetscInt pStart, pEnd, i;
1839 
1840       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
1841       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
1842         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
1843           offsets[p*(height+2)+h+1] = i;
1844           break;
1845         }
1846       }
1847       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
1848     }
1849     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);
1850   }
1851   for (h = 0; h < height+1; ++h) {
1852     PetscInt dof;
1853 
1854     /* Copy in cone of first point */
1855     dof = offsets[h+1] - offsets[h];
1856     for (meetSize = 0; meetSize < dof; ++meetSize) {
1857       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
1858     }
1859     /* Check each successive cone */
1860     for (p = 1; p < numPoints && meetSize; ++p) {
1861       PetscInt newMeetSize = 0;
1862 
1863       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
1864       for (c = 0; c < dof; ++c) {
1865         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
1866 
1867         for (m = 0; m < meetSize; ++m) {
1868           if (point == meet[i][m]) {
1869             meet[1-i][newMeetSize++] = point;
1870             break;
1871           }
1872         }
1873       }
1874       meetSize = newMeetSize;
1875       i        = 1-i;
1876     }
1877     if (meetSize) break;
1878   }
1879   *numCoveredPoints = meetSize;
1880   *coveredPoints    = meet[i];
1881   for (p = 0; p < numPoints; ++p) {
1882     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
1883   }
1884   ierr = PetscFree(closures);CHKERRQ(ierr);
1885   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1886   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
1887   PetscFunctionReturn(0);
1888 }
1889 
1890 #undef __FUNCT__
1891 #define __FUNCT__ "DMPlexGetNumFaceVertices"
1892 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
1893 {
1894   MPI_Comm       comm;
1895   PetscErrorCode ierr;
1896 
1897   PetscFunctionBegin;
1898   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
1899   PetscValidPointer(numFaceVertices,3);
1900   switch (cellDim) {
1901   case 0:
1902     *numFaceVertices = 0;
1903     break;
1904   case 1:
1905     *numFaceVertices = 1;
1906     break;
1907   case 2:
1908     switch (numCorners) {
1909     case 3: /* triangle */
1910       *numFaceVertices = 2; /* Edge has 2 vertices */
1911       break;
1912     case 4: /* quadrilateral */
1913       *numFaceVertices = 2; /* Edge has 2 vertices */
1914       break;
1915     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
1916       *numFaceVertices = 3; /* Edge has 3 vertices */
1917       break;
1918     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
1919       *numFaceVertices = 3; /* Edge has 3 vertices */
1920       break;
1921     default:
1922       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
1923     }
1924     break;
1925   case 3:
1926     switch (numCorners) {
1927     case 4: /* tetradehdron */
1928       *numFaceVertices = 3; /* Face has 3 vertices */
1929       break;
1930     case 6: /* tet cohesive cells */
1931       *numFaceVertices = 4; /* Face has 4 vertices */
1932       break;
1933     case 8: /* hexahedron */
1934       *numFaceVertices = 4; /* Face has 4 vertices */
1935       break;
1936     case 9: /* tet cohesive Lagrange cells */
1937       *numFaceVertices = 6; /* Face has 6 vertices */
1938       break;
1939     case 10: /* quadratic tetrahedron */
1940       *numFaceVertices = 6; /* Face has 6 vertices */
1941       break;
1942     case 12: /* hex cohesive Lagrange cells */
1943       *numFaceVertices = 6; /* Face has 6 vertices */
1944       break;
1945     case 18: /* quadratic tet cohesive Lagrange cells */
1946       *numFaceVertices = 6; /* Face has 6 vertices */
1947       break;
1948     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
1949       *numFaceVertices = 9; /* Face has 9 vertices */
1950       break;
1951     default:
1952       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
1953     }
1954     break;
1955   default:
1956     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %d", cellDim);
1957   }
1958   PetscFunctionReturn(0);
1959 }
1960 
1961 #undef __FUNCT__
1962 #define __FUNCT__ "DMPlexOrient"
1963 /* Trys to give the mesh a consistent orientation */
1964 PetscErrorCode DMPlexOrient(DM dm)
1965 {
1966   PetscBT        seenCells, flippedCells, seenFaces;
1967   PetscInt      *faceFIFO, fTop, fBottom;
1968   PetscInt       dim, h, cStart, cEnd, c, fStart, fEnd, face, maxConeSize, *revcone, *revconeO;
1969   PetscErrorCode ierr;
1970 
1971   PetscFunctionBegin;
1972   /* Truth Table
1973      mismatch    flips   do action   mismatch   flipA ^ flipB   action
1974          F       0 flips     no         F             F           F
1975          F       1 flip      yes        F             T           T
1976          F       2 flips     no         T             F           T
1977          T       0 flips     yes        T             T           F
1978          T       1 flip      no
1979          T       2 flips     yes
1980   */
1981   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1982   ierr = DMPlexGetVTKCellHeight(dm, &h);CHKERRQ(ierr);
1983   ierr = DMPlexGetHeightStratum(dm, h,   &cStart, &cEnd);CHKERRQ(ierr);
1984   ierr = DMPlexGetHeightStratum(dm, h+1, &fStart, &fEnd);CHKERRQ(ierr);
1985   ierr = PetscBTCreate(cEnd - cStart, &seenCells);CHKERRQ(ierr);
1986   ierr = PetscBTMemzero(cEnd - cStart, seenCells);CHKERRQ(ierr);
1987   ierr = PetscBTCreate(cEnd - cStart, &flippedCells);CHKERRQ(ierr);
1988   ierr = PetscBTMemzero(cEnd - cStart, flippedCells);CHKERRQ(ierr);
1989   ierr = PetscBTCreate(fEnd - fStart, &seenFaces);CHKERRQ(ierr);
1990   ierr = PetscBTMemzero(fEnd - fStart, seenFaces);CHKERRQ(ierr);
1991   ierr = PetscMalloc((fEnd - fStart) * sizeof(PetscInt), &faceFIFO);CHKERRQ(ierr);
1992   fTop = fBottom = 0;
1993   /* Initialize FIFO with first cell */
1994   if (cEnd > cStart) {
1995     const PetscInt *cone;
1996     PetscInt        coneSize;
1997 
1998     ierr = DMPlexGetConeSize(dm, cStart, &coneSize);CHKERRQ(ierr);
1999     ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr);
2000     for (c = 0; c < coneSize; ++c) {
2001       faceFIFO[fBottom++] = cone[c];
2002       ierr = PetscBTSet(seenFaces, cone[c]-fStart);CHKERRQ(ierr);
2003     }
2004   }
2005   /* Consider each face in FIFO */
2006   while (fTop < fBottom) {
2007     const PetscInt *support, *coneA, *coneB, *coneOA, *coneOB;
2008     PetscInt        supportSize, coneSizeA, coneSizeB, posA = -1, posB = -1;
2009     PetscInt        seenA, flippedA, seenB, flippedB, mismatch;
2010 
2011     face = faceFIFO[fTop++];
2012     ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2013     ierr = DMPlexGetSupport(dm, face, &support);CHKERRQ(ierr);
2014     if (supportSize < 2) continue;
2015     if (supportSize != 2) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Faces should separate only two cells, not %d", supportSize);
2016     seenA    = PetscBTLookup(seenCells,    support[0]-cStart);
2017     flippedA = PetscBTLookup(flippedCells, support[0]-cStart) ? 1 : 0;
2018     seenB    = PetscBTLookup(seenCells,    support[1]-cStart);
2019     flippedB = PetscBTLookup(flippedCells, support[1]-cStart) ? 1 : 0;
2020 
2021     ierr = DMPlexGetConeSize(dm, support[0], &coneSizeA);CHKERRQ(ierr);
2022     ierr = DMPlexGetConeSize(dm, support[1], &coneSizeB);CHKERRQ(ierr);
2023     ierr = DMPlexGetCone(dm, support[0], &coneA);CHKERRQ(ierr);
2024     ierr = DMPlexGetCone(dm, support[1], &coneB);CHKERRQ(ierr);
2025     ierr = DMPlexGetConeOrientation(dm, support[0], &coneOA);CHKERRQ(ierr);
2026     ierr = DMPlexGetConeOrientation(dm, support[1], &coneOB);CHKERRQ(ierr);
2027     for (c = 0; c < coneSizeA; ++c) {
2028       if (!PetscBTLookup(seenFaces, coneA[c]-fStart)) {
2029         faceFIFO[fBottom++] = coneA[c];
2030         ierr = PetscBTSet(seenFaces, coneA[c]-fStart);CHKERRQ(ierr);
2031       }
2032       if (coneA[c] == face) posA = c;
2033       if (fBottom > fEnd-fStart) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Face %d was pushed exceeding capacity %d > %d", coneA[c], fBottom, fEnd-fStart);
2034     }
2035     if (posA < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d could not be located in cell %d", face, support[0]);
2036     for (c = 0; c < coneSizeB; ++c) {
2037       if (!PetscBTLookup(seenFaces, coneB[c]-fStart)) {
2038         faceFIFO[fBottom++] = coneB[c];
2039         ierr = PetscBTSet(seenFaces, coneB[c]-fStart);CHKERRQ(ierr);
2040       }
2041       if (coneB[c] == face) posB = c;
2042       if (fBottom > fEnd-fStart) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Face %d was pushed exceeding capacity %d > %d", coneA[c], fBottom, fEnd-fStart);
2043     }
2044     if (posB < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d could not be located in cell %d", face, support[1]);
2045 
2046     if (dim == 1) {
2047       mismatch = posA == posB;
2048     } else {
2049       mismatch = coneOA[posA] == coneOB[posB];
2050     }
2051 
2052     if (mismatch ^ (flippedA ^ flippedB)) {
2053       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]);
2054       if (!seenA && !flippedA) {
2055         ierr = PetscBTSet(flippedCells, support[0]-cStart);CHKERRQ(ierr);
2056       } else if (!seenB && !flippedB) {
2057         ierr = PetscBTSet(flippedCells, support[1]-cStart);CHKERRQ(ierr);
2058       } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Inconsistent mesh orientation: Fault mesh is non-orientable");
2059     } else if (mismatch && flippedA && flippedB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Attempt to flip already flipped cell: Fault mesh is non-orientable");
2060     ierr = PetscBTSet(seenCells, support[0]-cStart);CHKERRQ(ierr);
2061     ierr = PetscBTSet(seenCells, support[1]-cStart);CHKERRQ(ierr);
2062   }
2063 
2064   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2065   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2066   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2067   for (c = cStart; c < cEnd; ++c) {
2068     const PetscInt *cone, *coneO, *support;
2069     PetscInt        coneSize, supportSize, faceSize, cp, sp;
2070 
2071     if (!PetscBTLookup(flippedCells, c-cStart)) continue;
2072     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
2073     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
2074     ierr = DMPlexGetConeOrientation(dm, c, &coneO);CHKERRQ(ierr);
2075     for (cp = 0; cp < coneSize; ++cp) {
2076       const PetscInt rcp = coneSize-cp-1;
2077 
2078       ierr = DMPlexGetConeSize(dm, cone[rcp], &faceSize);CHKERRQ(ierr);
2079       revcone[cp]  = cone[rcp];
2080       revconeO[cp] = coneO[rcp] >= 0 ? -(faceSize-coneO[rcp]) : faceSize+coneO[rcp];
2081     }
2082     ierr = DMPlexSetCone(dm, c, revcone);CHKERRQ(ierr);
2083     ierr = DMPlexSetConeOrientation(dm, c, revconeO);CHKERRQ(ierr);
2084     /* Reverse orientations of support */
2085     faceSize = coneSize;
2086     ierr = DMPlexGetSupportSize(dm, c, &supportSize);CHKERRQ(ierr);
2087     ierr = DMPlexGetSupport(dm, c, &support);CHKERRQ(ierr);
2088     for (sp = 0; sp < supportSize; ++sp) {
2089       ierr = DMPlexGetConeSize(dm, support[sp], &coneSize);CHKERRQ(ierr);
2090       ierr = DMPlexGetCone(dm, support[sp], &cone);CHKERRQ(ierr);
2091       ierr = DMPlexGetConeOrientation(dm, support[sp], &coneO);CHKERRQ(ierr);
2092       for (cp = 0; cp < coneSize; ++cp) {
2093         if (cone[cp] != c) continue;
2094         ierr = DMPlexInsertConeOrientation(dm, support[sp], cp, coneO[cp] >= 0 ? -(faceSize-coneO[cp]) : faceSize+coneO[cp]);CHKERRQ(ierr);
2095       }
2096     }
2097   }
2098   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2099   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2100   ierr = PetscBTDestroy(&seenCells);CHKERRQ(ierr);
2101   ierr = PetscBTDestroy(&flippedCells);CHKERRQ(ierr);
2102   ierr = PetscBTDestroy(&seenFaces);CHKERRQ(ierr);
2103   ierr = PetscFree(faceFIFO);CHKERRQ(ierr);
2104   PetscFunctionReturn(0);
2105 }
2106 
2107 #undef __FUNCT__
2108 #define __FUNCT__ "DMPlexGetAdjacencySingleLevel_Internal"
2109 static PetscErrorCode DMPlexGetAdjacencySingleLevel_Internal(DM dm, PetscInt p, PetscBool useClosure, const PetscInt *tmpClosure, PetscInt *adjSize, PetscInt adj[])
2110 {
2111   const PetscInt *support = NULL;
2112   PetscInt        numAdj   = 0, maxAdjSize = *adjSize, supportSize, s;
2113   PetscErrorCode  ierr;
2114 
2115   PetscFunctionBegin;
2116   if (useClosure) {
2117     ierr = DMPlexGetConeSize(dm, p, &supportSize);CHKERRQ(ierr);
2118     ierr = DMPlexGetCone(dm, p, &support);CHKERRQ(ierr);
2119     for (s = 0; s < supportSize; ++s) {
2120       const PetscInt *cone = NULL;
2121       PetscInt        coneSize, c, q;
2122 
2123       ierr = DMPlexGetSupportSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2124       ierr = DMPlexGetSupport(dm, support[s], &cone);CHKERRQ(ierr);
2125       for (c = 0; c < coneSize; ++c) {
2126         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2127           if (cone[c] == adj[q]) break;
2128         }
2129         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2130       }
2131     }
2132   } else {
2133     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2134     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
2135     for (s = 0; s < supportSize; ++s) {
2136       const PetscInt *cone = NULL;
2137       PetscInt        coneSize, c, q;
2138 
2139       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2140       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
2141       for (c = 0; c < coneSize; ++c) {
2142         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2143           if (cone[c] == adj[q]) break;
2144         }
2145         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2146       }
2147     }
2148   }
2149   *adjSize = numAdj;
2150   PetscFunctionReturn(0);
2151 }
2152 
2153 #undef __FUNCT__
2154 #define __FUNCT__ "DMPlexCreateNeighborCSR"
2155 PetscErrorCode DMPlexCreateNeighborCSR(DM dm, PetscInt cellHeight, PetscInt *numVertices, PetscInt **offsets, PetscInt **adjacency)
2156 {
2157   const PetscInt maxFaceCases = 30;
2158   PetscInt       numFaceCases = 0;
2159   PetscInt       numFaceVertices[30]; /* maxFaceCases, C89 sucks sucks sucks */
2160   PetscInt      *off, *adj;
2161   PetscInt      *neighborCells, *tmpClosure;
2162   PetscInt       maxConeSize, maxSupportSize, maxClosure, maxNeighbors;
2163   PetscInt       dim, cellDim, depth = 0, faceDepth, cStart, cEnd, c, numCells, cell;
2164   PetscErrorCode ierr;
2165 
2166   PetscFunctionBegin;
2167   /* For parallel partitioning, I think you have to communicate supports */
2168   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2169   cellDim = dim - cellHeight;
2170   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2171   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2172   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
2173   if (cEnd - cStart == 0) {
2174     if (numVertices) *numVertices = 0;
2175     if (offsets)   *offsets   = NULL;
2176     if (adjacency) *adjacency = NULL;
2177     PetscFunctionReturn(0);
2178   }
2179   numCells  = cEnd - cStart;
2180   faceDepth = depth - cellHeight;
2181   /* Setup face recognition */
2182   if (faceDepth == 1) {
2183     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 */
2184 
2185     for (c = cStart; c < cEnd; ++c) {
2186       PetscInt corners;
2187 
2188       ierr = DMPlexGetConeSize(dm, c, &corners);CHKERRQ(ierr);
2189       if (!cornersSeen[corners]) {
2190         PetscInt nFV;
2191 
2192         if (numFaceCases >= maxFaceCases) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Exceeded maximum number of face recognition cases");
2193         cornersSeen[corners] = 1;
2194 
2195         ierr = DMPlexGetNumFaceVertices(dm, cellDim, corners, &nFV);CHKERRQ(ierr);
2196 
2197         numFaceVertices[numFaceCases++] = nFV;
2198       }
2199     }
2200   }
2201   maxClosure   = 2*PetscMax(PetscPowInt(maxConeSize,depth+1),PetscPowInt(maxSupportSize,depth+1));
2202   maxNeighbors = PetscPowInt(maxConeSize,depth+1)*PetscPowInt(maxSupportSize,depth+1);
2203   ierr         = PetscMalloc2(maxNeighbors,PetscInt,&neighborCells,maxClosure,PetscInt,&tmpClosure);CHKERRQ(ierr);
2204   ierr         = PetscMalloc((numCells+1) * sizeof(PetscInt), &off);CHKERRQ(ierr);
2205   ierr         = PetscMemzero(off, (numCells+1) * sizeof(PetscInt));CHKERRQ(ierr);
2206   /* Count neighboring cells */
2207   for (cell = cStart; cell < cEnd; ++cell) {
2208     PetscInt numNeighbors = maxNeighbors, n;
2209 
2210     ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2211     /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2212     for (n = 0; n < numNeighbors; ++n) {
2213       PetscInt        cellPair[2];
2214       PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2215       PetscInt        meetSize = 0;
2216       const PetscInt *meet    = NULL;
2217 
2218       cellPair[0] = cell; cellPair[1] = neighborCells[n];
2219       if (cellPair[0] == cellPair[1]) continue;
2220       if (!found) {
2221         ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2222         if (meetSize) {
2223           PetscInt f;
2224 
2225           for (f = 0; f < numFaceCases; ++f) {
2226             if (numFaceVertices[f] == meetSize) {
2227               found = PETSC_TRUE;
2228               break;
2229             }
2230           }
2231         }
2232         ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2233       }
2234       if (found) ++off[cell-cStart+1];
2235     }
2236   }
2237   /* Prefix sum */
2238   for (cell = 1; cell <= numCells; ++cell) off[cell] += off[cell-1];
2239 
2240   if (adjacency) {
2241     ierr = PetscMalloc(off[numCells] * sizeof(PetscInt), &adj);CHKERRQ(ierr);
2242     /* Get neighboring cells */
2243     for (cell = cStart; cell < cEnd; ++cell) {
2244       PetscInt numNeighbors = maxNeighbors, n;
2245       PetscInt cellOffset   = 0;
2246 
2247       ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2248       /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2249       for (n = 0; n < numNeighbors; ++n) {
2250         PetscInt        cellPair[2];
2251         PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2252         PetscInt        meetSize = 0;
2253         const PetscInt *meet    = NULL;
2254 
2255         cellPair[0] = cell; cellPair[1] = neighborCells[n];
2256         if (cellPair[0] == cellPair[1]) continue;
2257         if (!found) {
2258           ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2259           if (meetSize) {
2260             PetscInt f;
2261 
2262             for (f = 0; f < numFaceCases; ++f) {
2263               if (numFaceVertices[f] == meetSize) {
2264                 found = PETSC_TRUE;
2265                 break;
2266               }
2267             }
2268           }
2269           ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2270         }
2271         if (found) {
2272           adj[off[cell-cStart]+cellOffset] = neighborCells[n];
2273           ++cellOffset;
2274         }
2275       }
2276     }
2277   }
2278   ierr = PetscFree2(neighborCells,tmpClosure);CHKERRQ(ierr);
2279   if (numVertices) *numVertices = numCells;
2280   if (offsets)   *offsets   = off;
2281   if (adjacency) *adjacency = adj;
2282   PetscFunctionReturn(0);
2283 }
2284 
2285 #if defined(PETSC_HAVE_CHACO)
2286 #if defined(PETSC_HAVE_UNISTD_H)
2287 #include <unistd.h>
2288 #endif
2289 /* Chaco does not have an include file */
2290 PETSC_EXTERN int interface(int nvtxs, int *start, int *adjacency, int *vwgts,
2291                        float *ewgts, float *x, float *y, float *z, char *outassignname,
2292                        char *outfilename, short *assignment, int architecture, int ndims_tot,
2293                        int mesh_dims[3], double *goal, int global_method, int local_method,
2294                        int rqi_flag, int vmax, int ndims, double eigtol, long seed);
2295 
2296 extern int FREE_GRAPH;
2297 
2298 #undef __FUNCT__
2299 #define __FUNCT__ "DMPlexPartition_Chaco"
2300 PetscErrorCode DMPlexPartition_Chaco(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2301 {
2302   enum {DEFAULT_METHOD = 1, INERTIAL_METHOD = 3};
2303   MPI_Comm       comm;
2304   int            nvtxs          = numVertices; /* number of vertices in full graph */
2305   int           *vwgts          = NULL;   /* weights for all vertices */
2306   float         *ewgts          = NULL;   /* weights for all edges */
2307   float         *x              = NULL, *y = NULL, *z = NULL; /* coordinates for inertial method */
2308   char          *outassignname  = NULL;   /*  name of assignment output file */
2309   char          *outfilename    = NULL;   /* output file name */
2310   int            architecture   = 1;      /* 0 => hypercube, d => d-dimensional mesh */
2311   int            ndims_tot      = 0;      /* total number of cube dimensions to divide */
2312   int            mesh_dims[3];            /* dimensions of mesh of processors */
2313   double        *goal          = NULL;    /* desired set sizes for each set */
2314   int            global_method = 1;       /* global partitioning algorithm */
2315   int            local_method  = 1;       /* local partitioning algorithm */
2316   int            rqi_flag      = 0;       /* should I use RQI/Symmlq eigensolver? */
2317   int            vmax          = 200;     /* how many vertices to coarsen down to? */
2318   int            ndims         = 1;       /* number of eigenvectors (2^d sets) */
2319   double         eigtol        = 0.001;   /* tolerance on eigenvectors */
2320   long           seed          = 123636512; /* for random graph mutations */
2321   short int     *assignment;              /* Output partition */
2322   int            fd_stdout, fd_pipe[2];
2323   PetscInt      *points;
2324   PetscMPIInt    commSize;
2325   int            i, v, p;
2326   PetscErrorCode ierr;
2327 
2328   PetscFunctionBegin;
2329   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2330   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2331   if (!numVertices) {
2332     ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2333     ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2334     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2335     ierr = ISCreateGeneral(comm, 0, NULL, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2336     PetscFunctionReturn(0);
2337   }
2338   FREE_GRAPH = 0;                         /* Do not let Chaco free my memory */
2339   for (i = 0; i < start[numVertices]; ++i) ++adjacency[i];
2340 
2341   if (global_method == INERTIAL_METHOD) {
2342     /* manager.createCellCoordinates(nvtxs, &x, &y, &z); */
2343     SETERRQ(comm, PETSC_ERR_SUP, "Inertial partitioning not yet supported");
2344   }
2345   mesh_dims[0] = commSize;
2346   mesh_dims[1] = 1;
2347   mesh_dims[2] = 1;
2348   ierr = PetscMalloc(nvtxs * sizeof(short int), &assignment);CHKERRQ(ierr);
2349   /* Chaco outputs to stdout. We redirect this to a buffer. */
2350   /* TODO: check error codes for UNIX calls */
2351 #if defined(PETSC_HAVE_UNISTD_H)
2352   {
2353     int piperet;
2354     piperet = pipe(fd_pipe);
2355     if (piperet) SETERRQ(comm,PETSC_ERR_SYS,"Could not create pipe");
2356     fd_stdout = dup(1);
2357     close(1);
2358     dup2(fd_pipe[1], 1);
2359   }
2360 #endif
2361   ierr = interface(nvtxs, (int*) start, (int*) adjacency, vwgts, ewgts, x, y, z, outassignname, outfilename,
2362                    assignment, architecture, ndims_tot, mesh_dims, goal, global_method, local_method, rqi_flag,
2363                    vmax, ndims, eigtol, seed);
2364 #if defined(PETSC_HAVE_UNISTD_H)
2365   {
2366     char msgLog[10000];
2367     int  count;
2368 
2369     fflush(stdout);
2370     count = read(fd_pipe[0], msgLog, (10000-1)*sizeof(char));
2371     if (count < 0) count = 0;
2372     msgLog[count] = 0;
2373     close(1);
2374     dup2(fd_stdout, 1);
2375     close(fd_stdout);
2376     close(fd_pipe[0]);
2377     close(fd_pipe[1]);
2378     if (ierr) SETERRQ1(comm, PETSC_ERR_LIB, "Error in Chaco library: %s", msgLog);
2379   }
2380 #endif
2381   /* Convert to PetscSection+IS */
2382   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2383   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2384   for (v = 0; v < nvtxs; ++v) {
2385     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2386   }
2387   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2388   ierr = PetscMalloc(nvtxs * sizeof(PetscInt), &points);CHKERRQ(ierr);
2389   for (p = 0, i = 0; p < commSize; ++p) {
2390     for (v = 0; v < nvtxs; ++v) {
2391       if (assignment[v] == p) points[i++] = v;
2392     }
2393   }
2394   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2395   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2396   if (global_method == INERTIAL_METHOD) {
2397     /* manager.destroyCellCoordinates(nvtxs, &x, &y, &z); */
2398   }
2399   ierr = PetscFree(assignment);CHKERRQ(ierr);
2400   for (i = 0; i < start[numVertices]; ++i) --adjacency[i];
2401   PetscFunctionReturn(0);
2402 }
2403 #endif
2404 
2405 #if defined(PETSC_HAVE_PARMETIS)
2406 #include <parmetis.h>
2407 
2408 #undef __FUNCT__
2409 #define __FUNCT__ "DMPlexPartition_ParMetis"
2410 PetscErrorCode DMPlexPartition_ParMetis(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2411 {
2412   MPI_Comm       comm;
2413   PetscInt       nvtxs      = numVertices; // The number of vertices in full graph
2414   PetscInt      *vtxdist;                  // Distribution of vertices across processes
2415   PetscInt      *xadj       = start;       // Start of edge list for each vertex
2416   PetscInt      *adjncy     = adjacency;   // Edge lists for all vertices
2417   PetscInt      *vwgt       = NULL;        // Vertex weights
2418   PetscInt      *adjwgt     = NULL;        // Edge weights
2419   PetscInt       wgtflag    = 0;           // Indicates which weights are present
2420   PetscInt       numflag    = 0;           // Indicates initial offset (0 or 1)
2421   PetscInt       ncon       = 1;           // The number of weights per vertex
2422   PetscInt       nparts;                   // The number of partitions
2423   PetscReal     *tpwgts;                   // The fraction of vertex weights assigned to each partition
2424   PetscReal     *ubvec;                    // The balance intolerance for vertex weights
2425   PetscInt       options[5];               // Options
2426   // Outputs
2427   PetscInt       edgeCut;                  // The number of edges cut by the partition
2428   PetscInt      *assignment, *points;
2429   PetscMPIInt    commSize, rank, p, v, i;
2430   PetscErrorCode ierr;
2431 
2432   PetscFunctionBegin;
2433   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
2434   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2435   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2436   nparts = commSize;
2437   options[0] = 0; /* Use all defaults */
2438   /* Calculate vertex distribution */
2439   ierr = PetscMalloc4(nparts+1,PetscInt,&vtxdist,nparts*ncon,PetscReal,&tpwgts,ncon,PetscReal,&ubvec,nvtxs,PetscInt,&assignment);CHKERRQ(ierr);
2440   vtxdist[0] = 0;
2441   ierr = MPI_Allgather(&nvtxs, 1, MPIU_INT, &vtxdist[1], 1, MPIU_INT, comm);CHKERRQ(ierr);
2442   for (p = 2; p <= nparts; ++p) {
2443     vtxdist[p] += vtxdist[p-1];
2444   }
2445   /* Calculate weights */
2446   for (p = 0; p < nparts; ++p) {
2447     tpwgts[p] = 1.0/nparts;
2448   }
2449   ubvec[0] = 1.05;
2450 
2451   if (nparts == 1) {
2452     ierr = PetscMemzero(assignment, nvtxs * sizeof(PetscInt));
2453   } else {
2454     if (vtxdist[1] == vtxdist[nparts]) {
2455       if (!rank) {
2456         PetscStackPush("METIS_PartGraphKway");
2457         ierr = METIS_PartGraphKway(&nvtxs, &ncon, xadj, adjncy, vwgt, NULL, adjwgt, &nparts, tpwgts, ubvec, NULL, &edgeCut, assignment);
2458         PetscStackPop;
2459         if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in METIS_PartGraphKway()");
2460       }
2461     } else {
2462       PetscStackPush("ParMETIS_V3_PartKway");
2463       ierr = ParMETIS_V3_PartKway(vtxdist, xadj, adjncy, vwgt, adjwgt, &wgtflag, &numflag, &ncon, &nparts, tpwgts, ubvec, options, &edgeCut, assignment, &comm);
2464       PetscStackPop;
2465       if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in ParMETIS_V3_PartKway()");
2466     }
2467   }
2468   /* Convert to PetscSection+IS */
2469   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2470   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2471   for (v = 0; v < nvtxs; ++v) {
2472     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2473   }
2474   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2475   ierr = PetscMalloc(nvtxs * sizeof(PetscInt), &points);CHKERRQ(ierr);
2476   for (p = 0, i = 0; p < commSize; ++p) {
2477     for (v = 0; v < nvtxs; ++v) {
2478       if (assignment[v] == p) points[i++] = v;
2479     }
2480   }
2481   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2482   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2483   ierr = PetscFree4(vtxdist,tpwgts,ubvec,assignment);CHKERRQ(ierr);
2484   PetscFunctionReturn(0);
2485 }
2486 #endif
2487 
2488 #undef __FUNCT__
2489 #define __FUNCT__ "DMPlexEnlargePartition"
2490 /* Expand the partition by BFS on the adjacency graph */
2491 PetscErrorCode DMPlexEnlargePartition(DM dm, const PetscInt start[], const PetscInt adjacency[], PetscSection origPartSection, IS origPartition, PetscSection *partSection, IS *partition)
2492 {
2493   PetscHashI      h;
2494   const PetscInt *points;
2495   PetscInt      **tmpPoints, *newPoints, totPoints = 0;
2496   PetscInt        pStart, pEnd, part, q;
2497   PetscErrorCode  ierr;
2498 
2499   PetscFunctionBegin;
2500   PetscHashICreate(h);
2501   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2502   ierr = PetscSectionGetChart(origPartSection, &pStart, &pEnd);CHKERRQ(ierr);
2503   ierr = PetscSectionSetChart(*partSection, pStart, pEnd);CHKERRQ(ierr);
2504   ierr = ISGetIndices(origPartition, &points);CHKERRQ(ierr);
2505   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt*), &tmpPoints);CHKERRQ(ierr);
2506   for (part = pStart; part < pEnd; ++part) {
2507     PetscInt numPoints, nP, numNewPoints, off, p, n = 0;
2508 
2509     PetscHashIClear(h);
2510     ierr = PetscSectionGetDof(origPartSection, part, &numPoints);CHKERRQ(ierr);
2511     ierr = PetscSectionGetOffset(origPartSection, part, &off);CHKERRQ(ierr);
2512     /* Add all existing points to h */
2513     for (p = 0; p < numPoints; ++p) {
2514       const PetscInt point = points[off+p];
2515       PetscHashIAdd(h, point, 1);
2516     }
2517     PetscHashISize(h, nP);
2518     if (nP != numPoints) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid partition has %d points, but only %d were unique", numPoints, nP);
2519     /* Add all points in next BFS level */
2520     /*   TODO We are brute forcing here, but could check the adjacency size to find the boundary */
2521     for (p = 0; p < numPoints; ++p) {
2522       const PetscInt point = points[off+p];
2523       PetscInt       s     = start[point], e = start[point+1], a;
2524 
2525       for (a = s; a < e; ++a) PetscHashIAdd(h, adjacency[a], 1);
2526     }
2527     PetscHashISize(h, numNewPoints);
2528     ierr = PetscSectionSetDof(*partSection, part, numNewPoints);CHKERRQ(ierr);
2529     ierr = PetscMalloc(numNewPoints * sizeof(PetscInt), &tmpPoints[part]);CHKERRQ(ierr);
2530     if (numNewPoints) PetscHashIGetKeys(h, n, tmpPoints[part]); /* Should not need this conditional */
2531     totPoints += numNewPoints;
2532   }
2533   ierr = ISRestoreIndices(origPartition, &points);CHKERRQ(ierr);
2534   PetscHashIDestroy(h);
2535   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2536   ierr = PetscMalloc(totPoints * sizeof(PetscInt), &newPoints);CHKERRQ(ierr);
2537   for (part = pStart, q = 0; part < pEnd; ++part) {
2538     PetscInt numPoints, p;
2539 
2540     ierr = PetscSectionGetDof(*partSection, part, &numPoints);CHKERRQ(ierr);
2541     for (p = 0; p < numPoints; ++p, ++q) newPoints[q] = tmpPoints[part][p];
2542     ierr = PetscFree(tmpPoints[part]);CHKERRQ(ierr);
2543   }
2544   ierr = PetscFree(tmpPoints);CHKERRQ(ierr);
2545   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), totPoints, newPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2546   PetscFunctionReturn(0);
2547 }
2548 
2549 #undef __FUNCT__
2550 #define __FUNCT__ "DMPlexCreatePartition"
2551 /*
2552   DMPlexCreatePartition - Create a non-overlapping partition of the points at the given height
2553 
2554   Collective on DM
2555 
2556   Input Parameters:
2557   + dm - The DM
2558   . height - The height for points in the partition
2559   - enlarge - Expand each partition with neighbors
2560 
2561   Output Parameters:
2562   + partSection - The PetscSection giving the division of points by partition
2563   . partition - The list of points by partition
2564   . origPartSection - If enlarge is true, the PetscSection giving the division of points before enlarging by partition, otherwise NULL
2565   - origPartition - If enlarge is true, the list of points before enlarging by partition, otherwise NULL
2566 
2567   Level: developer
2568 
2569 .seealso DMPlexDistribute()
2570 */
2571 PetscErrorCode DMPlexCreatePartition(DM dm, const char name[], PetscInt height, PetscBool enlarge, PetscSection *partSection, IS *partition, PetscSection *origPartSection, IS *origPartition)
2572 {
2573   char           partname[1024];
2574   PetscBool      isChaco = PETSC_FALSE, isMetis = PETSC_FALSE, flg;
2575   PetscMPIInt    size;
2576   PetscErrorCode ierr;
2577 
2578   PetscFunctionBegin;
2579   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
2580 
2581   *origPartSection = NULL;
2582   *origPartition   = NULL;
2583   if (size == 1) {
2584     PetscInt *points;
2585     PetscInt  cStart, cEnd, c;
2586 
2587     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2588     ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2589     ierr = PetscSectionSetChart(*partSection, 0, size);CHKERRQ(ierr);
2590     ierr = PetscSectionSetDof(*partSection, 0, cEnd-cStart);CHKERRQ(ierr);
2591     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2592     ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscInt), &points);CHKERRQ(ierr);
2593     for (c = cStart; c < cEnd; ++c) points[c] = c;
2594     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), cEnd-cStart, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2595     PetscFunctionReturn(0);
2596   }
2597   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_partitioner", partname, 1024, &flg);CHKERRQ(ierr);
2598   if (flg) name = partname;
2599   if (name) {
2600     ierr = PetscStrcmp(name, "chaco", &isChaco);CHKERRQ(ierr);
2601     ierr = PetscStrcmp(name, "metis", &isMetis);CHKERRQ(ierr);
2602   }
2603   if (height == 0) {
2604     PetscInt  numVertices;
2605     PetscInt *start     = NULL;
2606     PetscInt *adjacency = NULL;
2607 
2608     ierr = DMPlexCreateNeighborCSR(dm, 0, &numVertices, &start, &adjacency);CHKERRQ(ierr);
2609     if (!name || isChaco) {
2610 #if defined(PETSC_HAVE_CHACO)
2611       ierr = DMPlexPartition_Chaco(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2612 #else
2613       SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Mesh partitioning needs external package support.\nPlease reconfigure with --download-chaco.");
2614 #endif
2615     } else if (isMetis) {
2616 #if defined(PETSC_HAVE_PARMETIS)
2617       ierr = DMPlexPartition_ParMetis(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2618 #endif
2619     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Unknown mesh partitioning package %s", name);
2620     if (enlarge) {
2621       *origPartSection = *partSection;
2622       *origPartition   = *partition;
2623 
2624       ierr = DMPlexEnlargePartition(dm, start, adjacency, *origPartSection, *origPartition, partSection, partition);CHKERRQ(ierr);
2625     }
2626     ierr = PetscFree(start);CHKERRQ(ierr);
2627     ierr = PetscFree(adjacency);CHKERRQ(ierr);
2628 # if 0
2629   } else if (height == 1) {
2630     /* Build the dual graph for faces and partition the hypergraph */
2631     PetscInt numEdges;
2632 
2633     buildFaceCSRV(mesh, mesh->getFactory()->getNumbering(mesh, mesh->depth()-1), &numEdges, &start, &adjacency, GraphPartitioner::zeroBase());
2634     GraphPartitioner().partition(numEdges, start, adjacency, partition, manager);
2635     destroyCSR(numEdges, start, adjacency);
2636 #endif
2637   } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid partition height %D", height);
2638   PetscFunctionReturn(0);
2639 }
2640 
2641 #undef __FUNCT__
2642 #define __FUNCT__ "DMPlexCreatePartitionClosure"
2643 PetscErrorCode DMPlexCreatePartitionClosure(DM dm, PetscSection pointSection, IS pointPartition, PetscSection *section, IS *partition)
2644 {
2645   /* const PetscInt  height = 0; */
2646   const PetscInt *partArray;
2647   PetscInt       *allPoints, *packPoints;
2648   PetscInt        rStart, rEnd, rank, pStart, pEnd, newSize;
2649   PetscErrorCode  ierr;
2650   PetscBT         bt;
2651   PetscSegBuffer  segpack,segpart;
2652 
2653   PetscFunctionBegin;
2654   ierr = PetscSectionGetChart(pointSection, &rStart, &rEnd);CHKERRQ(ierr);
2655   ierr = ISGetIndices(pointPartition, &partArray);CHKERRQ(ierr);
2656   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2657   ierr = PetscSectionSetChart(*section, rStart, rEnd);CHKERRQ(ierr);
2658   ierr = DMPlexGetChart(dm,&pStart,&pEnd);CHKERRQ(ierr);
2659   ierr = PetscBTCreate(pEnd-pStart,&bt);CHKERRQ(ierr);
2660   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpack);CHKERRQ(ierr);
2661   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpart);CHKERRQ(ierr);
2662   for (rank = rStart; rank < rEnd; ++rank) {
2663     PetscInt partSize = 0, numPoints, offset, p, *PETSC_RESTRICT placePoints;
2664 
2665     ierr = PetscSectionGetDof(pointSection, rank, &numPoints);CHKERRQ(ierr);
2666     ierr = PetscSectionGetOffset(pointSection, rank, &offset);CHKERRQ(ierr);
2667     for (p = 0; p < numPoints; ++p) {
2668       PetscInt  point   = partArray[offset+p], closureSize, c;
2669       PetscInt *closure = NULL;
2670 
2671       /* TODO Include support for height > 0 case */
2672       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2673       for (c=0; c<closureSize; c++) {
2674         PetscInt cpoint = closure[c*2];
2675         if (!PetscBTLookupSet(bt,cpoint-pStart)) {
2676           PetscInt *PETSC_RESTRICT pt;
2677           partSize++;
2678           ierr = PetscSegBufferGetInts(segpart,1,&pt);CHKERRQ(ierr);
2679           *pt = cpoint;
2680         }
2681       }
2682       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2683     }
2684     ierr = PetscSectionSetDof(*section, rank, partSize);CHKERRQ(ierr);
2685     ierr = PetscSegBufferGetInts(segpack,partSize,&placePoints);CHKERRQ(ierr);
2686     ierr = PetscSegBufferExtractTo(segpart,placePoints);CHKERRQ(ierr);
2687     ierr = PetscSortInt(partSize,placePoints);CHKERRQ(ierr);
2688     for (p=0; p<partSize; p++) {ierr = PetscBTClear(bt,placePoints[p]-pStart);CHKERRQ(ierr);}
2689   }
2690   ierr = PetscBTDestroy(&bt);CHKERRQ(ierr);
2691   ierr = PetscSegBufferDestroy(&segpart);CHKERRQ(ierr);
2692 
2693   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
2694   ierr = PetscSectionGetStorageSize(*section, &newSize);CHKERRQ(ierr);
2695   ierr = PetscMalloc(newSize * sizeof(PetscInt), &allPoints);CHKERRQ(ierr);
2696 
2697   ierr = PetscSegBufferExtractInPlace(segpack,&packPoints);CHKERRQ(ierr);
2698   for (rank = rStart; rank < rEnd; ++rank) {
2699     PetscInt numPoints, offset;
2700 
2701     ierr = PetscSectionGetDof(*section, rank, &numPoints);CHKERRQ(ierr);
2702     ierr = PetscSectionGetOffset(*section, rank, &offset);CHKERRQ(ierr);
2703     ierr = PetscMemcpy(&allPoints[offset], packPoints, numPoints * sizeof(PetscInt));CHKERRQ(ierr);
2704     packPoints += numPoints;
2705   }
2706 
2707   ierr = PetscSegBufferDestroy(&segpack);CHKERRQ(ierr);
2708   ierr = ISRestoreIndices(pointPartition, &partArray);CHKERRQ(ierr);
2709   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), newSize, allPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2710   PetscFunctionReturn(0);
2711 }
2712 
2713 #undef __FUNCT__
2714 #define __FUNCT__ "DMPlexDistributeField"
2715 /*
2716   Input Parameters:
2717 . originalSection
2718 , originalVec
2719 
2720   Output Parameters:
2721 . newSection
2722 . newVec
2723 */
2724 PetscErrorCode DMPlexDistributeField(DM dm, PetscSF pointSF, PetscSection originalSection, Vec originalVec, PetscSection newSection, Vec newVec)
2725 {
2726   PetscSF        fieldSF;
2727   PetscInt      *remoteOffsets, fieldSize;
2728   PetscScalar   *originalValues, *newValues;
2729   PetscErrorCode ierr;
2730 
2731   PetscFunctionBegin;
2732   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
2733 
2734   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
2735   ierr = VecSetSizes(newVec, fieldSize, PETSC_DETERMINE);CHKERRQ(ierr);
2736   ierr = VecSetFromOptions(newVec);CHKERRQ(ierr);
2737 
2738   ierr = VecGetArray(originalVec, &originalValues);CHKERRQ(ierr);
2739   ierr = VecGetArray(newVec, &newValues);CHKERRQ(ierr);
2740   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
2741   ierr = PetscSFBcastBegin(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
2742   ierr = PetscSFBcastEnd(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
2743   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
2744   ierr = VecRestoreArray(newVec, &newValues);CHKERRQ(ierr);
2745   ierr = VecRestoreArray(originalVec, &originalValues);CHKERRQ(ierr);
2746   PetscFunctionReturn(0);
2747 }
2748 
2749 #undef __FUNCT__
2750 #define __FUNCT__ "DMPlexDistribute"
2751 /*@C
2752   DMPlexDistribute - Distributes the mesh and any associated sections.
2753 
2754   Not Collective
2755 
2756   Input Parameter:
2757 + dm  - The original DMPlex object
2758 . partitioner - The partitioning package, or NULL for the default
2759 - overlap - The overlap of partitions, 0 is the default
2760 
2761   Output Parameter:
2762 . parallelMesh - The distributed DMPlex object, or NULL
2763 
2764   Note: If the mesh was not distributed, the return value is NULL
2765 
2766   Level: intermediate
2767 
2768 .keywords: mesh, elements
2769 .seealso: DMPlexCreate(), DMPlexDistributeByFace()
2770 @*/
2771 PetscErrorCode DMPlexDistribute(DM dm, const char partitioner[], PetscInt overlap, DM *dmParallel)
2772 {
2773   DM_Plex               *mesh   = (DM_Plex*) dm->data, *pmesh;
2774   MPI_Comm               comm;
2775   const PetscInt         height = 0;
2776   PetscInt               dim, numRemoteRanks;
2777   IS                     origCellPart,        cellPart,        part;
2778   PetscSection           origCellPartSection, cellPartSection, partSection;
2779   PetscSFNode           *remoteRanks;
2780   PetscSF                partSF, pointSF, coneSF;
2781   ISLocalToGlobalMapping renumbering;
2782   PetscSection           originalConeSection, newConeSection;
2783   PetscInt              *remoteOffsets;
2784   PetscInt              *cones, *newCones, newConesSize;
2785   PetscBool              flg;
2786   PetscMPIInt            rank, numProcs, p;
2787   PetscErrorCode         ierr;
2788 
2789   PetscFunctionBegin;
2790   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2791   PetscValidPointer(dmParallel,4);
2792 
2793   ierr = PetscLogEventBegin(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
2794   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2795   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2796   ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
2797 
2798   *dmParallel = NULL;
2799   if (numProcs == 1) PetscFunctionReturn(0);
2800 
2801   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2802   /* Create cell partition - We need to rewrite to use IS, use the MatPartition stuff */
2803   ierr = PetscLogEventBegin(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
2804   if (overlap > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Overlap > 1 not yet implemented");
2805   ierr = DMPlexCreatePartition(dm, partitioner, height, overlap > 0 ? PETSC_TRUE : PETSC_FALSE, &cellPartSection, &cellPart, &origCellPartSection, &origCellPart);CHKERRQ(ierr);
2806   /* Create SF assuming a serial partition for all processes: Could check for IS length here */
2807   if (!rank) numRemoteRanks = numProcs;
2808   else       numRemoteRanks = 0;
2809   ierr = PetscMalloc(numRemoteRanks * sizeof(PetscSFNode), &remoteRanks);CHKERRQ(ierr);
2810   for (p = 0; p < numRemoteRanks; ++p) {
2811     remoteRanks[p].rank  = p;
2812     remoteRanks[p].index = 0;
2813   }
2814   ierr = PetscSFCreate(comm, &partSF);CHKERRQ(ierr);
2815   ierr = PetscSFSetGraph(partSF, 1, numRemoteRanks, NULL, PETSC_OWN_POINTER, remoteRanks, PETSC_OWN_POINTER);CHKERRQ(ierr);
2816   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-partition_view", &flg);CHKERRQ(ierr);
2817   if (flg) {
2818     ierr = PetscPrintf(comm, "Cell Partition:\n");CHKERRQ(ierr);
2819     ierr = PetscSectionView(cellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2820     ierr = ISView(cellPart, NULL);CHKERRQ(ierr);
2821     if (origCellPart) {
2822       ierr = PetscPrintf(comm, "Original Cell Partition:\n");CHKERRQ(ierr);
2823       ierr = PetscSectionView(origCellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2824       ierr = ISView(origCellPart, NULL);CHKERRQ(ierr);
2825     }
2826     ierr = PetscSFView(partSF, NULL);CHKERRQ(ierr);
2827   }
2828   /* Close the partition over the mesh */
2829   ierr = DMPlexCreatePartitionClosure(dm, cellPartSection, cellPart, &partSection, &part);CHKERRQ(ierr);
2830   ierr = ISDestroy(&cellPart);CHKERRQ(ierr);
2831   ierr = PetscSectionDestroy(&cellPartSection);CHKERRQ(ierr);
2832   /* Create new mesh */
2833   ierr  = DMPlexCreate(comm, dmParallel);CHKERRQ(ierr);
2834   ierr  = DMPlexSetDimension(*dmParallel, dim);CHKERRQ(ierr);
2835   ierr  = PetscObjectSetName((PetscObject) *dmParallel, "Parallel Mesh");CHKERRQ(ierr);
2836   pmesh = (DM_Plex*) (*dmParallel)->data;
2837   /* Distribute sieve points and the global point numbering (replaces creating remote bases) */
2838   ierr = PetscSFConvertPartition(partSF, partSection, part, &renumbering, &pointSF);CHKERRQ(ierr);
2839   if (flg) {
2840     ierr = PetscPrintf(comm, "Point Partition:\n");CHKERRQ(ierr);
2841     ierr = PetscSectionView(partSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2842     ierr = ISView(part, NULL);CHKERRQ(ierr);
2843     ierr = PetscSFView(pointSF, NULL);CHKERRQ(ierr);
2844     ierr = PetscPrintf(comm, "Point Renumbering after partition:\n");CHKERRQ(ierr);
2845     ierr = ISLocalToGlobalMappingView(renumbering, NULL);CHKERRQ(ierr);
2846   }
2847   ierr = PetscLogEventEnd(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
2848   /* Distribute cone section */
2849   ierr = DMPlexGetConeSection(dm, &originalConeSection);CHKERRQ(ierr);
2850   ierr = DMPlexGetConeSection(*dmParallel, &newConeSection);CHKERRQ(ierr);
2851   ierr = PetscSFDistributeSection(pointSF, originalConeSection, &remoteOffsets, newConeSection);CHKERRQ(ierr);
2852   ierr = DMSetUp(*dmParallel);CHKERRQ(ierr);
2853   {
2854     PetscInt pStart, pEnd, p;
2855 
2856     ierr = PetscSectionGetChart(newConeSection, &pStart, &pEnd);CHKERRQ(ierr);
2857     for (p = pStart; p < pEnd; ++p) {
2858       PetscInt coneSize;
2859       ierr               = PetscSectionGetDof(newConeSection, p, &coneSize);CHKERRQ(ierr);
2860       pmesh->maxConeSize = PetscMax(pmesh->maxConeSize, coneSize);
2861     }
2862   }
2863   /* Communicate and renumber cones */
2864   ierr = PetscSFCreateSectionSF(pointSF, originalConeSection, remoteOffsets, newConeSection, &coneSF);CHKERRQ(ierr);
2865   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
2866   ierr = DMPlexGetCones(*dmParallel, &newCones);CHKERRQ(ierr);
2867   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
2868   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
2869   ierr = PetscSectionGetStorageSize(newConeSection, &newConesSize);CHKERRQ(ierr);
2870   ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newConesSize, newCones, NULL, newCones);CHKERRQ(ierr);
2871   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-cones_view", &flg);CHKERRQ(ierr);
2872   if (flg) {
2873     ierr = PetscPrintf(comm, "Serial Cone Section:\n");CHKERRQ(ierr);
2874     ierr = PetscSectionView(originalConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2875     ierr = PetscPrintf(comm, "Parallel Cone Section:\n");CHKERRQ(ierr);
2876     ierr = PetscSectionView(newConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2877     ierr = PetscSFView(coneSF, NULL);CHKERRQ(ierr);
2878   }
2879   ierr = DMPlexGetConeOrientations(dm, &cones);CHKERRQ(ierr);
2880   ierr = DMPlexGetConeOrientations(*dmParallel, &newCones);CHKERRQ(ierr);
2881   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
2882   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
2883   ierr = PetscSFDestroy(&coneSF);CHKERRQ(ierr);
2884   /* Create supports and stratify sieve */
2885   {
2886     PetscInt pStart, pEnd;
2887 
2888     ierr = PetscSectionGetChart(pmesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2889     ierr = PetscSectionSetChart(pmesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
2890   }
2891   ierr = DMPlexSymmetrize(*dmParallel);CHKERRQ(ierr);
2892   ierr = DMPlexStratify(*dmParallel);CHKERRQ(ierr);
2893   /* Distribute Coordinates */
2894   {
2895     PetscSection originalCoordSection, newCoordSection;
2896     Vec          originalCoordinates, newCoordinates;
2897     const char  *name;
2898 
2899     ierr = DMPlexGetCoordinateSection(dm, &originalCoordSection);CHKERRQ(ierr);
2900     ierr = DMPlexGetCoordinateSection(*dmParallel, &newCoordSection);CHKERRQ(ierr);
2901     ierr = DMGetCoordinatesLocal(dm, &originalCoordinates);CHKERRQ(ierr);
2902     ierr = VecCreate(comm, &newCoordinates);CHKERRQ(ierr);
2903     ierr = PetscObjectGetName((PetscObject) originalCoordinates, &name);CHKERRQ(ierr);
2904     ierr = PetscObjectSetName((PetscObject) newCoordinates, name);CHKERRQ(ierr);
2905 
2906     ierr = DMPlexDistributeField(dm, pointSF, originalCoordSection, originalCoordinates, newCoordSection, newCoordinates);CHKERRQ(ierr);
2907     ierr = DMSetCoordinatesLocal(*dmParallel, newCoordinates);CHKERRQ(ierr);
2908     ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr);
2909   }
2910   /* Distribute labels */
2911   ierr = PetscLogEventBegin(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
2912   {
2913     DMLabel  next      = mesh->labels, newNext = pmesh->labels;
2914     PetscInt numLabels = 0, l;
2915 
2916     /* Bcast number of labels */
2917     while (next) {
2918       ++numLabels; next = next->next;
2919     }
2920     ierr = MPI_Bcast(&numLabels, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
2921     next = mesh->labels;
2922     for (l = 0; l < numLabels; ++l) {
2923       DMLabel         newLabel;
2924       const PetscInt *partArray;
2925       char           *name;
2926       PetscInt       *stratumSizes = NULL, *points = NULL;
2927       PetscMPIInt    *sendcnts     = NULL, *offsets = NULL, *displs = NULL;
2928       PetscInt        nameSize, s, p, proc;
2929       PetscBool       isdepth;
2930       size_t          len = 0;
2931 
2932       /* Bcast name (could filter for no points) */
2933       if (!rank) {ierr = PetscStrlen(next->name, &len);CHKERRQ(ierr);}
2934       nameSize = len;
2935       ierr     = MPI_Bcast(&nameSize, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
2936       ierr     = PetscMalloc(nameSize+1, &name);CHKERRQ(ierr);
2937       if (!rank) {ierr = PetscMemcpy(name, next->name, nameSize+1);CHKERRQ(ierr);}
2938       ierr = MPI_Bcast(name, nameSize+1, MPI_CHAR, 0, comm);CHKERRQ(ierr);
2939       ierr = PetscStrcmp(name, "depth", &isdepth);CHKERRQ(ierr);
2940       if (isdepth) {            /* skip because "depth" is not distributed */
2941         ierr = PetscFree(name);CHKERRQ(ierr);
2942         if (!rank) next = next->next;
2943         continue;
2944       }
2945       ierr           = PetscNew(struct _n_DMLabel, &newLabel);CHKERRQ(ierr);
2946       newLabel->name = name;
2947       /* Bcast numStrata (could filter for no points in stratum) */
2948       if (!rank) newLabel->numStrata = next->numStrata;
2949       ierr = MPI_Bcast(&newLabel->numStrata, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
2950       ierr = PetscMalloc3(newLabel->numStrata,PetscInt,&newLabel->stratumValues,
2951                           newLabel->numStrata,PetscInt,&newLabel->stratumSizes,
2952                           newLabel->numStrata+1,PetscInt,&newLabel->stratumOffsets);CHKERRQ(ierr);
2953       /* Bcast stratumValues (could filter for no points in stratum) */
2954       if (!rank) {ierr = PetscMemcpy(newLabel->stratumValues, next->stratumValues, next->numStrata * sizeof(PetscInt));CHKERRQ(ierr);}
2955       ierr = MPI_Bcast(newLabel->stratumValues, newLabel->numStrata, MPIU_INT, 0, comm);CHKERRQ(ierr);
2956       /* Find size on each process and Scatter
2957            we use the fact that both the stratum points and partArray are sorted */
2958       if (!rank) {
2959         ierr = ISGetIndices(part, &partArray);CHKERRQ(ierr);
2960         ierr = PetscMalloc(numProcs*next->numStrata * sizeof(PetscInt), &stratumSizes);CHKERRQ(ierr);
2961         ierr = PetscMemzero(stratumSizes, numProcs*next->numStrata * sizeof(PetscInt));CHKERRQ(ierr);
2962         /* TODO We should switch to using binary search if the label is a lot smaller than partitions */
2963         for (proc = 0; proc < numProcs; ++proc) {
2964           PetscInt dof, off;
2965 
2966           ierr = PetscSectionGetDof(partSection, proc, &dof);CHKERRQ(ierr);
2967           ierr = PetscSectionGetOffset(partSection, proc, &off);CHKERRQ(ierr);
2968           for (s = 0; s < next->numStrata; ++s) {
2969             PetscInt lStart = next->stratumOffsets[s], lEnd = next->stratumOffsets[s]+next->stratumSizes[s];
2970             PetscInt pStart = off,                     pEnd = off+dof;
2971 
2972             while (pStart < pEnd && lStart < lEnd) {
2973               if (partArray[pStart] > next->points[lStart]) {
2974                 ++lStart;
2975               } else if (next->points[lStart] > partArray[pStart]) {
2976                 ++pStart;
2977               } else {
2978                 ++stratumSizes[proc*next->numStrata+s];
2979                 ++pStart; ++lStart;
2980               }
2981             }
2982           }
2983         }
2984         ierr = ISRestoreIndices(part, &partArray);CHKERRQ(ierr);
2985       }
2986       ierr = MPI_Scatter(stratumSizes, newLabel->numStrata, MPIU_INT, newLabel->stratumSizes, newLabel->numStrata, MPIU_INT, 0, comm);CHKERRQ(ierr);
2987       /* Calculate stratumOffsets */
2988       newLabel->stratumOffsets[0] = 0;
2989       for (s = 0; s < newLabel->numStrata; ++s) {
2990         newLabel->stratumOffsets[s+1] = newLabel->stratumSizes[s] + newLabel->stratumOffsets[s];
2991       }
2992       /* Pack points and Scatter */
2993       if (!rank) {
2994         ierr = PetscMalloc3(numProcs,PetscMPIInt,&sendcnts,numProcs,PetscMPIInt,&offsets,numProcs+1,PetscMPIInt,&displs);CHKERRQ(ierr);
2995         displs[0] = 0;
2996         for (p = 0; p < numProcs; ++p) {
2997           sendcnts[p] = 0;
2998           for (s = 0; s < next->numStrata; ++s) {
2999             sendcnts[p] += stratumSizes[p*next->numStrata+s];
3000           }
3001           offsets[p]  = displs[p];
3002           displs[p+1] = displs[p] + sendcnts[p];
3003         }
3004         ierr = PetscMalloc(displs[numProcs] * sizeof(PetscInt), &points);CHKERRQ(ierr);
3005         /* TODO We should switch to using binary search if the label is a lot smaller than partitions */
3006         for (proc = 0; proc < numProcs; ++proc) {
3007           PetscInt dof, off;
3008 
3009           ierr = PetscSectionGetDof(partSection, proc, &dof);CHKERRQ(ierr);
3010           ierr = PetscSectionGetOffset(partSection, proc, &off);CHKERRQ(ierr);
3011           for (s = 0; s < next->numStrata; ++s) {
3012             PetscInt lStart = next->stratumOffsets[s], lEnd = next->stratumOffsets[s]+next->stratumSizes[s];
3013             PetscInt pStart = off,                     pEnd = off+dof;
3014 
3015             while (pStart < pEnd && lStart < lEnd) {
3016               if (partArray[pStart] > next->points[lStart]) {
3017                 ++lStart;
3018               } else if (next->points[lStart] > partArray[pStart]) {
3019                 ++pStart;
3020               } else {
3021                 points[offsets[proc]++] = next->points[lStart];
3022                 ++pStart; ++lStart;
3023               }
3024             }
3025           }
3026         }
3027       }
3028       ierr = PetscMalloc(newLabel->stratumOffsets[newLabel->numStrata] * sizeof(PetscInt), &newLabel->points);CHKERRQ(ierr);
3029       ierr = MPI_Scatterv(points, sendcnts, displs, MPIU_INT, newLabel->points, newLabel->stratumOffsets[newLabel->numStrata], MPIU_INT, 0, comm);CHKERRQ(ierr);
3030       ierr = PetscFree(points);CHKERRQ(ierr);
3031       ierr = PetscFree3(sendcnts,offsets,displs);CHKERRQ(ierr);
3032       ierr = PetscFree(stratumSizes);CHKERRQ(ierr);
3033       /* Renumber points */
3034       ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newLabel->stratumOffsets[newLabel->numStrata], newLabel->points, NULL, newLabel->points);CHKERRQ(ierr);
3035       /* Sort points */
3036       for (s = 0; s < newLabel->numStrata; ++s) {
3037         ierr = PetscSortInt(newLabel->stratumSizes[s], &newLabel->points[newLabel->stratumOffsets[s]]);CHKERRQ(ierr);
3038       }
3039       /* Insert into list */
3040       if (newNext) newNext->next = newLabel;
3041       else pmesh->labels = newLabel;
3042       newNext = newLabel;
3043       if (!rank) next = next->next;
3044     }
3045   }
3046   ierr = PetscLogEventEnd(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
3047   /* Setup hybrid structure */
3048   {
3049     const PetscInt *gpoints;
3050     PetscInt        depth, n, d;
3051 
3052     for (d = 0; d <= dim; ++d) {pmesh->hybridPointMax[d] = mesh->hybridPointMax[d];}
3053     ierr = MPI_Bcast(pmesh->hybridPointMax, dim+1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3054     ierr = ISLocalToGlobalMappingGetSize(renumbering, &n);CHKERRQ(ierr);
3055     ierr = ISLocalToGlobalMappingGetIndices(renumbering, &gpoints);CHKERRQ(ierr);
3056     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3057     for (d = 0; d <= dim; ++d) {
3058       PetscInt pmax = pmesh->hybridPointMax[d], newmax = 0, pEnd, stratum[2], p;
3059 
3060       if (pmax < 0) continue;
3061       ierr = DMPlexGetDepthStratum(dm, d > depth ? depth : d, &stratum[0], &stratum[1]);CHKERRQ(ierr);
3062       /* This mesh is not interpolated, so there is still a problem here */
3063       ierr = DMPlexGetDepthStratum(*dmParallel, d > 0 ? 1 : d, NULL, &pEnd);CHKERRQ(ierr);
3064       ierr = MPI_Bcast(stratum, 2, MPIU_INT, 0, comm);CHKERRQ(ierr);
3065       for (p = 0; p < n; ++p) {
3066         const PetscInt point = gpoints[p];
3067 
3068         if ((point >= stratum[0]) && (point < stratum[1]) && (point >= pmax)) ++newmax;
3069       }
3070       if (newmax > 0) pmesh->hybridPointMax[d] = pEnd - newmax;
3071       else            pmesh->hybridPointMax[d] = -1;
3072     }
3073     ierr = ISLocalToGlobalMappingRestoreIndices(renumbering, &gpoints);CHKERRQ(ierr);
3074   }
3075   /* Cleanup Partition */
3076   ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr);
3077   ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr);
3078   ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr);
3079   ierr = ISDestroy(&part);CHKERRQ(ierr);
3080   /* Create point SF for parallel mesh */
3081   ierr = PetscLogEventBegin(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3082   {
3083     const PetscInt *leaves;
3084     PetscSFNode    *remotePoints, *rowners, *lowners;
3085     PetscInt        numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints;
3086     PetscInt        pStart, pEnd;
3087 
3088     ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr);
3089     ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr);
3090     ierr = PetscMalloc2(numRoots,PetscSFNode,&rowners,numLeaves,PetscSFNode,&lowners);CHKERRQ(ierr);
3091     for (p=0; p<numRoots; p++) {
3092       rowners[p].rank  = -1;
3093       rowners[p].index = -1;
3094     }
3095     if (origCellPart) {
3096       /* Make sure cells in the original partition are not assigned to other procs */
3097       const PetscInt *origCells;
3098 
3099       ierr = ISGetIndices(origCellPart, &origCells);CHKERRQ(ierr);
3100       for (p = 0; p < numProcs; ++p) {
3101         PetscInt dof, off, d;
3102 
3103         ierr = PetscSectionGetDof(origCellPartSection, p, &dof);CHKERRQ(ierr);
3104         ierr = PetscSectionGetOffset(origCellPartSection, p, &off);CHKERRQ(ierr);
3105         for (d = off; d < off+dof; ++d) {
3106           rowners[origCells[d]].rank = p;
3107         }
3108       }
3109       ierr = ISRestoreIndices(origCellPart, &origCells);CHKERRQ(ierr);
3110     }
3111     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3112     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3113 
3114     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3115     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3116     for (p = 0; p < numLeaves; ++p) {
3117       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3118         lowners[p].rank  = rank;
3119         lowners[p].index = leaves ? leaves[p] : p;
3120       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3121         lowners[p].rank  = -2;
3122         lowners[p].index = -2;
3123       }
3124     }
3125     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3126       rowners[p].rank  = -3;
3127       rowners[p].index = -3;
3128     }
3129     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3130     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3131     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3132     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3133     for (p = 0; p < numLeaves; ++p) {
3134       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3135       if (lowners[p].rank != rank) ++numGhostPoints;
3136     }
3137     ierr = PetscMalloc(numGhostPoints * sizeof(PetscInt),    &ghostPoints);CHKERRQ(ierr);
3138     ierr = PetscMalloc(numGhostPoints * sizeof(PetscSFNode), &remotePoints);CHKERRQ(ierr);
3139     for (p = 0, gp = 0; p < numLeaves; ++p) {
3140       if (lowners[p].rank != rank) {
3141         ghostPoints[gp]        = leaves ? leaves[p] : p;
3142         remotePoints[gp].rank  = lowners[p].rank;
3143         remotePoints[gp].index = lowners[p].index;
3144         ++gp;
3145       }
3146     }
3147     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3148     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3149     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3150   }
3151   ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3152   /* Cleanup */
3153   ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);
3154   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3155   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3156   PetscFunctionReturn(0);
3157 }
3158 
3159 #undef __FUNCT__
3160 #define __FUNCT__ "DMPlexInvertCell"
3161 /*@C
3162   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3163 
3164   Input Parameters:
3165 + numCorners - The number of vertices in a cell
3166 - cone - The incoming cone
3167 
3168   Output Parameter:
3169 . cone - The inverted cone (in-place)
3170 
3171   Level: developer
3172 
3173 .seealso: DMPlexGenerate()
3174 @*/
3175 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3176 {
3177   int tmpc;
3178 
3179   PetscFunctionBegin;
3180   if (dim != 3) PetscFunctionReturn(0);
3181   switch (numCorners) {
3182   case 4:
3183     tmpc    = cone[0];
3184     cone[0] = cone[1];
3185     cone[1] = tmpc;
3186     break;
3187   case 8:
3188     tmpc    = cone[1];
3189     cone[1] = cone[3];
3190     cone[3] = tmpc;
3191     break;
3192   default: break;
3193   }
3194   PetscFunctionReturn(0);
3195 }
3196 
3197 #undef __FUNCT__
3198 #define __FUNCT__ "DMPlexInvertCells_Internal"
3199 /* This is to fix the tetrahedron orientation from TetGen */
3200 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3201 {
3202   PetscInt       bound = numCells*numCorners, coff;
3203   PetscErrorCode ierr;
3204 
3205   PetscFunctionBegin;
3206   for (coff = 0; coff < bound; coff += numCorners) {
3207     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3208   }
3209   PetscFunctionReturn(0);
3210 }
3211 
3212 #if defined(PETSC_HAVE_TRIANGLE)
3213 #include <triangle.h>
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "InitInput_Triangle"
3217 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3218 {
3219   PetscFunctionBegin;
3220   inputCtx->numberofpoints             = 0;
3221   inputCtx->numberofpointattributes    = 0;
3222   inputCtx->pointlist                  = NULL;
3223   inputCtx->pointattributelist         = NULL;
3224   inputCtx->pointmarkerlist            = NULL;
3225   inputCtx->numberofsegments           = 0;
3226   inputCtx->segmentlist                = NULL;
3227   inputCtx->segmentmarkerlist          = NULL;
3228   inputCtx->numberoftriangleattributes = 0;
3229   inputCtx->trianglelist               = NULL;
3230   inputCtx->numberofholes              = 0;
3231   inputCtx->holelist                   = NULL;
3232   inputCtx->numberofregions            = 0;
3233   inputCtx->regionlist                 = NULL;
3234   PetscFunctionReturn(0);
3235 }
3236 
3237 #undef __FUNCT__
3238 #define __FUNCT__ "InitOutput_Triangle"
3239 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3240 {
3241   PetscFunctionBegin;
3242   outputCtx->numberofpoints        = 0;
3243   outputCtx->pointlist             = NULL;
3244   outputCtx->pointattributelist    = NULL;
3245   outputCtx->pointmarkerlist       = NULL;
3246   outputCtx->numberoftriangles     = 0;
3247   outputCtx->trianglelist          = NULL;
3248   outputCtx->triangleattributelist = NULL;
3249   outputCtx->neighborlist          = NULL;
3250   outputCtx->segmentlist           = NULL;
3251   outputCtx->segmentmarkerlist     = NULL;
3252   outputCtx->numberofedges         = 0;
3253   outputCtx->edgelist              = NULL;
3254   outputCtx->edgemarkerlist        = NULL;
3255   PetscFunctionReturn(0);
3256 }
3257 
3258 #undef __FUNCT__
3259 #define __FUNCT__ "FiniOutput_Triangle"
3260 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3261 {
3262   PetscFunctionBegin;
3263   free(outputCtx->pointmarkerlist);
3264   free(outputCtx->edgelist);
3265   free(outputCtx->edgemarkerlist);
3266   free(outputCtx->trianglelist);
3267   free(outputCtx->neighborlist);
3268   PetscFunctionReturn(0);
3269 }
3270 
3271 #undef __FUNCT__
3272 #define __FUNCT__ "DMPlexGenerate_Triangle"
3273 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3274 {
3275   MPI_Comm             comm;
3276   PetscInt             dim              = 2;
3277   const PetscBool      createConvexHull = PETSC_FALSE;
3278   const PetscBool      constrained      = PETSC_FALSE;
3279   struct triangulateio in;
3280   struct triangulateio out;
3281   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3282   PetscMPIInt          rank;
3283   PetscErrorCode       ierr;
3284 
3285   PetscFunctionBegin;
3286   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3287   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3288   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3289   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3290   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3291 
3292   in.numberofpoints = vEnd - vStart;
3293   if (in.numberofpoints > 0) {
3294     PetscSection coordSection;
3295     Vec          coordinates;
3296     PetscScalar *array;
3297 
3298     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3299     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3300     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3301     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3302     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3303     for (v = vStart; v < vEnd; ++v) {
3304       const PetscInt idx = v - vStart;
3305       PetscInt       off, d;
3306 
3307       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3308       for (d = 0; d < dim; ++d) {
3309         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3310       }
3311       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3312     }
3313     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3314   }
3315   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3316   in.numberofsegments = eEnd - eStart;
3317   if (in.numberofsegments > 0) {
3318     ierr = PetscMalloc(in.numberofsegments*2 * sizeof(int), &in.segmentlist);CHKERRQ(ierr);
3319     ierr = PetscMalloc(in.numberofsegments   * sizeof(int), &in.segmentmarkerlist);CHKERRQ(ierr);
3320     for (e = eStart; e < eEnd; ++e) {
3321       const PetscInt  idx = e - eStart;
3322       const PetscInt *cone;
3323 
3324       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3325 
3326       in.segmentlist[idx*2+0] = cone[0] - vStart;
3327       in.segmentlist[idx*2+1] = cone[1] - vStart;
3328 
3329       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3330     }
3331   }
3332 #if 0 /* Do not currently support holes */
3333   PetscReal *holeCoords;
3334   PetscInt   h, d;
3335 
3336   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3337   if (in.numberofholes > 0) {
3338     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3339     for (h = 0; h < in.numberofholes; ++h) {
3340       for (d = 0; d < dim; ++d) {
3341         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3342       }
3343     }
3344   }
3345 #endif
3346   if (!rank) {
3347     char args[32];
3348 
3349     /* Take away 'Q' for verbose output */
3350     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3351     if (createConvexHull) {
3352       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3353     }
3354     if (constrained) {
3355       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3356     }
3357     triangulate(args, &in, &out, NULL);
3358   }
3359   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3360   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3361   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3362   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3363   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3364 
3365   {
3366     const PetscInt numCorners  = 3;
3367     const PetscInt numCells    = out.numberoftriangles;
3368     const PetscInt numVertices = out.numberofpoints;
3369     const int     *cells      = out.trianglelist;
3370     const double  *meshCoords = out.pointlist;
3371 
3372     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3373     /* Set labels */
3374     for (v = 0; v < numVertices; ++v) {
3375       if (out.pointmarkerlist[v]) {
3376         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3377       }
3378     }
3379     if (interpolate) {
3380       for (e = 0; e < out.numberofedges; e++) {
3381         if (out.edgemarkerlist[e]) {
3382           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3383           const PetscInt *edges;
3384           PetscInt        numEdges;
3385 
3386           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3387           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3388           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3389           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3390         }
3391       }
3392     }
3393     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3394   }
3395 #if 0 /* Do not currently support holes */
3396   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3397 #endif
3398   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3399   PetscFunctionReturn(0);
3400 }
3401 
3402 #undef __FUNCT__
3403 #define __FUNCT__ "DMPlexRefine_Triangle"
3404 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3405 {
3406   MPI_Comm             comm;
3407   PetscInt             dim  = 2;
3408   struct triangulateio in;
3409   struct triangulateio out;
3410   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3411   PetscMPIInt          rank;
3412   PetscErrorCode       ierr;
3413 
3414   PetscFunctionBegin;
3415   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3416   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3417   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3418   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3419   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3420   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3421   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3422 
3423   in.numberofpoints = vEnd - vStart;
3424   if (in.numberofpoints > 0) {
3425     PetscSection coordSection;
3426     Vec          coordinates;
3427     PetscScalar *array;
3428 
3429     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3430     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3431     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3432     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3433     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3434     for (v = vStart; v < vEnd; ++v) {
3435       const PetscInt idx = v - vStart;
3436       PetscInt       off, d;
3437 
3438       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3439       for (d = 0; d < dim; ++d) {
3440         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3441       }
3442       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3443     }
3444     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3445   }
3446   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3447 
3448   in.numberofcorners   = 3;
3449   in.numberoftriangles = cEnd - cStart;
3450 
3451   in.trianglearealist  = (double*) maxVolumes;
3452   if (in.numberoftriangles > 0) {
3453     ierr = PetscMalloc(in.numberoftriangles*in.numberofcorners * sizeof(int), &in.trianglelist);CHKERRQ(ierr);
3454     for (c = cStart; c < cEnd; ++c) {
3455       const PetscInt idx      = c - cStart;
3456       PetscInt      *closure = NULL;
3457       PetscInt       closureSize;
3458 
3459       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3460       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3461       for (v = 0; v < 3; ++v) {
3462         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3463       }
3464       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3465     }
3466   }
3467   /* TODO: Segment markers are missing on input */
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, "pqezQra");CHKERRQ(ierr);
3487     triangulate(args, &in, &out, NULL);
3488   }
3489   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3490   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3491   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3492   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3493   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3494 
3495   {
3496     const PetscInt numCorners  = 3;
3497     const PetscInt numCells    = out.numberoftriangles;
3498     const PetscInt numVertices = out.numberofpoints;
3499     const int     *cells      = out.trianglelist;
3500     const double  *meshCoords = out.pointlist;
3501     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3502 
3503     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3504     /* Set labels */
3505     for (v = 0; v < numVertices; ++v) {
3506       if (out.pointmarkerlist[v]) {
3507         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3508       }
3509     }
3510     if (interpolate) {
3511       PetscInt e;
3512 
3513       for (e = 0; e < out.numberofedges; e++) {
3514         if (out.edgemarkerlist[e]) {
3515           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3516           const PetscInt *edges;
3517           PetscInt        numEdges;
3518 
3519           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3520           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3521           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3522           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3523         }
3524       }
3525     }
3526     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3527   }
3528 #if 0 /* Do not currently support holes */
3529   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3530 #endif
3531   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3532   PetscFunctionReturn(0);
3533 }
3534 #endif
3535 
3536 #if defined(PETSC_HAVE_TETGEN)
3537 #include <tetgen.h>
3538 #undef __FUNCT__
3539 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3540 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3541 {
3542   MPI_Comm       comm;
3543   const PetscInt dim  = 3;
3544   ::tetgenio     in;
3545   ::tetgenio     out;
3546   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3547   PetscMPIInt    rank;
3548   PetscErrorCode ierr;
3549 
3550   PetscFunctionBegin;
3551   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3552   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3553   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3554   in.numberofpoints = vEnd - vStart;
3555   if (in.numberofpoints > 0) {
3556     PetscSection coordSection;
3557     Vec          coordinates;
3558     PetscScalar *array;
3559 
3560     in.pointlist       = new double[in.numberofpoints*dim];
3561     in.pointmarkerlist = new int[in.numberofpoints];
3562 
3563     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3564     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3565     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3566     for (v = vStart; v < vEnd; ++v) {
3567       const PetscInt idx = v - vStart;
3568       PetscInt       off, d;
3569 
3570       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3571       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3572       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3573     }
3574     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3575   }
3576   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3577 
3578   in.numberoffacets = fEnd - fStart;
3579   if (in.numberoffacets > 0) {
3580     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3581     in.facetmarkerlist = new int[in.numberoffacets];
3582     for (f = fStart; f < fEnd; ++f) {
3583       const PetscInt idx     = f - fStart;
3584       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3585 
3586       in.facetlist[idx].numberofpolygons = 1;
3587       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3588       in.facetlist[idx].numberofholes    = 0;
3589       in.facetlist[idx].holelist         = NULL;
3590 
3591       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3592       for (p = 0; p < numPoints*2; p += 2) {
3593         const PetscInt point = points[p];
3594         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3595       }
3596 
3597       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3598       poly->numberofvertices = numVertices;
3599       poly->vertexlist       = new int[poly->numberofvertices];
3600       for (v = 0; v < numVertices; ++v) {
3601         const PetscInt vIdx = points[v] - vStart;
3602         poly->vertexlist[v] = vIdx;
3603       }
3604       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3605       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3606     }
3607   }
3608   if (!rank) {
3609     char args[32];
3610 
3611     /* Take away 'Q' for verbose output */
3612     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3613     ::tetrahedralize(args, &in, &out);
3614   }
3615   {
3616     const PetscInt numCorners  = 4;
3617     const PetscInt numCells    = out.numberoftetrahedra;
3618     const PetscInt numVertices = out.numberofpoints;
3619     const double   *meshCoords = out.pointlist;
3620     int            *cells      = out.tetrahedronlist;
3621 
3622     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3623     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3624     /* Set labels */
3625     for (v = 0; v < numVertices; ++v) {
3626       if (out.pointmarkerlist[v]) {
3627         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3628       }
3629     }
3630     if (interpolate) {
3631       PetscInt e;
3632 
3633       for (e = 0; e < out.numberofedges; e++) {
3634         if (out.edgemarkerlist[e]) {
3635           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3636           const PetscInt *edges;
3637           PetscInt        numEdges;
3638 
3639           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3640           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3641           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3642           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3643         }
3644       }
3645       for (f = 0; f < out.numberoftrifaces; f++) {
3646         if (out.trifacemarkerlist[f]) {
3647           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3648           const PetscInt *faces;
3649           PetscInt        numFaces;
3650 
3651           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3652           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3653           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3654           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3655         }
3656       }
3657     }
3658     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3659   }
3660   PetscFunctionReturn(0);
3661 }
3662 
3663 #undef __FUNCT__
3664 #define __FUNCT__ "DMPlexRefine_Tetgen"
3665 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3666 {
3667   MPI_Comm       comm;
3668   const PetscInt dim  = 3;
3669   ::tetgenio     in;
3670   ::tetgenio     out;
3671   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3672   PetscMPIInt    rank;
3673   PetscErrorCode ierr;
3674 
3675   PetscFunctionBegin;
3676   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3677   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3678   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3679   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3680   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3681 
3682   in.numberofpoints = vEnd - vStart;
3683   if (in.numberofpoints > 0) {
3684     PetscSection coordSection;
3685     Vec          coordinates;
3686     PetscScalar *array;
3687 
3688     in.pointlist       = new double[in.numberofpoints*dim];
3689     in.pointmarkerlist = new int[in.numberofpoints];
3690 
3691     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3692     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3693     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3694     for (v = vStart; v < vEnd; ++v) {
3695       const PetscInt idx = v - vStart;
3696       PetscInt       off, d;
3697 
3698       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3699       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3700       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3701     }
3702     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3703   }
3704   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3705 
3706   in.numberofcorners       = 4;
3707   in.numberoftetrahedra    = cEnd - cStart;
3708   in.tetrahedronvolumelist = (double*) maxVolumes;
3709   if (in.numberoftetrahedra > 0) {
3710     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3711     for (c = cStart; c < cEnd; ++c) {
3712       const PetscInt idx      = c - cStart;
3713       PetscInt      *closure = NULL;
3714       PetscInt       closureSize;
3715 
3716       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3717       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3718       for (v = 0; v < 4; ++v) {
3719         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3720       }
3721       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3722     }
3723   }
3724   /* TODO: Put in boundary faces with markers */
3725   if (!rank) {
3726     char args[32];
3727 
3728     /* Take away 'Q' for verbose output */
3729     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3730     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3731     ::tetrahedralize(args, &in, &out);
3732   }
3733   in.tetrahedronvolumelist = NULL;
3734 
3735   {
3736     const PetscInt numCorners  = 4;
3737     const PetscInt numCells    = out.numberoftetrahedra;
3738     const PetscInt numVertices = out.numberofpoints;
3739     const double   *meshCoords = out.pointlist;
3740     int            *cells      = out.tetrahedronlist;
3741 
3742     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3743 
3744     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3745     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3746     /* Set labels */
3747     for (v = 0; v < numVertices; ++v) {
3748       if (out.pointmarkerlist[v]) {
3749         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3750       }
3751     }
3752     if (interpolate) {
3753       PetscInt e, f;
3754 
3755       for (e = 0; e < out.numberofedges; e++) {
3756         if (out.edgemarkerlist[e]) {
3757           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3758           const PetscInt *edges;
3759           PetscInt        numEdges;
3760 
3761           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3762           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3763           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3764           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3765         }
3766       }
3767       for (f = 0; f < out.numberoftrifaces; f++) {
3768         if (out.trifacemarkerlist[f]) {
3769           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3770           const PetscInt *faces;
3771           PetscInt        numFaces;
3772 
3773           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3774           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3775           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3776           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3777         }
3778       }
3779     }
3780     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3781   }
3782   PetscFunctionReturn(0);
3783 }
3784 #endif
3785 
3786 #if defined(PETSC_HAVE_CTETGEN)
3787 #include "ctetgen.h"
3788 
3789 #undef __FUNCT__
3790 #define __FUNCT__ "DMPlexGenerate_CTetgen"
3791 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
3792 {
3793   MPI_Comm       comm;
3794   const PetscInt dim  = 3;
3795   PLC           *in, *out;
3796   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
3797   PetscMPIInt    rank;
3798   PetscErrorCode ierr;
3799 
3800   PetscFunctionBegin;
3801   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3802   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3803   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3804   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3805   ierr = PLCCreate(&in);CHKERRQ(ierr);
3806   ierr = PLCCreate(&out);CHKERRQ(ierr);
3807 
3808   in->numberofpoints = vEnd - vStart;
3809   if (in->numberofpoints > 0) {
3810     PetscSection coordSection;
3811     Vec          coordinates;
3812     PetscScalar *array;
3813 
3814     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
3815     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
3816     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3817     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3818     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3819     for (v = vStart; v < vEnd; ++v) {
3820       const PetscInt idx = v - vStart;
3821       PetscInt       off, d, m;
3822 
3823       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3824       for (d = 0; d < dim; ++d) {
3825         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3826       }
3827       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
3828 
3829       in->pointmarkerlist[idx] = (int) m;
3830     }
3831     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3832   }
3833   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3834 
3835   in->numberoffacets = fEnd - fStart;
3836   if (in->numberoffacets > 0) {
3837     ierr = PetscMalloc(in->numberoffacets * sizeof(facet), &in->facetlist);CHKERRQ(ierr);
3838     ierr = PetscMalloc(in->numberoffacets * sizeof(int),   &in->facetmarkerlist);CHKERRQ(ierr);
3839     for (f = fStart; f < fEnd; ++f) {
3840       const PetscInt idx     = f - fStart;
3841       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
3842       polygon       *poly;
3843 
3844       in->facetlist[idx].numberofpolygons = 1;
3845 
3846       ierr = PetscMalloc(in->facetlist[idx].numberofpolygons * sizeof(polygon), &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
3847 
3848       in->facetlist[idx].numberofholes    = 0;
3849       in->facetlist[idx].holelist         = NULL;
3850 
3851       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3852       for (p = 0; p < numPoints*2; p += 2) {
3853         const PetscInt point = points[p];
3854         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3855       }
3856 
3857       poly                   = in->facetlist[idx].polygonlist;
3858       poly->numberofvertices = numVertices;
3859       ierr                   = PetscMalloc(poly->numberofvertices * sizeof(int), &poly->vertexlist);CHKERRQ(ierr);
3860       for (v = 0; v < numVertices; ++v) {
3861         const PetscInt vIdx = points[v] - vStart;
3862         poly->vertexlist[v] = vIdx;
3863       }
3864       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
3865       in->facetmarkerlist[idx] = (int) m;
3866       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3867     }
3868   }
3869   if (!rank) {
3870     TetGenOpts t;
3871 
3872     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3873     t.in        = boundary; /* Should go away */
3874     t.plc       = 1;
3875     t.quality   = 1;
3876     t.edgesout  = 1;
3877     t.zeroindex = 1;
3878     t.quiet     = 1;
3879     t.verbose   = verbose;
3880     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
3881     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3882   }
3883   {
3884     const PetscInt numCorners  = 4;
3885     const PetscInt numCells    = out->numberoftetrahedra;
3886     const PetscInt numVertices = out->numberofpoints;
3887     const double   *meshCoords = out->pointlist;
3888     int            *cells      = out->tetrahedronlist;
3889 
3890     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3891     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3892     /* Set labels */
3893     for (v = 0; v < numVertices; ++v) {
3894       if (out->pointmarkerlist[v]) {
3895         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3896       }
3897     }
3898     if (interpolate) {
3899       PetscInt e;
3900 
3901       for (e = 0; e < out->numberofedges; e++) {
3902         if (out->edgemarkerlist[e]) {
3903           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3904           const PetscInt *edges;
3905           PetscInt        numEdges;
3906 
3907           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3908           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3909           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3910           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3911         }
3912       }
3913       for (f = 0; f < out->numberoftrifaces; f++) {
3914         if (out->trifacemarkerlist[f]) {
3915           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3916           const PetscInt *faces;
3917           PetscInt        numFaces;
3918 
3919           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3920           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3921           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
3922           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3923         }
3924       }
3925     }
3926     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3927   }
3928 
3929   ierr = PLCDestroy(&in);CHKERRQ(ierr);
3930   ierr = PLCDestroy(&out);CHKERRQ(ierr);
3931   PetscFunctionReturn(0);
3932 }
3933 
3934 #undef __FUNCT__
3935 #define __FUNCT__ "DMPlexRefine_CTetgen"
3936 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
3937 {
3938   MPI_Comm       comm;
3939   const PetscInt dim  = 3;
3940   PLC           *in, *out;
3941   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3942   PetscMPIInt    rank;
3943   PetscErrorCode ierr;
3944 
3945   PetscFunctionBegin;
3946   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3947   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3948   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3949   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3950   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3951   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3952   ierr = PLCCreate(&in);CHKERRQ(ierr);
3953   ierr = PLCCreate(&out);CHKERRQ(ierr);
3954 
3955   in->numberofpoints = vEnd - vStart;
3956   if (in->numberofpoints > 0) {
3957     PetscSection coordSection;
3958     Vec          coordinates;
3959     PetscScalar *array;
3960 
3961     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
3962     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
3963     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3964     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3965     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3966     for (v = vStart; v < vEnd; ++v) {
3967       const PetscInt idx = v - vStart;
3968       PetscInt       off, d, m;
3969 
3970       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3971       for (d = 0; d < dim; ++d) {
3972         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3973       }
3974       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
3975 
3976       in->pointmarkerlist[idx] = (int) m;
3977     }
3978     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3979   }
3980   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3981 
3982   in->numberofcorners       = 4;
3983   in->numberoftetrahedra    = cEnd - cStart;
3984   in->tetrahedronvolumelist = maxVolumes;
3985   if (in->numberoftetrahedra > 0) {
3986     ierr = PetscMalloc(in->numberoftetrahedra*in->numberofcorners * sizeof(int), &in->tetrahedronlist);CHKERRQ(ierr);
3987     for (c = cStart; c < cEnd; ++c) {
3988       const PetscInt idx      = c - cStart;
3989       PetscInt      *closure = NULL;
3990       PetscInt       closureSize;
3991 
3992       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3993       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3994       for (v = 0; v < 4; ++v) {
3995         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3996       }
3997       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3998     }
3999   }
4000   if (!rank) {
4001     TetGenOpts t;
4002 
4003     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4004 
4005     t.in        = dm; /* Should go away */
4006     t.refine    = 1;
4007     t.varvolume = 1;
4008     t.quality   = 1;
4009     t.edgesout  = 1;
4010     t.zeroindex = 1;
4011     t.quiet     = 1;
4012     t.verbose   = verbose; /* Change this */
4013 
4014     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4015     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4016   }
4017   {
4018     const PetscInt numCorners  = 4;
4019     const PetscInt numCells    = out->numberoftetrahedra;
4020     const PetscInt numVertices = out->numberofpoints;
4021     const double   *meshCoords = out->pointlist;
4022     int            *cells      = out->tetrahedronlist;
4023     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4024 
4025     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4026     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4027     /* Set labels */
4028     for (v = 0; v < numVertices; ++v) {
4029       if (out->pointmarkerlist[v]) {
4030         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4031       }
4032     }
4033     if (interpolate) {
4034       PetscInt e, f;
4035 
4036       for (e = 0; e < out->numberofedges; e++) {
4037         if (out->edgemarkerlist[e]) {
4038           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4039           const PetscInt *edges;
4040           PetscInt        numEdges;
4041 
4042           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4043           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4044           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4045           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4046         }
4047       }
4048       for (f = 0; f < out->numberoftrifaces; f++) {
4049         if (out->trifacemarkerlist[f]) {
4050           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4051           const PetscInt *faces;
4052           PetscInt        numFaces;
4053 
4054           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4055           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4056           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4057           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4058         }
4059       }
4060     }
4061     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4062   }
4063   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4064   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4065   PetscFunctionReturn(0);
4066 }
4067 #endif
4068 
4069 #undef __FUNCT__
4070 #define __FUNCT__ "DMPlexGenerate"
4071 /*@C
4072   DMPlexGenerate - Generates a mesh.
4073 
4074   Not Collective
4075 
4076   Input Parameters:
4077 + boundary - The DMPlex boundary object
4078 . name - The mesh generation package name
4079 - interpolate - Flag to create intermediate mesh elements
4080 
4081   Output Parameter:
4082 . mesh - The DMPlex object
4083 
4084   Level: intermediate
4085 
4086 .keywords: mesh, elements
4087 .seealso: DMPlexCreate(), DMRefine()
4088 @*/
4089 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4090 {
4091   PetscInt       dim;
4092   char           genname[1024];
4093   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4094   PetscErrorCode ierr;
4095 
4096   PetscFunctionBegin;
4097   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4098   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4099   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4100   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4101   if (flg) name = genname;
4102   if (name) {
4103     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4104     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4105     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4106   }
4107   switch (dim) {
4108   case 1:
4109     if (!name || isTriangle) {
4110 #if defined(PETSC_HAVE_TRIANGLE)
4111       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4112 #else
4113       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4114 #endif
4115     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4116     break;
4117   case 2:
4118     if (!name || isCTetgen) {
4119 #if defined(PETSC_HAVE_CTETGEN)
4120       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4121 #else
4122       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4123 #endif
4124     } else if (isTetgen) {
4125 #if defined(PETSC_HAVE_TETGEN)
4126       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4127 #else
4128       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4129 #endif
4130     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4131     break;
4132   default:
4133     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4134   }
4135   PetscFunctionReturn(0);
4136 }
4137 
4138 typedef PetscInt CellRefiner;
4139 
4140 #undef __FUNCT__
4141 #define __FUNCT__ "GetDepthStart_Private"
4142 PETSC_STATIC_INLINE PetscErrorCode GetDepthStart_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cStart, PetscInt *fStart, PetscInt *eStart, PetscInt *vStart)
4143 {
4144   PetscFunctionBegin;
4145   if (cStart) *cStart = 0;
4146   if (vStart) *vStart = depthSize[depth];
4147   if (fStart) *fStart = depthSize[depth] + depthSize[0];
4148   if (eStart) *eStart = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4149   PetscFunctionReturn(0);
4150 }
4151 
4152 #undef __FUNCT__
4153 #define __FUNCT__ "GetDepthEnd_Private"
4154 PETSC_STATIC_INLINE PetscErrorCode GetDepthEnd_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cEnd, PetscInt *fEnd, PetscInt *eEnd, PetscInt *vEnd)
4155 {
4156   PetscFunctionBegin;
4157   if (cEnd) *cEnd = depthSize[depth];
4158   if (vEnd) *vEnd = depthSize[depth] + depthSize[0];
4159   if (fEnd) *fEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4160   if (eEnd) *eEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1] + depthSize[1];
4161   PetscFunctionReturn(0);
4162 }
4163 
4164 #undef __FUNCT__
4165 #define __FUNCT__ "CellRefinerGetSizes"
4166 PetscErrorCode CellRefinerGetSizes(CellRefiner refiner, DM dm, PetscInt depthSize[])
4167 {
4168   PetscInt       cStart, cEnd, cMax, vStart, vEnd, vMax, fStart, fEnd, fMax, eStart, eEnd, eMax;
4169   PetscErrorCode ierr;
4170 
4171   PetscFunctionBegin;
4172   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4173   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4174   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4175   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4176   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4177   switch (refiner) {
4178   case 1:
4179     /* Simplicial 2D */
4180     depthSize[0] = vEnd - vStart + fEnd - fStart;         /* Add a vertex on every face */
4181     depthSize[1] = 2*(fEnd - fStart) + 3*(cEnd - cStart); /* Every face is split into 2 faces and 3 faces are added for each cell */
4182     depthSize[2] = 4*(cEnd - cStart);                     /* Every cell split into 4 cells */
4183     break;
4184   case 3:
4185     /* Hybrid 2D */
4186     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4187     cMax = PetscMin(cEnd, cMax);
4188     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4189     fMax         = PetscMin(fEnd, fMax);
4190     depthSize[0] = vEnd - vStart + fMax - fStart;                                         /* Add a vertex on every face, but not hybrid faces */
4191     depthSize[1] = 2*(fMax - fStart) + 3*(cMax - cStart) + (fEnd - fMax) + (cEnd - cMax); /* Every interior face is split into 2 faces, 3 faces are added for each interior cell, and one in each hybrid cell */
4192     depthSize[2] = 4*(cMax - cStart) + 2*(cEnd - cMax);                                   /* Interior cells split into 4 cells, Hybrid cells split into 2 cells */
4193     break;
4194   case 2:
4195     /* Hex 2D */
4196     depthSize[0] = vEnd - vStart + cEnd - cStart + fEnd - fStart; /* Add a vertex on every face and cell */
4197     depthSize[1] = 2*(fEnd - fStart) + 4*(cEnd - cStart);         /* Every face is split into 2 faces and 4 faces are added for each cell */
4198     depthSize[2] = 4*(cEnd - cStart);                             /* Every cell split into 4 cells */
4199     break;
4200   default:
4201     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4202   }
4203   PetscFunctionReturn(0);
4204 }
4205 
4206 #undef __FUNCT__
4207 #define __FUNCT__ "CellRefinerSetConeSizes"
4208 PetscErrorCode CellRefinerSetConeSizes(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4209 {
4210   PetscInt       depth, cStart, cStartNew, cEnd, cMax, c, vStart, vStartNew, vEnd, vMax, v, fStart, fStartNew, fEnd, fMax, f, eStart, eStartNew, eEnd, eMax, r;
4211   PetscErrorCode ierr;
4212 
4213   PetscFunctionBegin;
4214   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4215   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4216   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4217   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4218   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4219   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4220   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4221   switch (refiner) {
4222   case 1:
4223     /* Simplicial 2D */
4224     /* All cells have 3 faces */
4225     for (c = cStart; c < cEnd; ++c) {
4226       for (r = 0; r < 4; ++r) {
4227         const PetscInt newp = (c - cStart)*4 + r;
4228 
4229         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4230       }
4231     }
4232     /* Split faces have 2 vertices and the same cells as the parent */
4233     for (f = fStart; f < fEnd; ++f) {
4234       for (r = 0; r < 2; ++r) {
4235         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4236         PetscInt       size;
4237 
4238         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4239         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4240         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4241       }
4242     }
4243     /* Interior faces have 2 vertices and 2 cells */
4244     for (c = cStart; c < cEnd; ++c) {
4245       for (r = 0; r < 3; ++r) {
4246         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4247 
4248         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4249         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4250       }
4251     }
4252     /* Old vertices have identical supports */
4253     for (v = vStart; v < vEnd; ++v) {
4254       const PetscInt newp = vStartNew + (v - vStart);
4255       PetscInt       size;
4256 
4257       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4258       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4259     }
4260     /* Face vertices have 2 + cells*2 supports */
4261     for (f = fStart; f < fEnd; ++f) {
4262       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4263       PetscInt       size;
4264 
4265       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4266       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size*2);CHKERRQ(ierr);
4267     }
4268     break;
4269   case 2:
4270     /* Hex 2D */
4271     /* All cells have 4 faces */
4272     for (c = cStart; c < cEnd; ++c) {
4273       for (r = 0; r < 4; ++r) {
4274         const PetscInt newp = (c - cStart)*4 + r;
4275 
4276         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4277       }
4278     }
4279     /* Split faces have 2 vertices and the same cells as the parent */
4280     for (f = fStart; f < fEnd; ++f) {
4281       for (r = 0; r < 2; ++r) {
4282         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4283         PetscInt       size;
4284 
4285         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4286         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4287         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4288       }
4289     }
4290     /* Interior faces have 2 vertices and 2 cells */
4291     for (c = cStart; c < cEnd; ++c) {
4292       for (r = 0; r < 4; ++r) {
4293         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4294 
4295         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4296         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4297       }
4298     }
4299     /* Old vertices have identical supports */
4300     for (v = vStart; v < vEnd; ++v) {
4301       const PetscInt newp = vStartNew + (v - vStart);
4302       PetscInt       size;
4303 
4304       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4305       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4306     }
4307     /* Face vertices have 2 + cells supports */
4308     for (f = fStart; f < fEnd; ++f) {
4309       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4310       PetscInt       size;
4311 
4312       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4313       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size);CHKERRQ(ierr);
4314     }
4315     /* Cell vertices have 4 supports */
4316     for (c = cStart; c < cEnd; ++c) {
4317       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
4318 
4319       ierr = DMPlexSetSupportSize(rdm, newp, 4);CHKERRQ(ierr);
4320     }
4321     break;
4322   case 3:
4323     /* Hybrid 2D */
4324     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4325     cMax = PetscMin(cEnd, cMax);
4326     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4327     fMax = PetscMin(fEnd, fMax);
4328     ierr = DMPlexSetHybridBounds(rdm, cStartNew + (cMax - cStart)*4, fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
4329     /* Interior cells have 3 faces */
4330     for (c = cStart; c < cMax; ++c) {
4331       for (r = 0; r < 4; ++r) {
4332         const PetscInt newp = cStartNew + (c - cStart)*4 + r;
4333 
4334         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4335       }
4336     }
4337     /* Hybrid cells have 4 faces */
4338     for (c = cMax; c < cEnd; ++c) {
4339       for (r = 0; r < 2; ++r) {
4340         const PetscInt newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2 + r;
4341 
4342         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4343       }
4344     }
4345     /* Interior split faces have 2 vertices and the same cells as the parent */
4346     for (f = fStart; f < fMax; ++f) {
4347       for (r = 0; r < 2; ++r) {
4348         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4349         PetscInt       size;
4350 
4351         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4352         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4353         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4354       }
4355     }
4356     /* Interior cell faces have 2 vertices and 2 cells */
4357     for (c = cStart; c < cMax; ++c) {
4358       for (r = 0; r < 3; ++r) {
4359         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
4360 
4361         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4362         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4363       }
4364     }
4365     /* Hybrid faces have 2 vertices and the same cells */
4366     for (f = fMax; f < fEnd; ++f) {
4367       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
4368       PetscInt       size;
4369 
4370       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4371       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4372       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4373     }
4374     /* Hybrid cell faces have 2 vertices and 2 cells */
4375     for (c = cMax; c < cEnd; ++c) {
4376       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
4377 
4378       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4379       ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4380     }
4381     /* Old vertices have identical supports */
4382     for (v = vStart; v < vEnd; ++v) {
4383       const PetscInt newp = vStartNew + (v - vStart);
4384       PetscInt       size;
4385 
4386       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4387       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4388     }
4389     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
4390     for (f = fStart; f < fMax; ++f) {
4391       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4392       const PetscInt *support;
4393       PetscInt       size, newSize = 2, s;
4394 
4395       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4396       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4397       for (s = 0; s < size; ++s) {
4398         if (support[s] >= cMax) newSize += 1;
4399         else newSize += 2;
4400       }
4401       ierr = DMPlexSetSupportSize(rdm, newp, newSize);CHKERRQ(ierr);
4402     }
4403     break;
4404   default:
4405     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4406   }
4407   PetscFunctionReturn(0);
4408 }
4409 
4410 #undef __FUNCT__
4411 #define __FUNCT__ "CellRefinerSetCones"
4412 PetscErrorCode CellRefinerSetCones(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4413 {
4414   PetscInt       depth, cStart, cEnd, cMax, cStartNew, cEndNew, c, vStart, vEnd, vMax, vStartNew, vEndNew, v, fStart, fEnd, fMax, fStartNew, fEndNew, f, eStart, eEnd, eMax, eStartNew, eEndNew, r, p;
4415   PetscInt       maxSupportSize, *supportRef;
4416   PetscErrorCode ierr;
4417 
4418   PetscFunctionBegin;
4419   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4420   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4421   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4422   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4423   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4424   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4425   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4426   ierr = GetDepthEnd_Private(depth, depthSize, &cEndNew, &fEndNew, &eEndNew, &vEndNew);CHKERRQ(ierr);
4427   switch (refiner) {
4428   case 1:
4429     /* Simplicial 2D */
4430     /*
4431      2
4432      |\
4433      | \
4434      |  \
4435      |   \
4436      | C  \
4437      |     \
4438      |      \
4439      2---1---1
4440      |\  D  / \
4441      | 2   0   \
4442      |A \ /  B  \
4443      0---0-------1
4444      */
4445     /* All cells have 3 faces */
4446     for (c = cStart; c < cEnd; ++c) {
4447       const PetscInt  newp = cStartNew + (c - cStart)*4;
4448       const PetscInt *cone, *ornt;
4449       PetscInt        coneNew[3], orntNew[3];
4450 
4451       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4452       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4453       /* A triangle */
4454       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4455       orntNew[0] = ornt[0];
4456       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4457       orntNew[1] = -2;
4458       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4459       orntNew[2] = ornt[2];
4460       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4461       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4462 #if 1
4463       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4464       for (p = 0; p < 3; ++p) {
4465         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4466       }
4467 #endif
4468       /* B triangle */
4469       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4470       orntNew[0] = ornt[0];
4471       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4472       orntNew[1] = ornt[1];
4473       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4474       orntNew[2] = -2;
4475       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4476       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4477 #if 1
4478       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4479       for (p = 0; p < 3; ++p) {
4480         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4481       }
4482 #endif
4483       /* C triangle */
4484       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4485       orntNew[0] = -2;
4486       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4487       orntNew[1] = ornt[1];
4488       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4489       orntNew[2] = ornt[2];
4490       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4491       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4492 #if 1
4493       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
4494       for (p = 0; p < 3; ++p) {
4495         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4496       }
4497 #endif
4498       /* D triangle */
4499       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4500       orntNew[0] = 0;
4501       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4502       orntNew[1] = 0;
4503       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4504       orntNew[2] = 0;
4505       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4506       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4507 #if 1
4508       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
4509       for (p = 0; p < 3; ++p) {
4510         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4511       }
4512 #endif
4513     }
4514     /* Split faces have 2 vertices and the same cells as the parent */
4515     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4516     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4517     for (f = fStart; f < fEnd; ++f) {
4518       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4519 
4520       for (r = 0; r < 2; ++r) {
4521         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4522         const PetscInt *cone, *support;
4523         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4524 
4525         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4526         coneNew[0]       = vStartNew + (cone[0] - vStart);
4527         coneNew[1]       = vStartNew + (cone[1] - vStart);
4528         coneNew[(r+1)%2] = newv;
4529         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4530 #if 1
4531         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4532         for (p = 0; p < 2; ++p) {
4533           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4534         }
4535 #endif
4536         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4537         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4538         for (s = 0; s < supportSize; ++s) {
4539           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4540           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4541           for (c = 0; c < coneSize; ++c) {
4542             if (cone[c] == f) break;
4543           }
4544           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
4545         }
4546         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4547 #if 1
4548         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4549         for (p = 0; p < supportSize; ++p) {
4550           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
4551         }
4552 #endif
4553       }
4554     }
4555     /* Interior faces have 2 vertices and 2 cells */
4556     for (c = cStart; c < cEnd; ++c) {
4557       const PetscInt *cone;
4558 
4559       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4560       for (r = 0; r < 3; ++r) {
4561         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4562         PetscInt       coneNew[2];
4563         PetscInt       supportNew[2];
4564 
4565         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
4566         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
4567         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4568 #if 1
4569         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4570         for (p = 0; p < 2; ++p) {
4571           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4572         }
4573 #endif
4574         supportNew[0] = (c - cStart)*4 + (r+1)%3;
4575         supportNew[1] = (c - cStart)*4 + 3;
4576         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4577 #if 1
4578         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4579         for (p = 0; p < 2; ++p) {
4580           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
4581         }
4582 #endif
4583       }
4584     }
4585     /* Old vertices have identical supports */
4586     for (v = vStart; v < vEnd; ++v) {
4587       const PetscInt  newp = vStartNew + (v - vStart);
4588       const PetscInt *support, *cone;
4589       PetscInt        size, s;
4590 
4591       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4592       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
4593       for (s = 0; s < size; ++s) {
4594         PetscInt r = 0;
4595 
4596         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4597         if (cone[1] == v) r = 1;
4598         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
4599       }
4600       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4601 #if 1
4602       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4603       for (p = 0; p < size; ++p) {
4604         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4605       }
4606 #endif
4607     }
4608     /* Face vertices have 2 + cells*2 supports */
4609     for (f = fStart; f < fEnd; ++f) {
4610       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
4611       const PetscInt *cone, *support;
4612       PetscInt        size, s;
4613 
4614       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4615       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4616       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
4617       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
4618       for (s = 0; s < size; ++s) {
4619         PetscInt r = 0;
4620 
4621         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4622         if      (cone[1] == f) r = 1;
4623         else if (cone[2] == f) r = 2;
4624         supportRef[2+s*2+0] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
4625         supportRef[2+s*2+1] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + r;
4626       }
4627       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4628 #if 1
4629       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4630       for (p = 0; p < 2+size*2; ++p) {
4631         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4632       }
4633 #endif
4634     }
4635     ierr = PetscFree(supportRef);CHKERRQ(ierr);
4636     break;
4637   case 2:
4638     /* Hex 2D */
4639     /*
4640      3---------2---------2
4641      |         |         |
4642      |    D    2    C    |
4643      |         |         |
4644      3----3----0----1----1
4645      |         |         |
4646      |    A    0    B    |
4647      |         |         |
4648      0---------0---------1
4649      */
4650     /* All cells have 4 faces */
4651     for (c = cStart; c < cEnd; ++c) {
4652       const PetscInt  newp = (c - cStart)*4;
4653       const PetscInt *cone, *ornt;
4654       PetscInt        coneNew[4], orntNew[4];
4655 
4656       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4657       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4658       /* A quad */
4659       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4660       orntNew[0] = ornt[0];
4661       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4662       orntNew[1] = 0;
4663       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4664       orntNew[2] = -2;
4665       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 0 : 1);
4666       orntNew[3] = ornt[3];
4667       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4668       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4669 #if 1
4670       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4671       for (p = 0; p < 4; ++p) {
4672         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4673       }
4674 #endif
4675       /* B quad */
4676       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4677       orntNew[0] = ornt[0];
4678       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4679       orntNew[1] = ornt[1];
4680       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4681       orntNew[2] = 0;
4682       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4683       orntNew[3] = -2;
4684       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4685       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4686 #if 1
4687       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4688       for (p = 0; p < 4; ++p) {
4689         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4690       }
4691 #endif
4692       /* C quad */
4693       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4694       orntNew[0] = -2;
4695       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4696       orntNew[1] = ornt[1];
4697       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4698       orntNew[2] = ornt[2];
4699       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4700       orntNew[3] = 0;
4701       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4702       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4703 #if 1
4704       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
4705       for (p = 0; p < 4; ++p) {
4706         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4707       }
4708 #endif
4709       /* D quad */
4710       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4711       orntNew[0] = 0;
4712       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4713       orntNew[1] = -2;
4714       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4715       orntNew[2] = ornt[2];
4716       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 1 : 0);
4717       orntNew[3] = ornt[3];
4718       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4719       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4720 #if 1
4721       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
4722       for (p = 0; p < 4; ++p) {
4723         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4724       }
4725 #endif
4726     }
4727     /* Split faces have 2 vertices and the same cells as the parent */
4728     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4729     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4730     for (f = fStart; f < fEnd; ++f) {
4731       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4732 
4733       for (r = 0; r < 2; ++r) {
4734         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4735         const PetscInt *cone, *support;
4736         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4737 
4738         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4739         coneNew[0]       = vStartNew + (cone[0] - vStart);
4740         coneNew[1]       = vStartNew + (cone[1] - vStart);
4741         coneNew[(r+1)%2] = newv;
4742         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4743 #if 1
4744         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4745         for (p = 0; p < 2; ++p) {
4746           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4747         }
4748 #endif
4749         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4750         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4751         for (s = 0; s < supportSize; ++s) {
4752           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4753           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4754           for (c = 0; c < coneSize; ++c) {
4755             if (cone[c] == f) break;
4756           }
4757           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%4;
4758         }
4759         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4760 #if 1
4761         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4762         for (p = 0; p < supportSize; ++p) {
4763           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
4764         }
4765 #endif
4766       }
4767     }
4768     /* Interior faces have 2 vertices and 2 cells */
4769     for (c = cStart; c < cEnd; ++c) {
4770       const PetscInt *cone;
4771       PetscInt        coneNew[2], supportNew[2];
4772 
4773       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4774       for (r = 0; r < 4; ++r) {
4775         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4776 
4777         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r] - fStart);
4778         coneNew[1] = vStartNew + (vEnd - vStart) + (fEnd    - fStart) + (c - cStart);
4779         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4780 #if 1
4781         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4782         for (p = 0; p < 2; ++p) {
4783           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4784         }
4785 #endif
4786         supportNew[0] = (c - cStart)*4 + r;
4787         supportNew[1] = (c - cStart)*4 + (r+1)%4;
4788         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4789 #if 1
4790         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4791         for (p = 0; p < 2; ++p) {
4792           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
4793         }
4794 #endif
4795       }
4796     }
4797     /* Old vertices have identical supports */
4798     for (v = vStart; v < vEnd; ++v) {
4799       const PetscInt  newp = vStartNew + (v - vStart);
4800       const PetscInt *support, *cone;
4801       PetscInt        size, s;
4802 
4803       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4804       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
4805       for (s = 0; s < size; ++s) {
4806         PetscInt r = 0;
4807 
4808         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4809         if (cone[1] == v) r = 1;
4810         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
4811       }
4812       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4813 #if 1
4814       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4815       for (p = 0; p < size; ++p) {
4816         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4817       }
4818 #endif
4819     }
4820     /* Face vertices have 2 + cells supports */
4821     for (f = fStart; f < fEnd; ++f) {
4822       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
4823       const PetscInt *cone, *support;
4824       PetscInt        size, s;
4825 
4826       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4827       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4828       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
4829       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
4830       for (s = 0; s < size; ++s) {
4831         PetscInt r = 0;
4832 
4833         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4834         if      (cone[1] == f) r = 1;
4835         else if (cone[2] == f) r = 2;
4836         else if (cone[3] == f) r = 3;
4837         supportRef[2+s] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*4 + r;
4838       }
4839       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4840 #if 1
4841       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4842       for (p = 0; p < 2+size; ++p) {
4843         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4844       }
4845 #endif
4846     }
4847     /* Cell vertices have 4 supports */
4848     for (c = cStart; c < cEnd; ++c) {
4849       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
4850       PetscInt       supportNew[4];
4851 
4852       for (r = 0; r < 4; ++r) {
4853         supportNew[r] = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4854       }
4855       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4856     }
4857     break;
4858   case 3:
4859     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4860     cMax = PetscMin(cEnd, cMax);
4861     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4862     fMax = PetscMin(fEnd, fMax);
4863     /* Interior cells have 3 faces */
4864     for (c = cStart; c < cMax; ++c) {
4865       const PetscInt  newp = cStartNew + (c - cStart)*4;
4866       const PetscInt *cone, *ornt;
4867       PetscInt        coneNew[3], orntNew[3];
4868 
4869       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4870       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4871       /* A triangle */
4872       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4873       orntNew[0] = ornt[0];
4874       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
4875       orntNew[1] = -2;
4876       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4877       orntNew[2] = ornt[2];
4878       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4879       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4880 #if 1
4881       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4882       for (p = 0; p < 3; ++p) {
4883         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4884       }
4885 #endif
4886       /* B triangle */
4887       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4888       orntNew[0] = ornt[0];
4889       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4890       orntNew[1] = ornt[1];
4891       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
4892       orntNew[2] = -2;
4893       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4894       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4895 #if 1
4896       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4897       for (p = 0; p < 3; ++p) {
4898         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4899       }
4900 #endif
4901       /* C triangle */
4902       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
4903       orntNew[0] = -2;
4904       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4905       orntNew[1] = ornt[1];
4906       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4907       orntNew[2] = ornt[2];
4908       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4909       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4910 #if 1
4911       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
4912       for (p = 0; p < 3; ++p) {
4913         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4914       }
4915 #endif
4916       /* D triangle */
4917       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
4918       orntNew[0] = 0;
4919       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
4920       orntNew[1] = 0;
4921       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
4922       orntNew[2] = 0;
4923       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4924       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4925 #if 1
4926       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
4927       for (p = 0; p < 3; ++p) {
4928         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4929       }
4930 #endif
4931     }
4932     /*
4933      2----3----3
4934      |         |
4935      |    B    |
4936      |         |
4937      0----4--- 1
4938      |         |
4939      |    A    |
4940      |         |
4941      0----2----1
4942      */
4943     /* Hybrid cells have 4 faces */
4944     for (c = cMax; c < cEnd; ++c) {
4945       const PetscInt  newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2;
4946       const PetscInt *cone, *ornt;
4947       PetscInt        coneNew[4], orntNew[4];
4948 
4949       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4950       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4951       /* A quad */
4952       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4953       orntNew[0] = ornt[0];
4954       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4955       orntNew[1] = ornt[1];
4956       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[2] - fMax);
4957       orntNew[2] = 0;
4958       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
4959       orntNew[3] = 0;
4960       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4961       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4962 #if 1
4963       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4964       for (p = 0; p < 4; ++p) {
4965         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4966       }
4967 #endif
4968       /* B quad */
4969       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4970       orntNew[0] = ornt[0];
4971       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4972       orntNew[1] = ornt[1];
4973       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
4974       orntNew[2] = 0;
4975       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[3] - fMax);
4976       orntNew[3] = 0;
4977       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4978       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4979 #if 1
4980       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4981       for (p = 0; p < 4; ++p) {
4982         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4983       }
4984 #endif
4985     }
4986     /* Interior split faces have 2 vertices and the same cells as the parent */
4987     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4988     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4989     for (f = fStart; f < fMax; ++f) {
4990       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4991 
4992       for (r = 0; r < 2; ++r) {
4993         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4994         const PetscInt *cone, *support;
4995         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4996 
4997         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4998         coneNew[0]       = vStartNew + (cone[0] - vStart);
4999         coneNew[1]       = vStartNew + (cone[1] - vStart);
5000         coneNew[(r+1)%2] = newv;
5001         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5002 #if 1
5003         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5004         for (p = 0; p < 2; ++p) {
5005           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5006         }
5007 #endif
5008         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
5009         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5010         for (s = 0; s < supportSize; ++s) {
5011           if (support[s] >= cMax) {
5012             supportRef[s] = cStartNew + (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
5013           } else {
5014             ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5015             ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5016             for (c = 0; c < coneSize; ++c) {
5017               if (cone[c] == f) break;
5018             }
5019             supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
5020           }
5021         }
5022         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5023 #if 1
5024         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5025         for (p = 0; p < supportSize; ++p) {
5026           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
5027         }
5028 #endif
5029       }
5030     }
5031     /* Interior cell faces have 2 vertices and 2 cells */
5032     for (c = cStart; c < cMax; ++c) {
5033       const PetscInt *cone;
5034 
5035       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5036       for (r = 0; r < 3; ++r) {
5037         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
5038         PetscInt       coneNew[2];
5039         PetscInt       supportNew[2];
5040 
5041         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
5042         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
5043         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5044 #if 1
5045         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5046         for (p = 0; p < 2; ++p) {
5047           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5048         }
5049 #endif
5050         supportNew[0] = (c - cStart)*4 + (r+1)%3;
5051         supportNew[1] = (c - cStart)*4 + 3;
5052         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5053 #if 1
5054         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5055         for (p = 0; p < 2; ++p) {
5056           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5057         }
5058 #endif
5059       }
5060     }
5061     /* Interior hybrid faces have 2 vertices and the same cells */
5062     for (f = fMax; f < fEnd; ++f) {
5063       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
5064       const PetscInt *cone;
5065       const PetscInt *support;
5066       PetscInt        coneNew[2];
5067       PetscInt        supportNew[2];
5068       PetscInt        size, s, r;
5069 
5070       ierr       = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5071       coneNew[0] = vStartNew + (cone[0] - vStart);
5072       coneNew[1] = vStartNew + (cone[1] - vStart);
5073       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5074 #if 1
5075       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5076       for (p = 0; p < 2; ++p) {
5077         if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5078       }
5079 #endif
5080       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5081       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5082       for (s = 0; s < size; ++s) {
5083         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5084         for (r = 0; r < 2; ++r) {
5085           if (cone[r+2] == f) break;
5086         }
5087         supportNew[s] = (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
5088       }
5089       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5090 #if 1
5091       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5092       for (p = 0; p < size; ++p) {
5093         if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5094       }
5095 #endif
5096     }
5097     /* Cell hybrid faces have 2 vertices and 2 cells */
5098     for (c = cMax; c < cEnd; ++c) {
5099       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
5100       const PetscInt *cone;
5101       PetscInt        coneNew[2];
5102       PetscInt        supportNew[2];
5103 
5104       ierr       = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5105       coneNew[0] = vStartNew + (vEnd - vStart) + (cone[0] - fStart);
5106       coneNew[1] = vStartNew + (vEnd - vStart) + (cone[1] - fStart);
5107       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5108 #if 1
5109       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5110       for (p = 0; p < 2; ++p) {
5111         if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5112       }
5113 #endif
5114       supportNew[0] = (cMax - cStart)*4 + (c - cMax)*2 + 0;
5115       supportNew[1] = (cMax - cStart)*4 + (c - cMax)*2 + 1;
5116       ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5117 #if 1
5118       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5119       for (p = 0; p < 2; ++p) {
5120         if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5121       }
5122 #endif
5123     }
5124     /* Old vertices have identical supports */
5125     for (v = vStart; v < vEnd; ++v) {
5126       const PetscInt  newp = vStartNew + (v - vStart);
5127       const PetscInt *support, *cone;
5128       PetscInt        size, s;
5129 
5130       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
5131       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
5132       for (s = 0; s < size; ++s) {
5133         if (support[s] >= fMax) {
5134           supportRef[s] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (support[s] - fMax);
5135         } else {
5136           PetscInt r = 0;
5137 
5138           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5139           if (cone[1] == v) r = 1;
5140           supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
5141         }
5142       }
5143       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5144 #if 1
5145       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5146       for (p = 0; p < size; ++p) {
5147         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5148       }
5149 #endif
5150     }
5151     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
5152     for (f = fStart; f < fMax; ++f) {
5153       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
5154       const PetscInt *cone, *support;
5155       PetscInt        size, newSize = 2, s;
5156 
5157       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5158       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5159       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
5160       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
5161       for (s = 0; s < size; ++s) {
5162         PetscInt r = 0;
5163 
5164         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5165         if (support[s] >= cMax) {
5166           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (support[s] - cMax);
5167 
5168           newSize += 1;
5169         } else {
5170           if      (cone[1] == f) r = 1;
5171           else if (cone[2] == f) r = 2;
5172           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
5173           supportRef[newSize+1] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + r;
5174 
5175           newSize += 2;
5176         }
5177       }
5178       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5179 #if 1
5180       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5181       for (p = 0; p < newSize; ++p) {
5182         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5183       }
5184 #endif
5185     }
5186     ierr = PetscFree(supportRef);CHKERRQ(ierr);
5187     break;
5188   default:
5189     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5190   }
5191   PetscFunctionReturn(0);
5192 }
5193 
5194 #undef __FUNCT__
5195 #define __FUNCT__ "CellRefinerSetCoordinates"
5196 PetscErrorCode CellRefinerSetCoordinates(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5197 {
5198   PetscSection   coordSection, coordSectionNew;
5199   Vec            coordinates, coordinatesNew;
5200   PetscScalar   *coords, *coordsNew;
5201   PetscInt       dim, depth, coordSizeNew, cStart, cEnd, c, vStart, vStartNew, vEnd, v, fStart, fEnd, fMax, f;
5202   PetscErrorCode ierr;
5203 
5204   PetscFunctionBegin;
5205   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5206   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5207   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5208   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5209   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5210   ierr = DMPlexGetHybridBounds(dm, NULL, &fMax, NULL, NULL);CHKERRQ(ierr);
5211   ierr = GetDepthStart_Private(depth, depthSize, NULL, NULL, NULL, &vStartNew);CHKERRQ(ierr);
5212   ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
5213   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &coordSectionNew);CHKERRQ(ierr);
5214   ierr = PetscSectionSetNumFields(coordSectionNew, 1);CHKERRQ(ierr);
5215   ierr = PetscSectionSetFieldComponents(coordSectionNew, 0, dim);CHKERRQ(ierr);
5216   ierr = PetscSectionSetChart(coordSectionNew, vStartNew, vStartNew+depthSize[0]);CHKERRQ(ierr);
5217   if (fMax < 0) fMax = fEnd;
5218   switch (refiner) {
5219   case 1:
5220   case 2:
5221   case 3:
5222     /* Simplicial and Hex 2D */
5223     /* All vertices have the dim coordinates */
5224     for (v = vStartNew; v < vStartNew+depthSize[0]; ++v) {
5225       ierr = PetscSectionSetDof(coordSectionNew, v, dim);CHKERRQ(ierr);
5226       ierr = PetscSectionSetFieldDof(coordSectionNew, v, 0, dim);CHKERRQ(ierr);
5227     }
5228     ierr = PetscSectionSetUp(coordSectionNew);CHKERRQ(ierr);
5229     ierr = DMPlexSetCoordinateSection(rdm, coordSectionNew);CHKERRQ(ierr);
5230     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
5231     ierr = PetscSectionGetStorageSize(coordSectionNew, &coordSizeNew);CHKERRQ(ierr);
5232     ierr = VecCreate(PetscObjectComm((PetscObject)dm), &coordinatesNew);CHKERRQ(ierr);
5233     ierr = PetscObjectSetName((PetscObject) coordinatesNew, "coordinates");CHKERRQ(ierr);
5234     ierr = VecSetSizes(coordinatesNew, coordSizeNew, PETSC_DETERMINE);CHKERRQ(ierr);
5235     ierr = VecSetFromOptions(coordinatesNew);CHKERRQ(ierr);
5236     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
5237     ierr = VecGetArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5238     /* Old vertices have the same coordinates */
5239     for (v = vStart; v < vEnd; ++v) {
5240       const PetscInt newv = vStartNew + (v - vStart);
5241       PetscInt       off, offnew, d;
5242 
5243       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
5244       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5245       for (d = 0; d < dim; ++d) {
5246         coordsNew[offnew+d] = coords[off+d];
5247       }
5248     }
5249     /* Face vertices have the average of endpoint coordinates */
5250     for (f = fStart; f < fMax; ++f) {
5251       const PetscInt  newv = vStartNew + (vEnd - vStart) + (f - fStart);
5252       const PetscInt *cone;
5253       PetscInt        coneSize, offA, offB, offnew, d;
5254 
5255       ierr = DMPlexGetConeSize(dm, f, &coneSize);CHKERRQ(ierr);
5256       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Face %d cone should have two vertices, not %d", f, coneSize);
5257       ierr = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5258       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5259       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5260       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5261       for (d = 0; d < dim; ++d) {
5262         coordsNew[offnew+d] = 0.5*(coords[offA+d] + coords[offB+d]);
5263       }
5264     }
5265     /* Just Hex 2D */
5266     if (refiner == 2) {
5267       /* Cell vertices have the average of corner coordinates */
5268       for (c = cStart; c < cEnd; ++c) {
5269         const PetscInt newv = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
5270         PetscInt      *cone = NULL;
5271         PetscInt       closureSize, coneSize = 0, offA, offB, offC, offD, offnew, p, d;
5272 
5273         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5274         for (p = 0; p < closureSize*2; p += 2) {
5275           const PetscInt point = cone[p];
5276           if ((point >= vStart) && (point < vEnd)) cone[coneSize++] = point;
5277         }
5278         if (coneSize != 4) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Quad %d cone should have four vertices, not %d", c, coneSize);
5279         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5280         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5281         ierr = PetscSectionGetOffset(coordSection, cone[2], &offC);CHKERRQ(ierr);
5282         ierr = PetscSectionGetOffset(coordSection, cone[3], &offD);CHKERRQ(ierr);
5283         ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5284         for (d = 0; d < dim; ++d) {
5285           coordsNew[offnew+d] = 0.25*(coords[offA+d] + coords[offB+d] + coords[offC+d] + coords[offD+d]);
5286         }
5287         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5288       }
5289     }
5290     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
5291     ierr = VecRestoreArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5292     ierr = DMSetCoordinatesLocal(rdm, coordinatesNew);CHKERRQ(ierr);
5293     ierr = VecDestroy(&coordinatesNew);CHKERRQ(ierr);
5294     ierr = PetscSectionDestroy(&coordSectionNew);CHKERRQ(ierr);
5295     break;
5296   default:
5297     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5298   }
5299   PetscFunctionReturn(0);
5300 }
5301 
5302 #undef __FUNCT__
5303 #define __FUNCT__ "DMPlexCreateProcessSF"
5304 PetscErrorCode DMPlexCreateProcessSF(DM dm, PetscSF sfPoint, IS *processRanks, PetscSF *sfProcess)
5305 {
5306   PetscInt           numRoots, numLeaves, l;
5307   const PetscInt    *localPoints;
5308   const PetscSFNode *remotePoints;
5309   PetscInt          *localPointsNew;
5310   PetscSFNode       *remotePointsNew;
5311   PetscInt          *ranks, *ranksNew;
5312   PetscErrorCode     ierr;
5313 
5314   PetscFunctionBegin;
5315   ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5316   ierr = PetscMalloc(numLeaves * sizeof(PetscInt), &ranks);CHKERRQ(ierr);
5317   for (l = 0; l < numLeaves; ++l) {
5318     ranks[l] = remotePoints[l].rank;
5319   }
5320   ierr = PetscSortRemoveDupsInt(&numLeaves, ranks);CHKERRQ(ierr);
5321   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &ranksNew);CHKERRQ(ierr);
5322   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5323   ierr = PetscMalloc(numLeaves * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5324   for (l = 0; l < numLeaves; ++l) {
5325     ranksNew[l]              = ranks[l];
5326     localPointsNew[l]        = l;
5327     remotePointsNew[l].index = 0;
5328     remotePointsNew[l].rank  = ranksNew[l];
5329   }
5330   ierr = PetscFree(ranks);CHKERRQ(ierr);
5331   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), numLeaves, ranksNew, PETSC_OWN_POINTER, processRanks);CHKERRQ(ierr);
5332   ierr = PetscSFCreate(PetscObjectComm((PetscObject)dm), sfProcess);CHKERRQ(ierr);
5333   ierr = PetscSFSetFromOptions(*sfProcess);CHKERRQ(ierr);
5334   ierr = PetscSFSetGraph(*sfProcess, 1, numLeaves, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5335   PetscFunctionReturn(0);
5336 }
5337 
5338 #undef __FUNCT__
5339 #define __FUNCT__ "CellRefinerCreateSF"
5340 PetscErrorCode CellRefinerCreateSF(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5341 {
5342   PetscSF            sf, sfNew, sfProcess;
5343   IS                 processRanks;
5344   MPI_Datatype       depthType;
5345   PetscInt           numRoots, numLeaves, numLeavesNew = 0, l, m;
5346   const PetscInt    *localPoints, *neighbors;
5347   const PetscSFNode *remotePoints;
5348   PetscInt          *localPointsNew;
5349   PetscSFNode       *remotePointsNew;
5350   PetscInt          *depthSizeOld, *rdepthSize, *rdepthSizeOld, *rdepthMaxOld, *rvStart, *rvStartNew, *reStart, *reStartNew, *rfStart, *rfStartNew, *rcStart, *rcStartNew;
5351   PetscInt           depth, numNeighbors, pStartNew, pEndNew, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eStartNew, eEnd, eMax, r, n;
5352   PetscErrorCode     ierr;
5353 
5354   PetscFunctionBegin;
5355   ierr = DMPlexGetChart(rdm, &pStartNew, &pEndNew);CHKERRQ(ierr);
5356   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5357   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5358   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5359   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5360   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5361   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5362   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
5363   switch (refiner) {
5364   case 3:
5365     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5366     cMax = PetscMin(cEnd, cMax);
5367     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5368     fMax = PetscMin(fEnd, fMax);
5369   }
5370   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
5371   ierr = DMGetPointSF(rdm, &sfNew);CHKERRQ(ierr);
5372   /* Caculate size of new SF */
5373   ierr = PetscSFGetGraph(sf, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5374   if (numRoots < 0) PetscFunctionReturn(0);
5375   for (l = 0; l < numLeaves; ++l) {
5376     const PetscInt p = localPoints[l];
5377 
5378     switch (refiner) {
5379     case 1:
5380       /* Simplicial 2D */
5381       if ((p >= vStart) && (p < vEnd)) {
5382         /* Old vertices stay the same */
5383         ++numLeavesNew;
5384       } else if ((p >= fStart) && (p < fEnd)) {
5385         /* Old faces add new faces and vertex */
5386         numLeavesNew += 1 + 2;
5387       } else if ((p >= cStart) && (p < cEnd)) {
5388         /* Old cells add new cells and interior faces */
5389         numLeavesNew += 4 + 3;
5390       }
5391       break;
5392     case 2:
5393       /* Hex 2D */
5394       if ((p >= vStart) && (p < vEnd)) {
5395         /* Old vertices stay the same */
5396         ++numLeavesNew;
5397       } else if ((p >= fStart) && (p < fEnd)) {
5398         /* Old faces add new faces and vertex */
5399         numLeavesNew += 1 + 2;
5400       } else if ((p >= cStart) && (p < cEnd)) {
5401         /* Old cells add new cells and interior faces */
5402         numLeavesNew += 4 + 4;
5403       }
5404       break;
5405     default:
5406       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5407     }
5408   }
5409   /* Communicate depthSizes for each remote rank */
5410   ierr = DMPlexCreateProcessSF(dm, sf, &processRanks, &sfProcess);CHKERRQ(ierr);
5411   ierr = ISGetLocalSize(processRanks, &numNeighbors);CHKERRQ(ierr);
5412   ierr = PetscMalloc5((depth+1)*numNeighbors,PetscInt,&rdepthSize,numNeighbors,PetscInt,&rvStartNew,numNeighbors,PetscInt,&reStartNew,numNeighbors,PetscInt,&rfStartNew,numNeighbors,PetscInt,&rcStartNew);CHKERRQ(ierr);
5413   ierr = PetscMalloc7(depth+1,PetscInt,&depthSizeOld,(depth+1)*numNeighbors,PetscInt,&rdepthSizeOld,(depth+1)*numNeighbors,PetscInt,&rdepthMaxOld,numNeighbors,PetscInt,&rvStart,numNeighbors,PetscInt,&reStart,numNeighbors,PetscInt,&rfStart,numNeighbors,PetscInt,&rcStart);CHKERRQ(ierr);
5414   ierr = MPI_Type_contiguous(depth+1, MPIU_INT, &depthType);CHKERRQ(ierr);
5415   ierr = MPI_Type_commit(&depthType);CHKERRQ(ierr);
5416   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5417   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5418   for (n = 0; n < numNeighbors; ++n) {
5419     ierr = GetDepthStart_Private(depth, &rdepthSize[n*(depth+1)], &rcStartNew[n], &rfStartNew[n], &reStartNew[n], &rvStartNew[n]);CHKERRQ(ierr);
5420   }
5421   depthSizeOld[depth]   = cMax;
5422   depthSizeOld[0]       = vMax;
5423   depthSizeOld[depth-1] = fMax;
5424   depthSizeOld[1]       = eMax;
5425 
5426   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5427   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5428 
5429   depthSizeOld[depth]   = cEnd - cStart;
5430   depthSizeOld[0]       = vEnd - vStart;
5431   depthSizeOld[depth-1] = fEnd - fStart;
5432   depthSizeOld[1]       = eEnd - eStart;
5433 
5434   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5435   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5436   for (n = 0; n < numNeighbors; ++n) {
5437     ierr = GetDepthStart_Private(depth, &rdepthSizeOld[n*(depth+1)], &rcStart[n], &rfStart[n], &reStart[n], &rvStart[n]);CHKERRQ(ierr);
5438   }
5439   ierr = MPI_Type_free(&depthType);CHKERRQ(ierr);
5440   ierr = PetscSFDestroy(&sfProcess);CHKERRQ(ierr);
5441   /* Calculate new point SF */
5442   ierr = PetscMalloc(numLeavesNew * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5443   ierr = PetscMalloc(numLeavesNew * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5444   ierr = ISGetIndices(processRanks, &neighbors);CHKERRQ(ierr);
5445   for (l = 0, m = 0; l < numLeaves; ++l) {
5446     PetscInt    p     = localPoints[l];
5447     PetscInt    rp    = remotePoints[l].index, n;
5448     PetscMPIInt rrank = remotePoints[l].rank;
5449 
5450     ierr = PetscFindInt(rrank, numNeighbors, neighbors, &n);CHKERRQ(ierr);
5451     if (n < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Could not locate remote rank %d", rrank);
5452     switch (refiner) {
5453     case 1:
5454       /* Simplicial 2D */
5455       if ((p >= vStart) && (p < vEnd)) {
5456         /* Old vertices stay the same */
5457         localPointsNew[m]        = vStartNew     + (p  - vStart);
5458         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5459         remotePointsNew[m].rank  = rrank;
5460         ++m;
5461       } else if ((p >= fStart) && (p < fEnd)) {
5462         /* Old faces add new faces and vertex */
5463         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5464         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5465         remotePointsNew[m].rank  = rrank;
5466         ++m;
5467         for (r = 0; r < 2; ++r, ++m) {
5468           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5469           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5470           remotePointsNew[m].rank  = rrank;
5471         }
5472       } else if ((p >= cStart) && (p < cEnd)) {
5473         /* Old cells add new cells and interior faces */
5474         for (r = 0; r < 4; ++r, ++m) {
5475           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5476           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5477           remotePointsNew[m].rank  = rrank;
5478         }
5479         for (r = 0; r < 3; ++r, ++m) {
5480           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*3     + r;
5481           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*3 + r;
5482           remotePointsNew[m].rank  = rrank;
5483         }
5484       }
5485       break;
5486     case 2:
5487       /* Hex 2D */
5488       if ((p >= vStart) && (p < vEnd)) {
5489         /* Old vertices stay the same */
5490         localPointsNew[m]        = vStartNew     + (p  - vStart);
5491         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5492         remotePointsNew[m].rank  = rrank;
5493         ++m;
5494       } else if ((p >= fStart) && (p < fEnd)) {
5495         /* Old faces add new faces and vertex */
5496         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5497         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5498         remotePointsNew[m].rank  = rrank;
5499         ++m;
5500         for (r = 0; r < 2; ++r, ++m) {
5501           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5502           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5503           remotePointsNew[m].rank  = rrank;
5504         }
5505       } else if ((p >= cStart) && (p < cEnd)) {
5506         /* Old cells add new cells and interior faces */
5507         for (r = 0; r < 4; ++r, ++m) {
5508           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5509           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5510           remotePointsNew[m].rank  = rrank;
5511         }
5512         for (r = 0; r < 4; ++r, ++m) {
5513           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*4     + r;
5514           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*4 + r;
5515           remotePointsNew[m].rank  = rrank;
5516         }
5517       }
5518       break;
5519     case 3:
5520       /* Hybrid simplicial 2D */
5521       if ((p >= vStart) && (p < vEnd)) {
5522         /* Old vertices stay the same */
5523         localPointsNew[m]        = vStartNew     + (p  - vStart);
5524         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5525         remotePointsNew[m].rank  = rrank;
5526         ++m;
5527       } else if ((p >= fStart) && (p < fMax)) {
5528         /* Old interior faces add new faces and vertex */
5529         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5530         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5531         remotePointsNew[m].rank  = rrank;
5532         ++m;
5533         for (r = 0; r < 2; ++r, ++m) {
5534           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5535           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5536           remotePointsNew[m].rank  = rrank;
5537         }
5538       } else if ((p >= fMax) && (p < fEnd)) {
5539         /* Old hybrid faces stay the same */
5540         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - fMax);
5541         remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rdepthMaxOld[n*(depth+1)+depth-1]);
5542         remotePointsNew[m].rank  = rrank;
5543         ++m;
5544       } else if ((p >= cStart) && (p < cMax)) {
5545         /* Old interior cells add new cells and interior faces */
5546         for (r = 0; r < 4; ++r, ++m) {
5547           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5548           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5549           remotePointsNew[m].rank  = rrank;
5550         }
5551         for (r = 0; r < 3; ++r, ++m) {
5552           localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - cStart)*3     + r;
5553           remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rcStart[n])*3 + r;
5554           remotePointsNew[m].rank  = rrank;
5555         }
5556       } else if ((p >= cStart) && (p < cMax)) {
5557         /* Old hybrid cells add new cells and hybrid face */
5558         for (r = 0; r < 2; ++r, ++m) {
5559           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5560           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5561           remotePointsNew[m].rank  = rrank;
5562         }
5563         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (cMax                            - cStart)*3     + (p  - cMax);
5564         remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rdepthMaxOld[n*(depth+1)+depth] - rcStart[n])*3 + (rp - rdepthMaxOld[n*(depth+1)+depth]);
5565         remotePointsNew[m].rank  = rrank;
5566         ++m;
5567       }
5568       break;
5569     default:
5570       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5571     }
5572   }
5573   ierr = ISRestoreIndices(processRanks, &neighbors);CHKERRQ(ierr);
5574   ierr = ISDestroy(&processRanks);CHKERRQ(ierr);
5575   ierr = PetscSFSetGraph(sfNew, pEndNew-pStartNew, numLeavesNew, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5576   ierr = PetscFree5(rdepthSize,rvStartNew,reStartNew,rfStartNew,rcStartNew);CHKERRQ(ierr);
5577   ierr = PetscFree6(depthSizeOld,rdepthSizeOld,rvStart,reStart,rfStart,rcStart);CHKERRQ(ierr);
5578   PetscFunctionReturn(0);
5579 }
5580 
5581 #undef __FUNCT__
5582 #define __FUNCT__ "CellRefinerCreateLabels"
5583 PetscErrorCode CellRefinerCreateLabels(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5584 {
5585   PetscInt       numLabels, l;
5586   PetscInt       newp, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eEnd, eMax, r;
5587   PetscErrorCode ierr;
5588 
5589   PetscFunctionBegin;
5590   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5591   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5592   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5593   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5594 
5595   cStartNew = 0;
5596   vStartNew = depthSize[2];
5597   fStartNew = depthSize[2] + depthSize[0];
5598 
5599   ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
5600   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5601   switch (refiner) {
5602   case 3:
5603     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5604     cMax = PetscMin(cEnd, cMax);
5605     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5606     fMax = PetscMin(fEnd, fMax);
5607   }
5608   for (l = 0; l < numLabels; ++l) {
5609     DMLabel         label, labelNew;
5610     const char     *lname;
5611     PetscBool       isDepth;
5612     IS              valueIS;
5613     const PetscInt *values;
5614     PetscInt        numValues, val;
5615 
5616     ierr = DMPlexGetLabelName(dm, l, &lname);CHKERRQ(ierr);
5617     ierr = PetscStrcmp(lname, "depth", &isDepth);CHKERRQ(ierr);
5618     if (isDepth) continue;
5619     ierr = DMPlexCreateLabel(rdm, lname);CHKERRQ(ierr);
5620     ierr = DMPlexGetLabel(dm, lname, &label);CHKERRQ(ierr);
5621     ierr = DMPlexGetLabel(rdm, lname, &labelNew);CHKERRQ(ierr);
5622     ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
5623     ierr = ISGetLocalSize(valueIS, &numValues);CHKERRQ(ierr);
5624     ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
5625     for (val = 0; val < numValues; ++val) {
5626       IS              pointIS;
5627       const PetscInt *points;
5628       PetscInt        numPoints, n;
5629 
5630       ierr = DMLabelGetStratumIS(label, values[val], &pointIS);CHKERRQ(ierr);
5631       ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
5632       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
5633       for (n = 0; n < numPoints; ++n) {
5634         const PetscInt p = points[n];
5635         switch (refiner) {
5636         case 1:
5637           /* Simplicial 2D */
5638           if ((p >= vStart) && (p < vEnd)) {
5639             /* Old vertices stay the same */
5640             newp = vStartNew + (p - vStart);
5641             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5642           } else if ((p >= fStart) && (p < fEnd)) {
5643             /* Old faces add new faces and vertex */
5644             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5645             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5646             for (r = 0; r < 2; ++r) {
5647               newp = fStartNew + (p - fStart)*2 + r;
5648               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5649             }
5650           } else if ((p >= cStart) && (p < cEnd)) {
5651             /* Old cells add new cells and interior faces */
5652             for (r = 0; r < 4; ++r) {
5653               newp = cStartNew + (p - cStart)*4 + r;
5654               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5655             }
5656             for (r = 0; r < 3; ++r) {
5657               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
5658               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5659             }
5660           }
5661           break;
5662         case 2:
5663           /* Hex 2D */
5664           if ((p >= vStart) && (p < vEnd)) {
5665             /* Old vertices stay the same */
5666             newp = vStartNew + (p - vStart);
5667             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5668           } else if ((p >= fStart) && (p < fEnd)) {
5669             /* Old faces add new faces and vertex */
5670             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5671             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5672             for (r = 0; r < 2; ++r) {
5673               newp = fStartNew + (p - fStart)*2 + r;
5674               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5675             }
5676           } else if ((p >= cStart) && (p < cEnd)) {
5677             /* Old cells add new cells and interior faces and vertex */
5678             for (r = 0; r < 4; ++r) {
5679               newp = cStartNew + (p - cStart)*4 + r;
5680               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5681             }
5682             for (r = 0; r < 4; ++r) {
5683               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*4 + r;
5684               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5685             }
5686             newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (p - cStart);
5687             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5688           }
5689           break;
5690         case 3:
5691           /* Hybrid simplicial 2D */
5692           if ((p >= vStart) && (p < vEnd)) {
5693             /* Old vertices stay the same */
5694             newp = vStartNew + (p - vStart);
5695             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5696           } else if ((p >= fStart) && (p < fMax)) {
5697             /* Old interior faces add new faces and vertex */
5698             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5699             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5700             for (r = 0; r < 2; ++r) {
5701               newp = fStartNew + (p - fStart)*2 + r;
5702               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5703             }
5704           } else if ((p >= fMax) && (p < fEnd)) {
5705             /* Old hybrid faces stay the same */
5706             newp = fStartNew + (fMax - fStart)*2 + (p - fMax);
5707             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5708           } else if ((p >= cStart) && (p < cMax)) {
5709             /* Old interior cells add new cells and interior faces */
5710             for (r = 0; r < 4; ++r) {
5711               newp = cStartNew + (p - cStart)*4 + r;
5712               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5713             }
5714             for (r = 0; r < 3; ++r) {
5715               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
5716               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5717             }
5718           } else if ((p >= cMax) && (p < cEnd)) {
5719             /* Old hybrid cells add new cells and hybrid face */
5720             for (r = 0; r < 2; ++r) {
5721               newp = cStartNew + (cMax - cStart)*4 + (p - cMax)*2 + r;
5722               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5723             }
5724             newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (p - cMax);
5725             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5726           }
5727           break;
5728         default:
5729           SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5730         }
5731       }
5732       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
5733       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
5734     }
5735     ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
5736     ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
5737     if (0) {
5738       ierr = PetscViewerASCIISynchronizedAllow(PETSC_VIEWER_STDOUT_WORLD, PETSC_TRUE);CHKERRQ(ierr);
5739       ierr = DMLabelView(labelNew, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
5740       ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
5741     }
5742   }
5743   PetscFunctionReturn(0);
5744 }
5745 
5746 #undef __FUNCT__
5747 #define __FUNCT__ "DMPlexRefine_Uniform"
5748 /* This will only work for interpolated meshes */
5749 PetscErrorCode DMPlexRefine_Uniform(DM dm, CellRefiner cellRefiner, DM *dmRefined)
5750 {
5751   DM             rdm;
5752   PetscInt      *depthSize;
5753   PetscInt       dim, depth = 0, d, pStart = 0, pEnd = 0;
5754   PetscErrorCode ierr;
5755 
5756   PetscFunctionBegin;
5757   ierr = DMCreate(PetscObjectComm((PetscObject)dm), &rdm);CHKERRQ(ierr);
5758   ierr = DMSetType(rdm, DMPLEX);CHKERRQ(ierr);
5759   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5760   ierr = DMPlexSetDimension(rdm, dim);CHKERRQ(ierr);
5761   /* Calculate number of new points of each depth */
5762   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5763   if (depth != dim) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Mesh must be fully interpolated for uniform refinement");
5764   ierr = PetscMalloc((depth+1) * sizeof(PetscInt), &depthSize);CHKERRQ(ierr);
5765   ierr = PetscMemzero(depthSize, (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
5766   ierr = CellRefinerGetSizes(cellRefiner, dm, depthSize);CHKERRQ(ierr);
5767   /* Step 1: Set chart */
5768   for (d = 0; d <= depth; ++d) pEnd += depthSize[d];
5769   ierr = DMPlexSetChart(rdm, pStart, pEnd);CHKERRQ(ierr);
5770   /* Step 2: Set cone/support sizes */
5771   ierr = CellRefinerSetConeSizes(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5772   /* Step 3: Setup refined DM */
5773   ierr = DMSetUp(rdm);CHKERRQ(ierr);
5774   /* Step 4: Set cones and supports */
5775   ierr = CellRefinerSetCones(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5776   /* Step 5: Stratify */
5777   ierr = DMPlexStratify(rdm);CHKERRQ(ierr);
5778   /* Step 6: Set coordinates for vertices */
5779   ierr = CellRefinerSetCoordinates(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5780   /* Step 7: Create pointSF */
5781   ierr = CellRefinerCreateSF(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5782   /* Step 8: Create labels */
5783   ierr = CellRefinerCreateLabels(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5784   ierr = PetscFree(depthSize);CHKERRQ(ierr);
5785 
5786   *dmRefined = rdm;
5787   PetscFunctionReturn(0);
5788 }
5789 
5790 #undef __FUNCT__
5791 #define __FUNCT__ "DMPlexSetRefinementUniform"
5792 PetscErrorCode DMPlexSetRefinementUniform(DM dm, PetscBool refinementUniform)
5793 {
5794   DM_Plex *mesh = (DM_Plex*) dm->data;
5795 
5796   PetscFunctionBegin;
5797   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5798   mesh->refinementUniform = refinementUniform;
5799   PetscFunctionReturn(0);
5800 }
5801 
5802 #undef __FUNCT__
5803 #define __FUNCT__ "DMPlexGetRefinementUniform"
5804 PetscErrorCode DMPlexGetRefinementUniform(DM dm, PetscBool *refinementUniform)
5805 {
5806   DM_Plex *mesh = (DM_Plex*) dm->data;
5807 
5808   PetscFunctionBegin;
5809   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5810   PetscValidPointer(refinementUniform,  2);
5811   *refinementUniform = mesh->refinementUniform;
5812   PetscFunctionReturn(0);
5813 }
5814 
5815 #undef __FUNCT__
5816 #define __FUNCT__ "DMPlexSetRefinementLimit"
5817 PetscErrorCode DMPlexSetRefinementLimit(DM dm, PetscReal refinementLimit)
5818 {
5819   DM_Plex *mesh = (DM_Plex*) dm->data;
5820 
5821   PetscFunctionBegin;
5822   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5823   mesh->refinementLimit = refinementLimit;
5824   PetscFunctionReturn(0);
5825 }
5826 
5827 #undef __FUNCT__
5828 #define __FUNCT__ "DMPlexGetRefinementLimit"
5829 PetscErrorCode DMPlexGetRefinementLimit(DM dm, PetscReal *refinementLimit)
5830 {
5831   DM_Plex *mesh = (DM_Plex*) dm->data;
5832 
5833   PetscFunctionBegin;
5834   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5835   PetscValidPointer(refinementLimit,  2);
5836   /* if (mesh->refinementLimit < 0) = getMaxVolume()/2.0; */
5837   *refinementLimit = mesh->refinementLimit;
5838   PetscFunctionReturn(0);
5839 }
5840 
5841 #undef __FUNCT__
5842 #define __FUNCT__ "DMPlexGetCellRefiner_Private"
5843 PetscErrorCode DMPlexGetCellRefiner_Private(DM dm, CellRefiner *cellRefiner)
5844 {
5845   PetscInt       dim, cStart, coneSize, cMax;
5846   PetscErrorCode ierr;
5847 
5848   PetscFunctionBegin;
5849   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5850   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
5851   ierr = DMPlexGetConeSize(dm, cStart, &coneSize);CHKERRQ(ierr);
5852   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5853   switch (dim) {
5854   case 2:
5855     switch (coneSize) {
5856     case 3:
5857       if (cMax >= 0) *cellRefiner = 3; /* Hybrid */
5858       else *cellRefiner = 1; /* Triangular */
5859       break;
5860     case 4:
5861       if (cMax >= 0) *cellRefiner = 4; /* Hybrid */
5862       else *cellRefiner = 2; /* Quadrilateral */
5863       break;
5864     default:
5865       SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown coneSize %d in dimension %d for cell refiner", coneSize, dim);
5866     }
5867     break;
5868   default:
5869     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown dimension %d for cell refiner", dim);
5870   }
5871   PetscFunctionReturn(0);
5872 }
5873 
5874 #undef __FUNCT__
5875 #define __FUNCT__ "DMRefine_Plex"
5876 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
5877 {
5878   PetscReal      refinementLimit;
5879   PetscInt       dim, cStart, cEnd;
5880   char           genname[1024], *name = NULL;
5881   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
5882   PetscErrorCode ierr;
5883 
5884   PetscFunctionBegin;
5885   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
5886   if (isUniform) {
5887     CellRefiner cellRefiner;
5888 
5889     ierr = DMPlexGetCellRefiner_Private(dm, &cellRefiner);CHKERRQ(ierr);
5890     ierr = DMPlexRefine_Uniform(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
5891     PetscFunctionReturn(0);
5892   }
5893   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
5894   if (refinementLimit == 0.0) PetscFunctionReturn(0);
5895   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5896   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5897   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
5898   if (flg) name = genname;
5899   if (name) {
5900     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
5901     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
5902     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
5903   }
5904   switch (dim) {
5905   case 2:
5906     if (!name || isTriangle) {
5907 #if defined(PETSC_HAVE_TRIANGLE)
5908       double  *maxVolumes;
5909       PetscInt c;
5910 
5911       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
5912       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5913       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5914       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
5915 #else
5916       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
5917 #endif
5918     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
5919     break;
5920   case 3:
5921     if (!name || isCTetgen) {
5922 #if defined(PETSC_HAVE_CTETGEN)
5923       PetscReal *maxVolumes;
5924       PetscInt   c;
5925 
5926       ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscReal), &maxVolumes);CHKERRQ(ierr);
5927       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5928       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5929 #else
5930       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
5931 #endif
5932     } else if (isTetgen) {
5933 #if defined(PETSC_HAVE_TETGEN)
5934       double  *maxVolumes;
5935       PetscInt c;
5936 
5937       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
5938       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5939       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5940 #else
5941       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
5942 #endif
5943     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
5944     break;
5945   default:
5946     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
5947   }
5948   PetscFunctionReturn(0);
5949 }
5950 
5951 #undef __FUNCT__
5952 #define __FUNCT__ "DMPlexGetDepthLabel"
5953 /*@
5954   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
5955 
5956   Not Collective
5957 
5958   Input Parameter:
5959 . dm    - The DMPlex object
5960 
5961   Output Parameter:
5962 . depthLabel - The DMLabel recording point depth
5963 
5964   Level: developer
5965 
5966 .keywords: mesh, points
5967 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
5968 @*/
5969 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
5970 {
5971   DM_Plex       *mesh = (DM_Plex*) dm->data;
5972   PetscErrorCode ierr;
5973 
5974   PetscFunctionBegin;
5975   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5976   PetscValidPointer(depthLabel, 2);
5977   if (!mesh->depthLabel) {
5978     ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);
5979   }
5980   *depthLabel = mesh->depthLabel;
5981   PetscFunctionReturn(0);
5982 }
5983 
5984 #undef __FUNCT__
5985 #define __FUNCT__ "DMPlexGetDepth"
5986 /*@
5987   DMPlexGetDepth - Get the depth of the DAG representing this mesh
5988 
5989   Not Collective
5990 
5991   Input Parameter:
5992 . dm    - The DMPlex object
5993 
5994   Output Parameter:
5995 . depth - The number of strata (breadth first levels) in the DAG
5996 
5997   Level: developer
5998 
5999 .keywords: mesh, points
6000 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
6001 @*/
6002 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
6003 {
6004   DMLabel        label;
6005   PetscInt       d = 0;
6006   PetscErrorCode ierr;
6007 
6008   PetscFunctionBegin;
6009   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6010   PetscValidPointer(depth, 2);
6011   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
6012   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
6013   *depth = d-1;
6014   PetscFunctionReturn(0);
6015 }
6016 
6017 #undef __FUNCT__
6018 #define __FUNCT__ "DMPlexGetDepthStratum"
6019 /*@
6020   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
6021 
6022   Not Collective
6023 
6024   Input Parameters:
6025 + dm           - The DMPlex object
6026 - stratumValue - The requested depth
6027 
6028   Output Parameters:
6029 + start - The first point at this depth
6030 - end   - One beyond the last point at this depth
6031 
6032   Level: developer
6033 
6034 .keywords: mesh, points
6035 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
6036 @*/
6037 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6038 {
6039   DMLabel        label;
6040   PetscInt       depth;
6041   PetscErrorCode ierr;
6042 
6043   PetscFunctionBegin;
6044   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6045   if (stratumValue < 0) {
6046     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6047     PetscFunctionReturn(0);
6048   } else {
6049     PetscInt pStart, pEnd;
6050 
6051     if (start) *start = 0;
6052     if (end)   *end   = 0;
6053     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6054     if (pStart == pEnd) PetscFunctionReturn(0);
6055   }
6056   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
6057   if (!label) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6058   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6059   depth = stratumValue;
6060   if ((depth < 0) || (depth >= label->numStrata)) {
6061     if (start) *start = 0;
6062     if (end)   *end   = 0;
6063   } else {
6064     if (start) *start = label->points[label->stratumOffsets[depth]];
6065     if (end)   *end   = label->points[label->stratumOffsets[depth]+label->stratumSizes[depth]-1]+1;
6066   }
6067   PetscFunctionReturn(0);
6068 }
6069 
6070 #undef __FUNCT__
6071 #define __FUNCT__ "DMPlexGetHeightStratum"
6072 /*@
6073   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
6074 
6075   Not Collective
6076 
6077   Input Parameters:
6078 + dm           - The DMPlex object
6079 - stratumValue - The requested height
6080 
6081   Output Parameters:
6082 + start - The first point at this height
6083 - end   - One beyond the last point at this height
6084 
6085   Level: developer
6086 
6087 .keywords: mesh, points
6088 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
6089 @*/
6090 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6091 {
6092   DMLabel        label;
6093   PetscInt       depth;
6094   PetscErrorCode ierr;
6095 
6096   PetscFunctionBegin;
6097   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6098   if (stratumValue < 0) {
6099     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6100   } else {
6101     PetscInt pStart, pEnd;
6102 
6103     if (start) *start = 0;
6104     if (end)   *end   = 0;
6105     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6106     if (pStart == pEnd) PetscFunctionReturn(0);
6107   }
6108   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
6109   if (!label) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6110   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6111   depth = label->stratumValues[label->numStrata-1] - stratumValue;
6112   if ((depth < 0) || (depth >= label->numStrata)) {
6113     if (start) *start = 0;
6114     if (end)   *end   = 0;
6115   } else {
6116     if (start) *start = label->points[label->stratumOffsets[depth]];
6117     if (end)   *end   = label->points[label->stratumOffsets[depth]+label->stratumSizes[depth]-1]+1;
6118   }
6119   PetscFunctionReturn(0);
6120 }
6121 
6122 #undef __FUNCT__
6123 #define __FUNCT__ "DMPlexCreateSectionInitial"
6124 /* Set the number of dof on each point and separate by fields */
6125 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
6126 {
6127   PetscInt      *numDofTot;
6128   PetscInt       pStart = 0, pEnd = 0;
6129   PetscInt       p, d, f;
6130   PetscErrorCode ierr;
6131 
6132   PetscFunctionBegin;
6133   ierr = PetscMalloc((dim+1) * sizeof(PetscInt), &numDofTot);CHKERRQ(ierr);
6134   for (d = 0; d <= dim; ++d) {
6135     numDofTot[d] = 0;
6136     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
6137   }
6138   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
6139   if (numFields > 0) {
6140     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
6141     if (numComp) {
6142       for (f = 0; f < numFields; ++f) {
6143         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
6144       }
6145     }
6146   }
6147   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6148   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
6149   for (d = 0; d <= dim; ++d) {
6150     ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
6151     for (p = pStart; p < pEnd; ++p) {
6152       for (f = 0; f < numFields; ++f) {
6153         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
6154       }
6155       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
6156     }
6157   }
6158   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
6159   PetscFunctionReturn(0);
6160 }
6161 
6162 #undef __FUNCT__
6163 #define __FUNCT__ "DMPlexCreateSectionBCDof"
6164 /* Set the number of dof on each point and separate by fields
6165    If constDof is PETSC_DETERMINE, constrain every dof on the point
6166 */
6167 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
6168 {
6169   PetscInt       numFields;
6170   PetscInt       bc;
6171   PetscErrorCode ierr;
6172 
6173   PetscFunctionBegin;
6174   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6175   for (bc = 0; bc < numBC; ++bc) {
6176     PetscInt        field = 0;
6177     const PetscInt *idx;
6178     PetscInt        n, i;
6179 
6180     if (numFields) field = bcField[bc];
6181     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
6182     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6183     for (i = 0; i < n; ++i) {
6184       const PetscInt p        = idx[i];
6185       PetscInt       numConst = constDof;
6186 
6187       /* Constrain every dof on the point */
6188       if (numConst < 0) {
6189         if (numFields) {
6190           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
6191         } else {
6192           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
6193         }
6194       }
6195       if (numFields) {
6196         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
6197       }
6198       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
6199     }
6200     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6201   }
6202   PetscFunctionReturn(0);
6203 }
6204 
6205 #undef __FUNCT__
6206 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
6207 /* Set the constrained indices on each point and separate by fields */
6208 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
6209 {
6210   PetscInt      *maxConstraints;
6211   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
6212   PetscErrorCode ierr;
6213 
6214   PetscFunctionBegin;
6215   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6216   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6217   ierr = PetscMalloc((numFields+1) * sizeof(PetscInt), &maxConstraints);CHKERRQ(ierr);
6218   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
6219   for (p = pStart; p < pEnd; ++p) {
6220     PetscInt cdof;
6221 
6222     if (numFields) {
6223       for (f = 0; f < numFields; ++f) {
6224         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
6225         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
6226       }
6227     } else {
6228       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6229       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
6230     }
6231   }
6232   for (f = 0; f < numFields; ++f) {
6233     maxConstraints[numFields] += maxConstraints[f];
6234   }
6235   if (maxConstraints[numFields]) {
6236     PetscInt *indices;
6237 
6238     ierr = PetscMalloc(maxConstraints[numFields] * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6239     for (p = pStart; p < pEnd; ++p) {
6240       PetscInt cdof, d;
6241 
6242       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6243       if (cdof) {
6244         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
6245         if (numFields) {
6246           PetscInt numConst = 0, foff = 0;
6247 
6248           for (f = 0; f < numFields; ++f) {
6249             PetscInt cfdof, fdof;
6250 
6251             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6252             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
6253             /* Change constraint numbering from absolute local dof number to field relative local dof number */
6254             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
6255             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
6256             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
6257             numConst += cfdof;
6258             foff     += fdof;
6259           }
6260           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6261         } else {
6262           for (d = 0; d < cdof; ++d) indices[d] = d;
6263         }
6264         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6265       }
6266     }
6267     ierr = PetscFree(indices);CHKERRQ(ierr);
6268   }
6269   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
6270   PetscFunctionReturn(0);
6271 }
6272 
6273 #undef __FUNCT__
6274 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
6275 /* Set the constrained field indices on each point */
6276 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
6277 {
6278   const PetscInt *points, *indices;
6279   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
6280   PetscErrorCode  ierr;
6281 
6282   PetscFunctionBegin;
6283   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6284   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
6285 
6286   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
6287   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
6288   if (!constraintIndices) {
6289     PetscInt *idx, i;
6290 
6291     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6292     ierr = PetscMalloc(maxDof * sizeof(PetscInt), &idx);CHKERRQ(ierr);
6293     for (i = 0; i < maxDof; ++i) idx[i] = i;
6294     for (p = 0; p < numPoints; ++p) {
6295       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
6296     }
6297     ierr = PetscFree(idx);CHKERRQ(ierr);
6298   } else {
6299     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
6300     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
6301     for (p = 0; p < numPoints; ++p) {
6302       PetscInt fcdof;
6303 
6304       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
6305       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);
6306       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
6307     }
6308     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
6309   }
6310   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
6311   PetscFunctionReturn(0);
6312 }
6313 
6314 #undef __FUNCT__
6315 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
6316 /* Set the constrained indices on each point and separate by fields */
6317 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
6318 {
6319   PetscInt      *indices;
6320   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
6321   PetscErrorCode ierr;
6322 
6323   PetscFunctionBegin;
6324   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6325   ierr = PetscMalloc(maxDof * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6326   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6327   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
6328   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6329   for (p = pStart; p < pEnd; ++p) {
6330     PetscInt cdof, d;
6331 
6332     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6333     if (cdof) {
6334       PetscInt numConst = 0, foff = 0;
6335 
6336       for (f = 0; f < numFields; ++f) {
6337         const PetscInt *fcind;
6338         PetscInt        fdof, fcdof;
6339 
6340         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6341         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
6342         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
6343         /* Change constraint numbering from field relative local dof number to absolute local dof number */
6344         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
6345         foff     += fdof;
6346         numConst += fcdof;
6347       }
6348       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6349       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6350     }
6351   }
6352   ierr = PetscFree(indices);CHKERRQ(ierr);
6353   PetscFunctionReturn(0);
6354 }
6355 
6356 #undef __FUNCT__
6357 #define __FUNCT__ "DMPlexCreateSection"
6358 /*@C
6359   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
6360 
6361   Not Collective
6362 
6363   Input Parameters:
6364 + dm        - The DMPlex object
6365 . dim       - The spatial dimension of the problem
6366 . numFields - The number of fields in the problem
6367 . numComp   - An array of size numFields that holds the number of components for each field
6368 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
6369 . numBC     - The number of boundary conditions
6370 . bcField   - An array of size numBC giving the field number for each boundry condition
6371 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
6372 
6373   Output Parameter:
6374 . section - The PetscSection object
6375 
6376   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
6377   nubmer of dof for field 0 on each edge.
6378 
6379   Level: developer
6380 
6381   Fortran Notes:
6382   A Fortran 90 version is available as DMPlexCreateSectionF90()
6383 
6384 .keywords: mesh, elements
6385 .seealso: DMPlexCreate(), PetscSectionCreate()
6386 @*/
6387 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
6388 {
6389   PetscErrorCode ierr;
6390 
6391   PetscFunctionBegin;
6392   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
6393   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
6394   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
6395   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
6396   {
6397     PetscBool view = PETSC_FALSE;
6398 
6399     ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-section_view", &view);CHKERRQ(ierr);
6400     if (view) {ierr = PetscSectionView(*section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
6401   }
6402   PetscFunctionReturn(0);
6403 }
6404 
6405 #undef __FUNCT__
6406 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
6407 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
6408 {
6409   PetscSection   section;
6410   PetscErrorCode ierr;
6411 
6412   PetscFunctionBegin;
6413   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
6414   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6415   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
6416   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6417   PetscFunctionReturn(0);
6418 }
6419 
6420 #undef __FUNCT__
6421 #define __FUNCT__ "DMPlexGetCoordinateSection"
6422 /*@
6423   DMPlexGetCoordinateSection - Retrieve the layout of coordinate values over the mesh.
6424 
6425   Not Collective
6426 
6427   Input Parameter:
6428 . dm - The DMPlex object
6429 
6430   Output Parameter:
6431 . section - The PetscSection object
6432 
6433   Level: intermediate
6434 
6435 .keywords: mesh, coordinates
6436 .seealso: DMGetCoordinateDM(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6437 @*/
6438 PetscErrorCode DMPlexGetCoordinateSection(DM dm, PetscSection *section)
6439 {
6440   DM             cdm;
6441   PetscErrorCode ierr;
6442 
6443   PetscFunctionBegin;
6444   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6445   PetscValidPointer(section, 2);
6446   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6447   ierr = DMGetDefaultSection(cdm, section);CHKERRQ(ierr);
6448   PetscFunctionReturn(0);
6449 }
6450 
6451 #undef __FUNCT__
6452 #define __FUNCT__ "DMPlexSetCoordinateSection"
6453 /*@
6454   DMPlexSetCoordinateSection - Set the layout of coordinate values over the mesh.
6455 
6456   Not Collective
6457 
6458   Input Parameters:
6459 + dm      - The DMPlex object
6460 - section - The PetscSection object
6461 
6462   Level: intermediate
6463 
6464 .keywords: mesh, coordinates
6465 .seealso: DMPlexGetCoordinateSection(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6466 @*/
6467 PetscErrorCode DMPlexSetCoordinateSection(DM dm, PetscSection section)
6468 {
6469   DM             cdm;
6470   PetscErrorCode ierr;
6471 
6472   PetscFunctionBegin;
6473   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
6474   PetscValidHeaderSpecific(section,PETSC_SECTION_CLASSID,2);
6475   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6476   ierr = DMSetDefaultSection(cdm, section);CHKERRQ(ierr);
6477   PetscFunctionReturn(0);
6478 }
6479 
6480 #undef __FUNCT__
6481 #define __FUNCT__ "DMPlexGetConeSection"
6482 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
6483 {
6484   DM_Plex *mesh = (DM_Plex*) dm->data;
6485 
6486   PetscFunctionBegin;
6487   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6488   if (section) *section = mesh->coneSection;
6489   PetscFunctionReturn(0);
6490 }
6491 
6492 #undef __FUNCT__
6493 #define __FUNCT__ "DMPlexGetCones"
6494 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
6495 {
6496   DM_Plex *mesh = (DM_Plex*) dm->data;
6497 
6498   PetscFunctionBegin;
6499   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6500   if (cones) *cones = mesh->cones;
6501   PetscFunctionReturn(0);
6502 }
6503 
6504 #undef __FUNCT__
6505 #define __FUNCT__ "DMPlexGetConeOrientations"
6506 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
6507 {
6508   DM_Plex *mesh = (DM_Plex*) dm->data;
6509 
6510   PetscFunctionBegin;
6511   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6512   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
6513   PetscFunctionReturn(0);
6514 }
6515 
6516 /******************************** FEM Support **********************************/
6517 
6518 #undef __FUNCT__
6519 #define __FUNCT__ "DMPlexVecGetClosure"
6520 /*@C
6521   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
6522 
6523   Not collective
6524 
6525   Input Parameters:
6526 + dm - The DM
6527 . section - The section describing the layout in v, or NULL to use the default section
6528 . v - The local vector
6529 - point - The sieve point in the DM
6530 
6531   Output Parameters:
6532 + csize - The number of values in the closure, or NULL
6533 - values - The array of values, which is a borrowed array and should not be freed
6534 
6535   Fortran Notes:
6536   Since it returns an array, this routine is only available in Fortran 90, and you must
6537   include petsc.h90 in your code.
6538 
6539   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6540 
6541   Level: intermediate
6542 
6543 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6544 @*/
6545 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6546 {
6547   PetscScalar   *array, *vArray;
6548   PetscInt      *points = NULL;
6549   PetscInt       offsets[32];
6550   PetscInt       depth, numFields, size = 0, numPoints, pStart, pEnd, p, q, f;
6551   PetscErrorCode ierr;
6552 
6553   PetscFunctionBegin;
6554   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6555   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
6556   if (!section) {
6557     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
6558   }
6559   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6560   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6561   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6562   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6563   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6564   if (depth == 1 && numFields < 2) {
6565     const PetscInt *cone, *coneO;
6566 
6567     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
6568     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
6569     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
6570     if (!values || !*values) {
6571       if ((point >= pStart) && (point < pEnd)) {
6572         PetscInt dof;
6573         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
6574         size += dof;
6575       }
6576       for (p = 0; p < numPoints; ++p) {
6577         const PetscInt cp = cone[p];
6578         PetscInt       dof;
6579 
6580         if ((cp < pStart) || (cp >= pEnd)) continue;
6581         ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6582         size += dof;
6583       }
6584       if (!values) {
6585         if (csize) *csize = size;
6586         PetscFunctionReturn(0);
6587       }
6588       ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
6589     } else {
6590       array = *values;
6591     }
6592     size = 0;
6593     ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
6594     if ((point >= pStart) && (point < pEnd)) {
6595       PetscInt     dof, off, d;
6596       PetscScalar *varr;
6597       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
6598       ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6599       varr = &vArray[off];
6600       for (d = 0; d < dof; ++d, ++offsets[0]) {
6601         array[offsets[0]] = varr[d];
6602       }
6603       size += dof;
6604     }
6605     for (p = 0; p < numPoints; ++p) {
6606       const PetscInt cp = cone[p];
6607       PetscInt       o  = coneO[p];
6608       PetscInt       dof, off, d;
6609       PetscScalar   *varr;
6610 
6611       if ((cp < pStart) || (cp >= pEnd)) continue;
6612       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6613       ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
6614       varr = &vArray[off];
6615       if (o >= 0) {
6616         for (d = 0; d < dof; ++d, ++offsets[0]) {
6617           array[offsets[0]] = varr[d];
6618         }
6619       } else {
6620         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
6621           array[offsets[0]] = varr[d];
6622         }
6623       }
6624       size += dof;
6625     }
6626     ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
6627     if (!*values) {
6628       if (csize) *csize = size;
6629       *values = array;
6630     } else {
6631       if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
6632       *csize = size;
6633     }
6634     PetscFunctionReturn(0);
6635   }
6636   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6637   /* Compress out points not in the section */
6638   for (p = 0, q = 0; p < numPoints*2; p += 2) {
6639     if ((points[p] >= pStart) && (points[p] < pEnd)) {
6640       points[q*2]   = points[p];
6641       points[q*2+1] = points[p+1];
6642       ++q;
6643     }
6644   }
6645   numPoints = q;
6646   if (!values || !*values) {
6647     for (p = 0, size = 0; p < numPoints*2; p += 2) {
6648       PetscInt dof, fdof;
6649 
6650       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6651       for (f = 0; f < numFields; ++f) {
6652         ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6653         offsets[f+1] += fdof;
6654       }
6655       size += dof;
6656     }
6657     if (!values) {
6658       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6659       if (csize) *csize = size;
6660       PetscFunctionReturn(0);
6661     }
6662     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
6663   } else {
6664     array = *values;
6665   }
6666   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
6667   if (numFields && offsets[numFields] != size) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], size);
6668   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
6669   for (p = 0; p < numPoints*2; p += 2) {
6670     PetscInt     o = points[p+1];
6671     PetscInt     dof, off, d;
6672     PetscScalar *varr;
6673 
6674     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6675     ierr = PetscSectionGetOffset(section, points[p], &off);CHKERRQ(ierr);
6676     varr = &vArray[off];
6677     if (numFields) {
6678       PetscInt fdof, foff, fcomp, f, c;
6679 
6680       for (f = 0, foff = 0; f < numFields; ++f) {
6681         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6682         if (o >= 0) {
6683           for (d = 0; d < fdof; ++d, ++offsets[f]) {
6684             array[offsets[f]] = varr[foff+d];
6685           }
6686         } else {
6687           ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6688           for (d = fdof/fcomp-1; d >= 0; --d) {
6689             for (c = 0; c < fcomp; ++c, ++offsets[f]) {
6690               array[offsets[f]] = varr[foff+d*fcomp+c];
6691             }
6692           }
6693         }
6694         foff += fdof;
6695       }
6696     } else {
6697       if (o >= 0) {
6698         for (d = 0; d < dof; ++d, ++offsets[0]) {
6699           array[offsets[0]] = varr[d];
6700         }
6701       } else {
6702         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
6703           array[offsets[0]] = varr[d];
6704         }
6705       }
6706     }
6707   }
6708   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6709   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
6710   if (!*values) {
6711     if (csize) *csize = size;
6712     *values = array;
6713   } else {
6714     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
6715     *csize = size;
6716   }
6717   PetscFunctionReturn(0);
6718 }
6719 
6720 #undef __FUNCT__
6721 #define __FUNCT__ "DMPlexVecRestoreClosure"
6722 /*@C
6723   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
6724 
6725   Not collective
6726 
6727   Input Parameters:
6728 + dm - The DM
6729 . section - The section describing the layout in v, or NULL to use the default section
6730 . v - The local vector
6731 . point - The sieve point in the DM
6732 . csize - The number of values in the closure, or NULL
6733 - values - The array of values, which is a borrowed array and should not be freed
6734 
6735   Fortran Notes:
6736   Since it returns an array, this routine is only available in Fortran 90, and you must
6737   include petsc.h90 in your code.
6738 
6739   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6740 
6741   Level: intermediate
6742 
6743 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6744 @*/
6745 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6746 {
6747   PetscInt       size = 0;
6748   PetscErrorCode ierr;
6749 
6750   PetscFunctionBegin;
6751   /* Should work without recalculating size */
6752   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
6753   PetscFunctionReturn(0);
6754 }
6755 
6756 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
6757 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
6758 
6759 #undef __FUNCT__
6760 #define __FUNCT__ "updatePoint_private"
6761 PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6762 {
6763   PetscInt        cdof;   /* The number of constraints on this point */
6764   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6765   PetscScalar    *a;
6766   PetscInt        off, cind = 0, k;
6767   PetscErrorCode  ierr;
6768 
6769   PetscFunctionBegin;
6770   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
6771   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6772   a    = &array[off];
6773   if (!cdof || setBC) {
6774     if (orientation >= 0) {
6775       for (k = 0; k < dof; ++k) {
6776         fuse(&a[k], values[k]);
6777       }
6778     } else {
6779       for (k = 0; k < dof; ++k) {
6780         fuse(&a[k], values[dof-k-1]);
6781       }
6782     }
6783   } else {
6784     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
6785     if (orientation >= 0) {
6786       for (k = 0; k < dof; ++k) {
6787         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6788         fuse(&a[k], values[k]);
6789       }
6790     } else {
6791       for (k = 0; k < dof; ++k) {
6792         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6793         fuse(&a[k], values[dof-k-1]);
6794       }
6795     }
6796   }
6797   PetscFunctionReturn(0);
6798 }
6799 
6800 #undef __FUNCT__
6801 #define __FUNCT__ "updatePointBC_private"
6802 PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6803 {
6804   PetscInt        cdof;   /* The number of constraints on this point */
6805   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6806   PetscScalar    *a;
6807   PetscInt        off, cind = 0, k;
6808   PetscErrorCode  ierr;
6809 
6810   PetscFunctionBegin;
6811   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
6812   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6813   a    = &array[off];
6814   if (cdof) {
6815     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
6816     if (orientation >= 0) {
6817       for (k = 0; k < dof; ++k) {
6818         if ((cind < cdof) && (k == cdofs[cind])) {
6819           fuse(&a[k], values[k]);
6820           ++cind;
6821         }
6822       }
6823     } else {
6824       for (k = 0; k < dof; ++k) {
6825         if ((cind < cdof) && (k == cdofs[cind])) {
6826           fuse(&a[k], values[dof-k-1]);
6827           ++cind;
6828         }
6829       }
6830     }
6831   }
6832   PetscFunctionReturn(0);
6833 }
6834 
6835 #undef __FUNCT__
6836 #define __FUNCT__ "updatePointFields_private"
6837 PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6838 {
6839   PetscScalar   *a;
6840   PetscInt       numFields, off, foff, f;
6841   PetscErrorCode ierr;
6842 
6843   PetscFunctionBegin;
6844   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6845   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6846   a    = &array[off];
6847   for (f = 0, foff = 0; f < numFields; ++f) {
6848     PetscInt        fdof, fcomp, fcdof;
6849     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
6850     PetscInt        cind = 0, k, c;
6851 
6852     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6853     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
6854     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
6855     if (!fcdof || setBC) {
6856       if (orientation >= 0) {
6857         for (k = 0; k < fdof; ++k) {
6858           fuse(&a[foff+k], values[foffs[f]+k]);
6859         }
6860       } else {
6861         for (k = fdof/fcomp-1; k >= 0; --k) {
6862           for (c = 0; c < fcomp; ++c) {
6863             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
6864           }
6865         }
6866       }
6867     } else {
6868       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
6869       if (orientation >= 0) {
6870         for (k = 0; k < fdof; ++k) {
6871           if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
6872           fuse(&a[foff+k], values[foffs[f]+k]);
6873         }
6874       } else {
6875         for (k = fdof/fcomp-1; k >= 0; --k) {
6876           for (c = 0; c < fcomp; ++c) {
6877             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
6878             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
6879           }
6880         }
6881       }
6882     }
6883     foff     += fdof;
6884     foffs[f] += fdof;
6885   }
6886   PetscFunctionReturn(0);
6887 }
6888 
6889 #undef __FUNCT__
6890 #define __FUNCT__ "updatePointFieldsBC_private"
6891 PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6892 {
6893   PetscScalar   *a;
6894   PetscInt       numFields, off, foff, f;
6895   PetscErrorCode ierr;
6896 
6897   PetscFunctionBegin;
6898   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6899   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6900   a    = &array[off];
6901   for (f = 0, foff = 0; f < numFields; ++f) {
6902     PetscInt        fdof, fcomp, fcdof;
6903     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
6904     PetscInt        cind = 0, k, c;
6905 
6906     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6907     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
6908     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
6909     if (fcdof) {
6910       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
6911       if (orientation >= 0) {
6912         for (k = 0; k < fdof; ++k) {
6913           if ((cind < fcdof) && (k == fcdofs[cind])) {
6914             fuse(&a[foff+k], values[foffs[f]+k]);
6915             ++cind;
6916           }
6917         }
6918       } else {
6919         for (k = fdof/fcomp-1; k >= 0; --k) {
6920           for (c = 0; c < fcomp; ++c) {
6921             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
6922               fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
6923               ++cind;
6924             }
6925           }
6926         }
6927       }
6928     }
6929     foff     += fdof;
6930     foffs[f] += fdof;
6931   }
6932   PetscFunctionReturn(0);
6933 }
6934 
6935 #undef __FUNCT__
6936 #define __FUNCT__ "DMPlexVecSetClosure"
6937 /*@C
6938   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
6939 
6940   Not collective
6941 
6942   Input Parameters:
6943 + dm - The DM
6944 . section - The section describing the layout in v, or NULL to use the default section
6945 . v - The local vector
6946 . point - The sieve point in the DM
6947 . values - The array of values
6948 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6949 
6950   Fortran Notes:
6951   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
6952 
6953   Level: intermediate
6954 
6955 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
6956 @*/
6957 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
6958 {
6959   PetscScalar   *array;
6960   PetscInt      *points = NULL;
6961   PetscInt       offsets[32];
6962   PetscInt       depth, numFields, numPoints, off, dof, pStart, pEnd, p, q, f;
6963   PetscErrorCode ierr;
6964 
6965   PetscFunctionBegin;
6966   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6967   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
6968   if (!section) {
6969     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
6970   }
6971   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6972   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6973   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6974   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6975   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6976   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
6977     const PetscInt *cone, *coneO;
6978 
6979     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
6980     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
6981     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
6982     ierr = VecGetArray(v, &array);CHKERRQ(ierr);
6983     for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
6984       const PetscInt cp = !p ? point : cone[p-1];
6985       const PetscInt o  = !p ? 0     : coneO[p-1];
6986 
6987       if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
6988       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6989       /* ADD_VALUES */
6990       {
6991         const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6992         PetscScalar    *a;
6993         PetscInt        cdof, coff, cind = 0, k;
6994 
6995         ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
6996         ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
6997         a    = &array[coff];
6998         if (!cdof) {
6999           if (o >= 0) {
7000             for (k = 0; k < dof; ++k) {
7001               a[k] += values[off+k];
7002             }
7003           } else {
7004             for (k = 0; k < dof; ++k) {
7005               a[k] += values[off+dof-k-1];
7006             }
7007           }
7008         } else {
7009           ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
7010           if (o >= 0) {
7011             for (k = 0; k < dof; ++k) {
7012               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
7013               a[k] += values[off+k];
7014             }
7015           } else {
7016             for (k = 0; k < dof; ++k) {
7017               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
7018               a[k] += values[off+dof-k-1];
7019             }
7020           }
7021         }
7022       }
7023     }
7024     ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
7025     PetscFunctionReturn(0);
7026   }
7027   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7028   /* Compress out points not in the section */
7029   for (p = 0, q = 0; p < numPoints*2; p += 2) {
7030     if ((points[p] >= pStart) && (points[p] < pEnd)) {
7031       points[q*2]   = points[p];
7032       points[q*2+1] = points[p+1];
7033       ++q;
7034     }
7035   }
7036   numPoints = q;
7037   for (p = 0; p < numPoints*2; p += 2) {
7038     PetscInt fdof;
7039 
7040     for (f = 0; f < numFields; ++f) {
7041       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
7042       offsets[f+1] += fdof;
7043     }
7044   }
7045   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
7046   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
7047   if (numFields) {
7048     switch (mode) {
7049     case INSERT_VALUES:
7050       for (p = 0; p < numPoints*2; p += 2) {
7051         PetscInt o = points[p+1];
7052         updatePointFields_private(section, points[p], offsets, insert, PETSC_FALSE, o, values, array);
7053       } break;
7054     case INSERT_ALL_VALUES:
7055       for (p = 0; p < numPoints*2; p += 2) {
7056         PetscInt o = points[p+1];
7057         updatePointFields_private(section, points[p], offsets, insert, PETSC_TRUE,  o, values, array);
7058       } break;
7059     case INSERT_BC_VALUES:
7060       for (p = 0; p < numPoints*2; p += 2) {
7061         PetscInt o = points[p+1];
7062         updatePointFieldsBC_private(section, points[p], offsets, insert,  o, values, array);
7063       } break;
7064     case ADD_VALUES:
7065       for (p = 0; p < numPoints*2; p += 2) {
7066         PetscInt o = points[p+1];
7067         updatePointFields_private(section, points[p], offsets, add,    PETSC_FALSE, o, values, array);
7068       } break;
7069     case ADD_ALL_VALUES:
7070       for (p = 0; p < numPoints*2; p += 2) {
7071         PetscInt o = points[p+1];
7072         updatePointFields_private(section, points[p], offsets, add,    PETSC_TRUE,  o, values, array);
7073       } break;
7074     default:
7075       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
7076     }
7077   } else {
7078     switch (mode) {
7079     case INSERT_VALUES:
7080       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7081         PetscInt o = points[p+1];
7082         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7083         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
7084       } break;
7085     case INSERT_ALL_VALUES:
7086       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7087         PetscInt o = points[p+1];
7088         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7089         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
7090       } break;
7091     case INSERT_BC_VALUES:
7092       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7093         PetscInt o = points[p+1];
7094         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7095         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
7096       } break;
7097     case ADD_VALUES:
7098       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7099         PetscInt o = points[p+1];
7100         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7101         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
7102       } break;
7103     case ADD_ALL_VALUES:
7104       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7105         PetscInt o = points[p+1];
7106         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7107         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
7108       } break;
7109     default:
7110       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
7111     }
7112   }
7113   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7114   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
7115   PetscFunctionReturn(0);
7116 }
7117 
7118 #undef __FUNCT__
7119 #define __FUNCT__ "DMPlexPrintMatSetValues"
7120 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numIndices, const PetscInt indices[], const PetscScalar values[])
7121 {
7122   PetscMPIInt    rank;
7123   PetscInt       i, j;
7124   PetscErrorCode ierr;
7125 
7126   PetscFunctionBegin;
7127   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
7128   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
7129   for (i = 0; i < numIndices; i++) {
7130     ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat indices[%D] = %D\n", rank, i, indices[i]);CHKERRQ(ierr);
7131   }
7132   for (i = 0; i < numIndices; i++) {
7133     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
7134     for (j = 0; j < numIndices; j++) {
7135 #if defined(PETSC_USE_COMPLEX)
7136       ierr = PetscViewerASCIIPrintf(viewer, " (%G,%G)", PetscRealPart(values[i*numIndices+j]), PetscImaginaryPart(values[i*numIndices+j]));CHKERRQ(ierr);
7137 #else
7138       ierr = PetscViewerASCIIPrintf(viewer, " %G", values[i*numIndices+j]);CHKERRQ(ierr);
7139 #endif
7140     }
7141     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
7142   }
7143   PetscFunctionReturn(0);
7144 }
7145 
7146 #undef __FUNCT__
7147 #define __FUNCT__ "indicesPoint_private"
7148 /* . off - The global offset of this point */
7149 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
7150 {
7151   PetscInt        dof;    /* The number of unknowns on this point */
7152   PetscInt        cdof;   /* The number of constraints on this point */
7153   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
7154   PetscInt        cind = 0, k;
7155   PetscErrorCode  ierr;
7156 
7157   PetscFunctionBegin;
7158   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
7159   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
7160   if (!cdof || setBC) {
7161     if (orientation >= 0) {
7162       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
7163     } else {
7164       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
7165     }
7166   } else {
7167     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
7168     if (orientation >= 0) {
7169       for (k = 0; k < dof; ++k) {
7170         if ((cind < cdof) && (k == cdofs[cind])) {
7171           /* Insert check for returning constrained indices */
7172           indices[*loff+k] = -(off+k+1);
7173           ++cind;
7174         } else {
7175           indices[*loff+k] = off+k-cind;
7176         }
7177       }
7178     } else {
7179       for (k = 0; k < dof; ++k) {
7180         if ((cind < cdof) && (k == cdofs[cind])) {
7181           /* Insert check for returning constrained indices */
7182           indices[*loff+dof-k-1] = -(off+k+1);
7183           ++cind;
7184         } else {
7185           indices[*loff+dof-k-1] = off+k-cind;
7186         }
7187       }
7188     }
7189   }
7190   *loff += dof;
7191   PetscFunctionReturn(0);
7192 }
7193 
7194 #undef __FUNCT__
7195 #define __FUNCT__ "indicesPointFields_private"
7196 /* . off - The global offset of this point */
7197 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
7198 {
7199   PetscInt       numFields, foff, f;
7200   PetscErrorCode ierr;
7201 
7202   PetscFunctionBegin;
7203   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7204   for (f = 0, foff = 0; f < numFields; ++f) {
7205     PetscInt        fdof, fcomp, cfdof;
7206     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
7207     PetscInt        cind = 0, k, c;
7208 
7209     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
7210     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
7211     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
7212     if (!cfdof || setBC) {
7213       if (orientation >= 0) {
7214         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
7215       } else {
7216         for (k = fdof/fcomp-1; k >= 0; --k) {
7217           for (c = 0; c < fcomp; ++c) {
7218             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
7219           }
7220         }
7221       }
7222     } else {
7223       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
7224       if (orientation >= 0) {
7225         for (k = 0; k < fdof; ++k) {
7226           if ((cind < cfdof) && (k == fcdofs[cind])) {
7227             indices[foffs[f]+k] = -(off+foff+k+1);
7228             ++cind;
7229           } else {
7230             indices[foffs[f]+k] = off+foff+k-cind;
7231           }
7232         }
7233       } else {
7234         for (k = fdof/fcomp-1; k >= 0; --k) {
7235           for (c = 0; c < fcomp; ++c) {
7236             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
7237               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
7238               ++cind;
7239             } else {
7240               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
7241             }
7242           }
7243         }
7244       }
7245     }
7246     foff     += fdof - cfdof;
7247     foffs[f] += fdof;
7248   }
7249   PetscFunctionReturn(0);
7250 }
7251 
7252 #undef __FUNCT__
7253 #define __FUNCT__ "DMPlexMatSetClosure"
7254 /*@C
7255   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
7256 
7257   Not collective
7258 
7259   Input Parameters:
7260 + dm - The DM
7261 . section - The section describing the layout in v
7262 . globalSection - The section describing the layout in v
7263 . A - The matrix
7264 . point - The sieve point in the DM
7265 . values - The array of values
7266 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
7267 
7268   Fortran Notes:
7269   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
7270 
7271   Level: intermediate
7272 
7273 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
7274 @*/
7275 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
7276 {
7277   DM_Plex       *mesh   = (DM_Plex*) dm->data;
7278   PetscInt      *points = NULL;
7279   PetscInt      *indices;
7280   PetscInt       offsets[32];
7281   PetscInt       numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
7282   PetscErrorCode ierr;
7283 
7284   PetscFunctionBegin;
7285   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7286   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
7287   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
7288   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
7289   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7290   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
7291   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
7292   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7293   /* Compress out points not in the section */
7294   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
7295   for (p = 0, q = 0; p < numPoints*2; p += 2) {
7296     if ((points[p] >= pStart) && (points[p] < pEnd)) {
7297       points[q*2]   = points[p];
7298       points[q*2+1] = points[p+1];
7299       ++q;
7300     }
7301   }
7302   numPoints = q;
7303   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
7304     PetscInt fdof;
7305 
7306     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7307     for (f = 0; f < numFields; ++f) {
7308       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
7309       offsets[f+1] += fdof;
7310     }
7311     numIndices += dof;
7312   }
7313   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
7314 
7315   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
7316   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7317   if (numFields) {
7318     for (p = 0; p < numPoints*2; p += 2) {
7319       PetscInt o = points[p+1];
7320       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7321       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
7322     }
7323   } else {
7324     for (p = 0, off = 0; p < numPoints*2; p += 2) {
7325       PetscInt o = points[p+1];
7326       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7327       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
7328     }
7329   }
7330   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr);}
7331   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
7332   if (ierr) {
7333     PetscMPIInt    rank;
7334     PetscErrorCode ierr2;
7335 
7336     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
7337     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
7338     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr2);
7339     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
7340     CHKERRQ(ierr);
7341   }
7342   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7343   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7344   PetscFunctionReturn(0);
7345 }
7346 
7347 #undef __FUNCT__
7348 #define __FUNCT__ "DMPlexGetHybridBounds"
7349 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
7350 {
7351   DM_Plex       *mesh = (DM_Plex*) dm->data;
7352   PetscInt       dim;
7353   PetscErrorCode ierr;
7354 
7355   PetscFunctionBegin;
7356   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7357   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7358   if (cMax) *cMax = mesh->hybridPointMax[dim];
7359   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
7360   if (eMax) *eMax = mesh->hybridPointMax[1];
7361   if (vMax) *vMax = mesh->hybridPointMax[0];
7362   PetscFunctionReturn(0);
7363 }
7364 
7365 #undef __FUNCT__
7366 #define __FUNCT__ "DMPlexSetHybridBounds"
7367 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
7368 {
7369   DM_Plex       *mesh = (DM_Plex*) dm->data;
7370   PetscInt       dim;
7371   PetscErrorCode ierr;
7372 
7373   PetscFunctionBegin;
7374   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7375   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7376   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
7377   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
7378   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
7379   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
7380   PetscFunctionReturn(0);
7381 }
7382 
7383 #undef __FUNCT__
7384 #define __FUNCT__ "DMPlexGetVTKCellHeight"
7385 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
7386 {
7387   DM_Plex *mesh = (DM_Plex*) dm->data;
7388 
7389   PetscFunctionBegin;
7390   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7391   PetscValidPointer(cellHeight, 2);
7392   *cellHeight = mesh->vtkCellHeight;
7393   PetscFunctionReturn(0);
7394 }
7395 
7396 #undef __FUNCT__
7397 #define __FUNCT__ "DMPlexSetVTKCellHeight"
7398 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
7399 {
7400   DM_Plex *mesh = (DM_Plex*) dm->data;
7401 
7402   PetscFunctionBegin;
7403   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7404   mesh->vtkCellHeight = cellHeight;
7405   PetscFunctionReturn(0);
7406 }
7407 
7408 #undef __FUNCT__
7409 #define __FUNCT__ "DMPlexCreateNumbering_Private"
7410 /* We can easily have a form that takes an IS instead */
7411 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
7412 {
7413   PetscSection   section, globalSection;
7414   PetscInt      *numbers, p;
7415   PetscErrorCode ierr;
7416 
7417   PetscFunctionBegin;
7418   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
7419   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
7420   for (p = pStart; p < pEnd; ++p) {
7421     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
7422   }
7423   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
7424   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7425   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &numbers);CHKERRQ(ierr);
7426   for (p = pStart; p < pEnd; ++p) {
7427     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
7428   }
7429   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
7430   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
7431   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7432   PetscFunctionReturn(0);
7433 }
7434 
7435 #undef __FUNCT__
7436 #define __FUNCT__ "DMPlexGetCellNumbering"
7437 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7438 {
7439   DM_Plex       *mesh = (DM_Plex*) dm->data;
7440   PetscInt       cellHeight, cStart, cEnd, cMax;
7441   PetscErrorCode ierr;
7442 
7443   PetscFunctionBegin;
7444   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7445   if (!mesh->globalCellNumbers) {
7446     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7447     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7448     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
7449     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
7450     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
7451   }
7452   *globalCellNumbers = mesh->globalCellNumbers;
7453   PetscFunctionReturn(0);
7454 }
7455 
7456 #undef __FUNCT__
7457 #define __FUNCT__ "DMPlexGetVertexNumbering"
7458 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7459 {
7460   DM_Plex       *mesh = (DM_Plex*) dm->data;
7461   PetscInt       vStart, vEnd, vMax;
7462   PetscErrorCode ierr;
7463 
7464   PetscFunctionBegin;
7465   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7466   if (!mesh->globalVertexNumbers) {
7467     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7468     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
7469     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
7470     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
7471   }
7472   *globalVertexNumbers = mesh->globalVertexNumbers;
7473   PetscFunctionReturn(0);
7474 }
7475 
7476 
7477 #undef __FUNCT__
7478 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
7479 /*@C
7480   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
7481   the local section and an SF describing the section point overlap.
7482 
7483   Input Parameters:
7484   + s - The PetscSection for the local field layout
7485   . sf - The SF describing parallel layout of the section points
7486   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
7487   . label - The label specifying the points
7488   - labelValue - The label stratum specifying the points
7489 
7490   Output Parameter:
7491   . gsection - The PetscSection for the global field layout
7492 
7493   Note: This gives negative sizes and offsets to points not owned by this process
7494 
7495   Level: developer
7496 
7497 .seealso: PetscSectionCreate()
7498 @*/
7499 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
7500 {
7501   PetscInt      *neg = NULL, *tmpOff = NULL;
7502   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
7503   PetscErrorCode ierr;
7504 
7505   PetscFunctionBegin;
7506   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
7507   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
7508   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
7509   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
7510   if (nroots >= 0) {
7511     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
7512     ierr = PetscMalloc(nroots * sizeof(PetscInt), &neg);CHKERRQ(ierr);
7513     ierr = PetscMemzero(neg, nroots * sizeof(PetscInt));CHKERRQ(ierr);
7514     if (nroots > pEnd-pStart) {
7515       ierr = PetscMalloc(nroots * sizeof(PetscInt), &tmpOff);CHKERRQ(ierr);
7516       ierr = PetscMemzero(tmpOff, nroots * sizeof(PetscInt));CHKERRQ(ierr);
7517     } else {
7518       tmpOff = &(*gsection)->atlasDof[-pStart];
7519     }
7520   }
7521   /* Mark ghost points with negative dof */
7522   for (p = pStart; p < pEnd; ++p) {
7523     PetscInt value;
7524 
7525     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
7526     if (value != labelValue) continue;
7527     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
7528     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
7529     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
7530     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
7531     if (neg) neg[p] = -(dof+1);
7532   }
7533   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
7534   if (nroots >= 0) {
7535     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7536     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7537     if (nroots > pEnd-pStart) {
7538       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
7539     }
7540   }
7541   /* Calculate new sizes, get proccess offset, and calculate point offsets */
7542   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
7543     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
7544     (*gsection)->atlasOff[p] = off;
7545     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
7546   }
7547   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
7548   globalOff -= off;
7549   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
7550     (*gsection)->atlasOff[p] += globalOff;
7551     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
7552   }
7553   /* Put in negative offsets for ghost points */
7554   if (nroots >= 0) {
7555     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7556     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7557     if (nroots > pEnd-pStart) {
7558       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
7559     }
7560   }
7561   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
7562   ierr = PetscFree(neg);CHKERRQ(ierr);
7563   PetscFunctionReturn(0);
7564 }
7565