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