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