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