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