xref: /petsc/src/dm/impls/plex/plex.c (revision 05eca2e3f55d1cf4d4a0afd8b793dcdae4aebf72)
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;
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   /* Cleanup Partition */
3041   ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr);
3042   ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr);
3043   ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr);
3044   ierr = ISDestroy(&part);CHKERRQ(ierr);
3045   /* Create point SF for parallel mesh */
3046   ierr = PetscLogEventBegin(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3047   {
3048     const PetscInt *leaves;
3049     PetscSFNode    *remotePoints, *rowners, *lowners;
3050     PetscInt        numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints;
3051     PetscInt        pStart, pEnd;
3052 
3053     ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr);
3054     ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr);
3055     ierr = PetscMalloc2(numRoots,PetscSFNode,&rowners,numLeaves,PetscSFNode,&lowners);CHKERRQ(ierr);
3056     for (p=0; p<numRoots; p++) {
3057       rowners[p].rank  = -1;
3058       rowners[p].index = -1;
3059     }
3060     if (origCellPart) {
3061       /* Make sure cells in the original partition are not assigned to other procs */
3062       const PetscInt *origCells;
3063 
3064       ierr = ISGetIndices(origCellPart, &origCells);CHKERRQ(ierr);
3065       for (p = 0; p < numProcs; ++p) {
3066         PetscInt dof, off, d;
3067 
3068         ierr = PetscSectionGetDof(origCellPartSection, p, &dof);CHKERRQ(ierr);
3069         ierr = PetscSectionGetOffset(origCellPartSection, p, &off);CHKERRQ(ierr);
3070         for (d = off; d < off+dof; ++d) {
3071           rowners[origCells[d]].rank = p;
3072         }
3073       }
3074       ierr = ISRestoreIndices(origCellPart, &origCells);CHKERRQ(ierr);
3075     }
3076     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3077     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3078 
3079     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3080     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3081     for (p = 0; p < numLeaves; ++p) {
3082       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3083         lowners[p].rank  = rank;
3084         lowners[p].index = leaves ? leaves[p] : p;
3085       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3086         lowners[p].rank  = -2;
3087         lowners[p].index = -2;
3088       }
3089     }
3090     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3091       rowners[p].rank  = -3;
3092       rowners[p].index = -3;
3093     }
3094     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3095     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3096     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3097     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3098     for (p = 0; p < numLeaves; ++p) {
3099       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3100       if (lowners[p].rank != rank) ++numGhostPoints;
3101     }
3102     ierr = PetscMalloc(numGhostPoints * sizeof(PetscInt),    &ghostPoints);CHKERRQ(ierr);
3103     ierr = PetscMalloc(numGhostPoints * sizeof(PetscSFNode), &remotePoints);CHKERRQ(ierr);
3104     for (p = 0, gp = 0; p < numLeaves; ++p) {
3105       if (lowners[p].rank != rank) {
3106         ghostPoints[gp]        = leaves ? leaves[p] : p;
3107         remotePoints[gp].rank  = lowners[p].rank;
3108         remotePoints[gp].index = lowners[p].index;
3109         ++gp;
3110       }
3111     }
3112     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3113     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3114     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3115   }
3116   ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3117   /* Cleanup */
3118   ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);
3119   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3120   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3121   PetscFunctionReturn(0);
3122 }
3123 
3124 #undef __FUNCT__
3125 #define __FUNCT__ "DMPlexInvertCell"
3126 /*@C
3127   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3128 
3129   Input Parameters:
3130 + numCorners - The number of vertices in a cell
3131 - cone - The incoming cone
3132 
3133   Output Parameter:
3134 . cone - The inverted cone (in-place)
3135 
3136   Level: developer
3137 
3138 .seealso: DMPlexGenerate()
3139 @*/
3140 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3141 {
3142   int tmpc;
3143 
3144   PetscFunctionBegin;
3145   if (dim != 3) PetscFunctionReturn(0);
3146   switch (numCorners) {
3147   case 4:
3148     tmpc    = cone[0];
3149     cone[0] = cone[1];
3150     cone[1] = tmpc;
3151     break;
3152   case 8:
3153     tmpc    = cone[1];
3154     cone[1] = cone[3];
3155     cone[3] = tmpc;
3156     break;
3157   default: break;
3158   }
3159   PetscFunctionReturn(0);
3160 }
3161 
3162 #undef __FUNCT__
3163 #define __FUNCT__ "DMPlexInvertCells_Internal"
3164 /* This is to fix the tetrahedron orientation from TetGen */
3165 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3166 {
3167   PetscInt       bound = numCells*numCorners, coff;
3168   PetscErrorCode ierr;
3169 
3170   PetscFunctionBegin;
3171   for (coff = 0; coff < bound; coff += numCorners) {
3172     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3173   }
3174   PetscFunctionReturn(0);
3175 }
3176 
3177 #if defined(PETSC_HAVE_TRIANGLE)
3178 #include <triangle.h>
3179 
3180 #undef __FUNCT__
3181 #define __FUNCT__ "InitInput_Triangle"
3182 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3183 {
3184   PetscFunctionBegin;
3185   inputCtx->numberofpoints             = 0;
3186   inputCtx->numberofpointattributes    = 0;
3187   inputCtx->pointlist                  = NULL;
3188   inputCtx->pointattributelist         = NULL;
3189   inputCtx->pointmarkerlist            = NULL;
3190   inputCtx->numberofsegments           = 0;
3191   inputCtx->segmentlist                = NULL;
3192   inputCtx->segmentmarkerlist          = NULL;
3193   inputCtx->numberoftriangleattributes = 0;
3194   inputCtx->trianglelist               = NULL;
3195   inputCtx->numberofholes              = 0;
3196   inputCtx->holelist                   = NULL;
3197   inputCtx->numberofregions            = 0;
3198   inputCtx->regionlist                 = NULL;
3199   PetscFunctionReturn(0);
3200 }
3201 
3202 #undef __FUNCT__
3203 #define __FUNCT__ "InitOutput_Triangle"
3204 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3205 {
3206   PetscFunctionBegin;
3207   outputCtx->numberofpoints        = 0;
3208   outputCtx->pointlist             = NULL;
3209   outputCtx->pointattributelist    = NULL;
3210   outputCtx->pointmarkerlist       = NULL;
3211   outputCtx->numberoftriangles     = 0;
3212   outputCtx->trianglelist          = NULL;
3213   outputCtx->triangleattributelist = NULL;
3214   outputCtx->neighborlist          = NULL;
3215   outputCtx->segmentlist           = NULL;
3216   outputCtx->segmentmarkerlist     = NULL;
3217   outputCtx->numberofedges         = 0;
3218   outputCtx->edgelist              = NULL;
3219   outputCtx->edgemarkerlist        = NULL;
3220   PetscFunctionReturn(0);
3221 }
3222 
3223 #undef __FUNCT__
3224 #define __FUNCT__ "FiniOutput_Triangle"
3225 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3226 {
3227   PetscFunctionBegin;
3228   free(outputCtx->pointmarkerlist);
3229   free(outputCtx->edgelist);
3230   free(outputCtx->edgemarkerlist);
3231   free(outputCtx->trianglelist);
3232   free(outputCtx->neighborlist);
3233   PetscFunctionReturn(0);
3234 }
3235 
3236 #undef __FUNCT__
3237 #define __FUNCT__ "DMPlexGenerate_Triangle"
3238 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3239 {
3240   MPI_Comm             comm;
3241   PetscInt             dim              = 2;
3242   const PetscBool      createConvexHull = PETSC_FALSE;
3243   const PetscBool      constrained      = PETSC_FALSE;
3244   struct triangulateio in;
3245   struct triangulateio out;
3246   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3247   PetscMPIInt          rank;
3248   PetscErrorCode       ierr;
3249 
3250   PetscFunctionBegin;
3251   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3252   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3253   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3254   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3255   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3256 
3257   in.numberofpoints = vEnd - vStart;
3258   if (in.numberofpoints > 0) {
3259     PetscSection coordSection;
3260     Vec          coordinates;
3261     PetscScalar *array;
3262 
3263     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3264     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3265     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3266     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3267     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3268     for (v = vStart; v < vEnd; ++v) {
3269       const PetscInt idx = v - vStart;
3270       PetscInt       off, d;
3271 
3272       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3273       for (d = 0; d < dim; ++d) {
3274         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3275       }
3276       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3277     }
3278     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3279   }
3280   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3281   in.numberofsegments = eEnd - eStart;
3282   if (in.numberofsegments > 0) {
3283     ierr = PetscMalloc(in.numberofsegments*2 * sizeof(int), &in.segmentlist);CHKERRQ(ierr);
3284     ierr = PetscMalloc(in.numberofsegments   * sizeof(int), &in.segmentmarkerlist);CHKERRQ(ierr);
3285     for (e = eStart; e < eEnd; ++e) {
3286       const PetscInt  idx = e - eStart;
3287       const PetscInt *cone;
3288 
3289       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3290 
3291       in.segmentlist[idx*2+0] = cone[0] - vStart;
3292       in.segmentlist[idx*2+1] = cone[1] - vStart;
3293 
3294       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3295     }
3296   }
3297 #if 0 /* Do not currently support holes */
3298   PetscReal *holeCoords;
3299   PetscInt   h, d;
3300 
3301   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3302   if (in.numberofholes > 0) {
3303     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3304     for (h = 0; h < in.numberofholes; ++h) {
3305       for (d = 0; d < dim; ++d) {
3306         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3307       }
3308     }
3309   }
3310 #endif
3311   if (!rank) {
3312     char args[32];
3313 
3314     /* Take away 'Q' for verbose output */
3315     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3316     if (createConvexHull) {
3317       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3318     }
3319     if (constrained) {
3320       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3321     }
3322     triangulate(args, &in, &out, NULL);
3323   }
3324   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3325   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3326   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3327   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3328   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3329 
3330   {
3331     const PetscInt numCorners  = 3;
3332     const PetscInt numCells    = out.numberoftriangles;
3333     const PetscInt numVertices = out.numberofpoints;
3334     const int     *cells      = out.trianglelist;
3335     const double  *meshCoords = out.pointlist;
3336 
3337     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3338     /* Set labels */
3339     for (v = 0; v < numVertices; ++v) {
3340       if (out.pointmarkerlist[v]) {
3341         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3342       }
3343     }
3344     if (interpolate) {
3345       for (e = 0; e < out.numberofedges; e++) {
3346         if (out.edgemarkerlist[e]) {
3347           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3348           const PetscInt *edges;
3349           PetscInt        numEdges;
3350 
3351           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3352           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3353           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3354           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3355         }
3356       }
3357     }
3358     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3359   }
3360 #if 0 /* Do not currently support holes */
3361   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3362 #endif
3363   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3364   PetscFunctionReturn(0);
3365 }
3366 
3367 #undef __FUNCT__
3368 #define __FUNCT__ "DMPlexRefine_Triangle"
3369 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3370 {
3371   MPI_Comm             comm;
3372   PetscInt             dim  = 2;
3373   struct triangulateio in;
3374   struct triangulateio out;
3375   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3376   PetscMPIInt          rank;
3377   PetscErrorCode       ierr;
3378 
3379   PetscFunctionBegin;
3380   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3381   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3382   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3383   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3384   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3385   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3386   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3387 
3388   in.numberofpoints = vEnd - vStart;
3389   if (in.numberofpoints > 0) {
3390     PetscSection coordSection;
3391     Vec          coordinates;
3392     PetscScalar *array;
3393 
3394     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3395     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3396     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3397     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3398     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3399     for (v = vStart; v < vEnd; ++v) {
3400       const PetscInt idx = v - vStart;
3401       PetscInt       off, d;
3402 
3403       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3404       for (d = 0; d < dim; ++d) {
3405         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3406       }
3407       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3408     }
3409     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3410   }
3411   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3412 
3413   in.numberofcorners   = 3;
3414   in.numberoftriangles = cEnd - cStart;
3415 
3416   in.trianglearealist  = (double*) maxVolumes;
3417   if (in.numberoftriangles > 0) {
3418     ierr = PetscMalloc(in.numberoftriangles*in.numberofcorners * sizeof(int), &in.trianglelist);CHKERRQ(ierr);
3419     for (c = cStart; c < cEnd; ++c) {
3420       const PetscInt idx      = c - cStart;
3421       PetscInt      *closure = NULL;
3422       PetscInt       closureSize;
3423 
3424       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3425       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3426       for (v = 0; v < 3; ++v) {
3427         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3428       }
3429       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3430     }
3431   }
3432   /* TODO: Segment markers are missing on input */
3433 #if 0 /* Do not currently support holes */
3434   PetscReal *holeCoords;
3435   PetscInt   h, d;
3436 
3437   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3438   if (in.numberofholes > 0) {
3439     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3440     for (h = 0; h < in.numberofholes; ++h) {
3441       for (d = 0; d < dim; ++d) {
3442         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3443       }
3444     }
3445   }
3446 #endif
3447   if (!rank) {
3448     char args[32];
3449 
3450     /* Take away 'Q' for verbose output */
3451     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3452     triangulate(args, &in, &out, NULL);
3453   }
3454   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3455   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3456   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3457   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3458   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3459 
3460   {
3461     const PetscInt numCorners  = 3;
3462     const PetscInt numCells    = out.numberoftriangles;
3463     const PetscInt numVertices = out.numberofpoints;
3464     const int     *cells      = out.trianglelist;
3465     const double  *meshCoords = out.pointlist;
3466     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3467 
3468     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3469     /* Set labels */
3470     for (v = 0; v < numVertices; ++v) {
3471       if (out.pointmarkerlist[v]) {
3472         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3473       }
3474     }
3475     if (interpolate) {
3476       PetscInt e;
3477 
3478       for (e = 0; e < out.numberofedges; e++) {
3479         if (out.edgemarkerlist[e]) {
3480           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3481           const PetscInt *edges;
3482           PetscInt        numEdges;
3483 
3484           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3485           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3486           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3487           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3488         }
3489       }
3490     }
3491     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3492   }
3493 #if 0 /* Do not currently support holes */
3494   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3495 #endif
3496   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3497   PetscFunctionReturn(0);
3498 }
3499 #endif
3500 
3501 #if defined(PETSC_HAVE_TETGEN)
3502 #include <tetgen.h>
3503 #undef __FUNCT__
3504 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3505 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3506 {
3507   MPI_Comm       comm;
3508   const PetscInt dim  = 3;
3509   ::tetgenio     in;
3510   ::tetgenio     out;
3511   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3512   PetscMPIInt    rank;
3513   PetscErrorCode ierr;
3514 
3515   PetscFunctionBegin;
3516   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3517   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3518   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3519   in.numberofpoints = vEnd - vStart;
3520   if (in.numberofpoints > 0) {
3521     PetscSection coordSection;
3522     Vec          coordinates;
3523     PetscScalar *array;
3524 
3525     in.pointlist       = new double[in.numberofpoints*dim];
3526     in.pointmarkerlist = new int[in.numberofpoints];
3527 
3528     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3529     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3530     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3531     for (v = vStart; v < vEnd; ++v) {
3532       const PetscInt idx = v - vStart;
3533       PetscInt       off, d;
3534 
3535       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3536       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3537       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3538     }
3539     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3540   }
3541   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3542 
3543   in.numberoffacets = fEnd - fStart;
3544   if (in.numberoffacets > 0) {
3545     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3546     in.facetmarkerlist = new int[in.numberoffacets];
3547     for (f = fStart; f < fEnd; ++f) {
3548       const PetscInt idx     = f - fStart;
3549       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3550 
3551       in.facetlist[idx].numberofpolygons = 1;
3552       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3553       in.facetlist[idx].numberofholes    = 0;
3554       in.facetlist[idx].holelist         = NULL;
3555 
3556       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3557       for (p = 0; p < numPoints*2; p += 2) {
3558         const PetscInt point = points[p];
3559         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3560       }
3561 
3562       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3563       poly->numberofvertices = numVertices;
3564       poly->vertexlist       = new int[poly->numberofvertices];
3565       for (v = 0; v < numVertices; ++v) {
3566         const PetscInt vIdx = points[v] - vStart;
3567         poly->vertexlist[v] = vIdx;
3568       }
3569       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3570       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3571     }
3572   }
3573   if (!rank) {
3574     char args[32];
3575 
3576     /* Take away 'Q' for verbose output */
3577     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3578     ::tetrahedralize(args, &in, &out);
3579   }
3580   {
3581     const PetscInt numCorners  = 4;
3582     const PetscInt numCells    = out.numberoftetrahedra;
3583     const PetscInt numVertices = out.numberofpoints;
3584     const double   *meshCoords = out.pointlist;
3585     int            *cells      = out.tetrahedronlist;
3586 
3587     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3588     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3589     /* Set labels */
3590     for (v = 0; v < numVertices; ++v) {
3591       if (out.pointmarkerlist[v]) {
3592         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3593       }
3594     }
3595     if (interpolate) {
3596       PetscInt e;
3597 
3598       for (e = 0; e < out.numberofedges; e++) {
3599         if (out.edgemarkerlist[e]) {
3600           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3601           const PetscInt *edges;
3602           PetscInt        numEdges;
3603 
3604           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3605           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3606           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3607           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3608         }
3609       }
3610       for (f = 0; f < out.numberoftrifaces; f++) {
3611         if (out.trifacemarkerlist[f]) {
3612           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3613           const PetscInt *faces;
3614           PetscInt        numFaces;
3615 
3616           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3617           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3618           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3619           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3620         }
3621       }
3622     }
3623     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3624   }
3625   PetscFunctionReturn(0);
3626 }
3627 
3628 #undef __FUNCT__
3629 #define __FUNCT__ "DMPlexRefine_Tetgen"
3630 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3631 {
3632   MPI_Comm       comm;
3633   const PetscInt dim  = 3;
3634   ::tetgenio     in;
3635   ::tetgenio     out;
3636   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3637   PetscMPIInt    rank;
3638   PetscErrorCode ierr;
3639 
3640   PetscFunctionBegin;
3641   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3642   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3643   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3644   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3645   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3646 
3647   in.numberofpoints = vEnd - vStart;
3648   if (in.numberofpoints > 0) {
3649     PetscSection coordSection;
3650     Vec          coordinates;
3651     PetscScalar *array;
3652 
3653     in.pointlist       = new double[in.numberofpoints*dim];
3654     in.pointmarkerlist = new int[in.numberofpoints];
3655 
3656     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3657     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3658     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3659     for (v = vStart; v < vEnd; ++v) {
3660       const PetscInt idx = v - vStart;
3661       PetscInt       off, d;
3662 
3663       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3664       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3665       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3666     }
3667     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3668   }
3669   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3670 
3671   in.numberofcorners       = 4;
3672   in.numberoftetrahedra    = cEnd - cStart;
3673   in.tetrahedronvolumelist = (double*) maxVolumes;
3674   if (in.numberoftetrahedra > 0) {
3675     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3676     for (c = cStart; c < cEnd; ++c) {
3677       const PetscInt idx      = c - cStart;
3678       PetscInt      *closure = NULL;
3679       PetscInt       closureSize;
3680 
3681       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3682       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3683       for (v = 0; v < 4; ++v) {
3684         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3685       }
3686       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3687     }
3688   }
3689   /* TODO: Put in boundary faces with markers */
3690   if (!rank) {
3691     char args[32];
3692 
3693     /* Take away 'Q' for verbose output */
3694     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3695     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3696     ::tetrahedralize(args, &in, &out);
3697   }
3698   in.tetrahedronvolumelist = NULL;
3699 
3700   {
3701     const PetscInt numCorners  = 4;
3702     const PetscInt numCells    = out.numberoftetrahedra;
3703     const PetscInt numVertices = out.numberofpoints;
3704     const double   *meshCoords = out.pointlist;
3705     int            *cells      = out.tetrahedronlist;
3706 
3707     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3708 
3709     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3710     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3711     /* Set labels */
3712     for (v = 0; v < numVertices; ++v) {
3713       if (out.pointmarkerlist[v]) {
3714         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3715       }
3716     }
3717     if (interpolate) {
3718       PetscInt e, f;
3719 
3720       for (e = 0; e < out.numberofedges; e++) {
3721         if (out.edgemarkerlist[e]) {
3722           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3723           const PetscInt *edges;
3724           PetscInt        numEdges;
3725 
3726           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3727           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3728           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3729           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3730         }
3731       }
3732       for (f = 0; f < out.numberoftrifaces; f++) {
3733         if (out.trifacemarkerlist[f]) {
3734           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3735           const PetscInt *faces;
3736           PetscInt        numFaces;
3737 
3738           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3739           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3740           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3741           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3742         }
3743       }
3744     }
3745     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3746   }
3747   PetscFunctionReturn(0);
3748 }
3749 #endif
3750 
3751 #if defined(PETSC_HAVE_CTETGEN)
3752 #include "ctetgen.h"
3753 
3754 #undef __FUNCT__
3755 #define __FUNCT__ "DMPlexGenerate_CTetgen"
3756 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
3757 {
3758   MPI_Comm       comm;
3759   const PetscInt dim  = 3;
3760   PLC           *in, *out;
3761   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
3762   PetscMPIInt    rank;
3763   PetscErrorCode ierr;
3764 
3765   PetscFunctionBegin;
3766   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3767   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3768   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3769   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3770   ierr = PLCCreate(&in);CHKERRQ(ierr);
3771   ierr = PLCCreate(&out);CHKERRQ(ierr);
3772 
3773   in->numberofpoints = vEnd - vStart;
3774   if (in->numberofpoints > 0) {
3775     PetscSection coordSection;
3776     Vec          coordinates;
3777     PetscScalar *array;
3778 
3779     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
3780     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
3781     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3782     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3783     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3784     for (v = vStart; v < vEnd; ++v) {
3785       const PetscInt idx = v - vStart;
3786       PetscInt       off, d, m;
3787 
3788       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3789       for (d = 0; d < dim; ++d) {
3790         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3791       }
3792       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
3793 
3794       in->pointmarkerlist[idx] = (int) m;
3795     }
3796     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3797   }
3798   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3799 
3800   in->numberoffacets = fEnd - fStart;
3801   if (in->numberoffacets > 0) {
3802     ierr = PetscMalloc(in->numberoffacets * sizeof(facet), &in->facetlist);CHKERRQ(ierr);
3803     ierr = PetscMalloc(in->numberoffacets * sizeof(int),   &in->facetmarkerlist);CHKERRQ(ierr);
3804     for (f = fStart; f < fEnd; ++f) {
3805       const PetscInt idx     = f - fStart;
3806       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
3807       polygon       *poly;
3808 
3809       in->facetlist[idx].numberofpolygons = 1;
3810 
3811       ierr = PetscMalloc(in->facetlist[idx].numberofpolygons * sizeof(polygon), &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
3812 
3813       in->facetlist[idx].numberofholes    = 0;
3814       in->facetlist[idx].holelist         = NULL;
3815 
3816       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3817       for (p = 0; p < numPoints*2; p += 2) {
3818         const PetscInt point = points[p];
3819         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3820       }
3821 
3822       poly                   = in->facetlist[idx].polygonlist;
3823       poly->numberofvertices = numVertices;
3824       ierr                   = PetscMalloc(poly->numberofvertices * sizeof(int), &poly->vertexlist);CHKERRQ(ierr);
3825       for (v = 0; v < numVertices; ++v) {
3826         const PetscInt vIdx = points[v] - vStart;
3827         poly->vertexlist[v] = vIdx;
3828       }
3829       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
3830       in->facetmarkerlist[idx] = (int) m;
3831       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3832     }
3833   }
3834   if (!rank) {
3835     TetGenOpts t;
3836 
3837     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3838     t.in        = boundary; /* Should go away */
3839     t.plc       = 1;
3840     t.quality   = 1;
3841     t.edgesout  = 1;
3842     t.zeroindex = 1;
3843     t.quiet     = 1;
3844     t.verbose   = verbose;
3845     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
3846     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3847   }
3848   {
3849     const PetscInt numCorners  = 4;
3850     const PetscInt numCells    = out->numberoftetrahedra;
3851     const PetscInt numVertices = out->numberofpoints;
3852     const double   *meshCoords = out->pointlist;
3853     int            *cells      = out->tetrahedronlist;
3854 
3855     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3856     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3857     /* Set labels */
3858     for (v = 0; v < numVertices; ++v) {
3859       if (out->pointmarkerlist[v]) {
3860         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3861       }
3862     }
3863     if (interpolate) {
3864       PetscInt e;
3865 
3866       for (e = 0; e < out->numberofedges; e++) {
3867         if (out->edgemarkerlist[e]) {
3868           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3869           const PetscInt *edges;
3870           PetscInt        numEdges;
3871 
3872           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3873           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3874           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3875           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3876         }
3877       }
3878       for (f = 0; f < out->numberoftrifaces; f++) {
3879         if (out->trifacemarkerlist[f]) {
3880           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3881           const PetscInt *faces;
3882           PetscInt        numFaces;
3883 
3884           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3885           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3886           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
3887           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3888         }
3889       }
3890     }
3891     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3892   }
3893 
3894   ierr = PLCDestroy(&in);CHKERRQ(ierr);
3895   ierr = PLCDestroy(&out);CHKERRQ(ierr);
3896   PetscFunctionReturn(0);
3897 }
3898 
3899 #undef __FUNCT__
3900 #define __FUNCT__ "DMPlexRefine_CTetgen"
3901 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
3902 {
3903   MPI_Comm       comm;
3904   const PetscInt dim  = 3;
3905   PLC           *in, *out;
3906   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3907   PetscMPIInt    rank;
3908   PetscErrorCode ierr;
3909 
3910   PetscFunctionBegin;
3911   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3912   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3913   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3914   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3915   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3916   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3917   ierr = PLCCreate(&in);CHKERRQ(ierr);
3918   ierr = PLCCreate(&out);CHKERRQ(ierr);
3919 
3920   in->numberofpoints = vEnd - vStart;
3921   if (in->numberofpoints > 0) {
3922     PetscSection coordSection;
3923     Vec          coordinates;
3924     PetscScalar *array;
3925 
3926     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
3927     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
3928     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3929     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3930     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3931     for (v = vStart; v < vEnd; ++v) {
3932       const PetscInt idx = v - vStart;
3933       PetscInt       off, d, m;
3934 
3935       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3936       for (d = 0; d < dim; ++d) {
3937         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3938       }
3939       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
3940 
3941       in->pointmarkerlist[idx] = (int) m;
3942     }
3943     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3944   }
3945   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3946 
3947   in->numberofcorners       = 4;
3948   in->numberoftetrahedra    = cEnd - cStart;
3949   in->tetrahedronvolumelist = maxVolumes;
3950   if (in->numberoftetrahedra > 0) {
3951     ierr = PetscMalloc(in->numberoftetrahedra*in->numberofcorners * sizeof(int), &in->tetrahedronlist);CHKERRQ(ierr);
3952     for (c = cStart; c < cEnd; ++c) {
3953       const PetscInt idx      = c - cStart;
3954       PetscInt      *closure = NULL;
3955       PetscInt       closureSize;
3956 
3957       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3958       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3959       for (v = 0; v < 4; ++v) {
3960         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3961       }
3962       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3963     }
3964   }
3965   if (!rank) {
3966     TetGenOpts t;
3967 
3968     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3969 
3970     t.in        = dm; /* Should go away */
3971     t.refine    = 1;
3972     t.varvolume = 1;
3973     t.quality   = 1;
3974     t.edgesout  = 1;
3975     t.zeroindex = 1;
3976     t.quiet     = 1;
3977     t.verbose   = verbose; /* Change this */
3978 
3979     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
3980     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3981   }
3982   {
3983     const PetscInt numCorners  = 4;
3984     const PetscInt numCells    = out->numberoftetrahedra;
3985     const PetscInt numVertices = out->numberofpoints;
3986     const double   *meshCoords = out->pointlist;
3987     int            *cells      = out->tetrahedronlist;
3988     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3989 
3990     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3991     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3992     /* Set labels */
3993     for (v = 0; v < numVertices; ++v) {
3994       if (out->pointmarkerlist[v]) {
3995         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3996       }
3997     }
3998     if (interpolate) {
3999       PetscInt e, f;
4000 
4001       for (e = 0; e < out->numberofedges; e++) {
4002         if (out->edgemarkerlist[e]) {
4003           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4004           const PetscInt *edges;
4005           PetscInt        numEdges;
4006 
4007           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4008           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4009           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4010           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4011         }
4012       }
4013       for (f = 0; f < out->numberoftrifaces; f++) {
4014         if (out->trifacemarkerlist[f]) {
4015           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4016           const PetscInt *faces;
4017           PetscInt        numFaces;
4018 
4019           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4020           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4021           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4022           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4023         }
4024       }
4025     }
4026     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4027   }
4028   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4029   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4030   PetscFunctionReturn(0);
4031 }
4032 #endif
4033 
4034 #undef __FUNCT__
4035 #define __FUNCT__ "DMPlexGenerate"
4036 /*@C
4037   DMPlexGenerate - Generates a mesh.
4038 
4039   Not Collective
4040 
4041   Input Parameters:
4042 + boundary - The DMPlex boundary object
4043 . name - The mesh generation package name
4044 - interpolate - Flag to create intermediate mesh elements
4045 
4046   Output Parameter:
4047 . mesh - The DMPlex object
4048 
4049   Level: intermediate
4050 
4051 .keywords: mesh, elements
4052 .seealso: DMPlexCreate(), DMRefine()
4053 @*/
4054 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4055 {
4056   PetscInt       dim;
4057   char           genname[1024];
4058   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4059   PetscErrorCode ierr;
4060 
4061   PetscFunctionBegin;
4062   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4063   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4064   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4065   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4066   if (flg) name = genname;
4067   if (name) {
4068     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4069     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4070     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4071   }
4072   switch (dim) {
4073   case 1:
4074     if (!name || isTriangle) {
4075 #if defined(PETSC_HAVE_TRIANGLE)
4076       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4077 #else
4078       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4079 #endif
4080     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4081     break;
4082   case 2:
4083     if (!name || isCTetgen) {
4084 #if defined(PETSC_HAVE_CTETGEN)
4085       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4086 #else
4087       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4088 #endif
4089     } else if (isTetgen) {
4090 #if defined(PETSC_HAVE_TETGEN)
4091       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4092 #else
4093       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4094 #endif
4095     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4096     break;
4097   default:
4098     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4099   }
4100   PetscFunctionReturn(0);
4101 }
4102 
4103 typedef PetscInt CellRefiner;
4104 
4105 #undef __FUNCT__
4106 #define __FUNCT__ "GetDepthStart_Private"
4107 PETSC_STATIC_INLINE PetscErrorCode GetDepthStart_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cStart, PetscInt *fStart, PetscInt *eStart, PetscInt *vStart)
4108 {
4109   PetscFunctionBegin;
4110   if (cStart) *cStart = 0;
4111   if (vStart) *vStart = depthSize[depth];
4112   if (fStart) *fStart = depthSize[depth] + depthSize[0];
4113   if (eStart) *eStart = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4114   PetscFunctionReturn(0);
4115 }
4116 
4117 #undef __FUNCT__
4118 #define __FUNCT__ "GetDepthEnd_Private"
4119 PETSC_STATIC_INLINE PetscErrorCode GetDepthEnd_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cEnd, PetscInt *fEnd, PetscInt *eEnd, PetscInt *vEnd)
4120 {
4121   PetscFunctionBegin;
4122   if (cEnd) *cEnd = depthSize[depth];
4123   if (vEnd) *vEnd = depthSize[depth] + depthSize[0];
4124   if (fEnd) *fEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4125   if (eEnd) *eEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1] + depthSize[1];
4126   PetscFunctionReturn(0);
4127 }
4128 
4129 #undef __FUNCT__
4130 #define __FUNCT__ "CellRefinerGetSizes"
4131 PetscErrorCode CellRefinerGetSizes(CellRefiner refiner, DM dm, PetscInt depthSize[])
4132 {
4133   PetscInt       cStart, cEnd, cMax, vStart, vEnd, vMax, fStart, fEnd, fMax, eStart, eEnd, eMax;
4134   PetscErrorCode ierr;
4135 
4136   PetscFunctionBegin;
4137   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4138   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4139   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4140   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4141   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4142   switch (refiner) {
4143   case 1:
4144     /* Simplicial 2D */
4145     depthSize[0] = vEnd - vStart + fEnd - fStart;         /* Add a vertex on every face */
4146     depthSize[1] = 2*(fEnd - fStart) + 3*(cEnd - cStart); /* Every face is split into 2 faces and 3 faces are added for each cell */
4147     depthSize[2] = 4*(cEnd - cStart);                     /* Every cell split into 4 cells */
4148     break;
4149   case 3:
4150     /* Hybrid 2D */
4151     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4152     cMax = PetscMin(cEnd, cMax);
4153     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4154     fMax         = PetscMin(fEnd, fMax);
4155     depthSize[0] = vEnd - vStart + fMax - fStart;                                         /* Add a vertex on every face, but not hybrid faces */
4156     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 */
4157     depthSize[2] = 4*(cMax - cStart) + 2*(cEnd - cMax);                                   /* Interior cells split into 4 cells, Hybrid cells split into 2 cells */
4158     break;
4159   case 2:
4160     /* Hex 2D */
4161     depthSize[0] = vEnd - vStart + cEnd - cStart + fEnd - fStart; /* Add a vertex on every face and cell */
4162     depthSize[1] = 2*(fEnd - fStart) + 4*(cEnd - cStart);         /* Every face is split into 2 faces and 4 faces are added for each cell */
4163     depthSize[2] = 4*(cEnd - cStart);                             /* Every cell split into 4 cells */
4164     break;
4165   default:
4166     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4167   }
4168   PetscFunctionReturn(0);
4169 }
4170 
4171 #undef __FUNCT__
4172 #define __FUNCT__ "CellRefinerSetConeSizes"
4173 PetscErrorCode CellRefinerSetConeSizes(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4174 {
4175   PetscInt       depth, cStart, cStartNew, cEnd, cMax, c, vStart, vStartNew, vEnd, vMax, v, fStart, fStartNew, fEnd, fMax, f, eStart, eStartNew, eEnd, eMax, r;
4176   PetscErrorCode ierr;
4177 
4178   PetscFunctionBegin;
4179   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4180   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4181   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4182   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4183   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4184   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4185   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4186   switch (refiner) {
4187   case 1:
4188     /* Simplicial 2D */
4189     /* All cells have 3 faces */
4190     for (c = cStart; c < cEnd; ++c) {
4191       for (r = 0; r < 4; ++r) {
4192         const PetscInt newp = (c - cStart)*4 + r;
4193 
4194         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4195       }
4196     }
4197     /* Split faces have 2 vertices and the same cells as the parent */
4198     for (f = fStart; f < fEnd; ++f) {
4199       for (r = 0; r < 2; ++r) {
4200         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4201         PetscInt       size;
4202 
4203         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4204         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4205         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4206       }
4207     }
4208     /* Interior faces have 2 vertices and 2 cells */
4209     for (c = cStart; c < cEnd; ++c) {
4210       for (r = 0; r < 3; ++r) {
4211         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4212 
4213         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4214         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4215       }
4216     }
4217     /* Old vertices have identical supports */
4218     for (v = vStart; v < vEnd; ++v) {
4219       const PetscInt newp = vStartNew + (v - vStart);
4220       PetscInt       size;
4221 
4222       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4223       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4224     }
4225     /* Face vertices have 2 + cells*2 supports */
4226     for (f = fStart; f < fEnd; ++f) {
4227       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4228       PetscInt       size;
4229 
4230       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4231       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size*2);CHKERRQ(ierr);
4232     }
4233     break;
4234   case 2:
4235     /* Hex 2D */
4236     /* All cells have 4 faces */
4237     for (c = cStart; c < cEnd; ++c) {
4238       for (r = 0; r < 4; ++r) {
4239         const PetscInt newp = (c - cStart)*4 + r;
4240 
4241         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4242       }
4243     }
4244     /* Split faces have 2 vertices and the same cells as the parent */
4245     for (f = fStart; f < fEnd; ++f) {
4246       for (r = 0; r < 2; ++r) {
4247         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4248         PetscInt       size;
4249 
4250         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4251         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4252         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4253       }
4254     }
4255     /* Interior faces have 2 vertices and 2 cells */
4256     for (c = cStart; c < cEnd; ++c) {
4257       for (r = 0; r < 4; ++r) {
4258         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4259 
4260         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4261         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4262       }
4263     }
4264     /* Old vertices have identical supports */
4265     for (v = vStart; v < vEnd; ++v) {
4266       const PetscInt newp = vStartNew + (v - vStart);
4267       PetscInt       size;
4268 
4269       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4270       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4271     }
4272     /* Face vertices have 2 + cells supports */
4273     for (f = fStart; f < fEnd; ++f) {
4274       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4275       PetscInt       size;
4276 
4277       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4278       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size);CHKERRQ(ierr);
4279     }
4280     /* Cell vertices have 4 supports */
4281     for (c = cStart; c < cEnd; ++c) {
4282       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
4283 
4284       ierr = DMPlexSetSupportSize(rdm, newp, 4);CHKERRQ(ierr);
4285     }
4286     break;
4287   case 3:
4288     /* Hybrid 2D */
4289     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4290     cMax = PetscMin(cEnd, cMax);
4291     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4292     fMax = PetscMin(fEnd, fMax);
4293     ierr = DMPlexSetHybridBounds(rdm, cStartNew + (cMax - cStart)*4, fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
4294     /* Interior cells have 3 faces */
4295     for (c = cStart; c < cMax; ++c) {
4296       for (r = 0; r < 4; ++r) {
4297         const PetscInt newp = cStartNew + (c - cStart)*4 + r;
4298 
4299         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4300       }
4301     }
4302     /* Hybrid cells have 4 faces */
4303     for (c = cMax; c < cEnd; ++c) {
4304       for (r = 0; r < 2; ++r) {
4305         const PetscInt newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2 + r;
4306 
4307         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4308       }
4309     }
4310     /* Interior split faces have 2 vertices and the same cells as the parent */
4311     for (f = fStart; f < fMax; ++f) {
4312       for (r = 0; r < 2; ++r) {
4313         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4314         PetscInt       size;
4315 
4316         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4317         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4318         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4319       }
4320     }
4321     /* Interior cell faces have 2 vertices and 2 cells */
4322     for (c = cStart; c < cMax; ++c) {
4323       for (r = 0; r < 3; ++r) {
4324         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
4325 
4326         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4327         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4328       }
4329     }
4330     /* Hybrid faces have 2 vertices and the same cells */
4331     for (f = fMax; f < fEnd; ++f) {
4332       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
4333       PetscInt       size;
4334 
4335       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4336       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4337       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4338     }
4339     /* Hybrid cell faces have 2 vertices and 2 cells */
4340     for (c = cMax; c < cEnd; ++c) {
4341       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
4342 
4343       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4344       ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4345     }
4346     /* Old vertices have identical supports */
4347     for (v = vStart; v < vEnd; ++v) {
4348       const PetscInt newp = vStartNew + (v - vStart);
4349       PetscInt       size;
4350 
4351       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4352       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4353     }
4354     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
4355     for (f = fStart; f < fMax; ++f) {
4356       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4357       const PetscInt *support;
4358       PetscInt       size, newSize = 2, s;
4359 
4360       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4361       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4362       for (s = 0; s < size; ++s) {
4363         if (support[s] >= cMax) newSize += 1;
4364         else newSize += 2;
4365       }
4366       ierr = DMPlexSetSupportSize(rdm, newp, newSize);CHKERRQ(ierr);
4367     }
4368     break;
4369   default:
4370     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4371   }
4372   PetscFunctionReturn(0);
4373 }
4374 
4375 #undef __FUNCT__
4376 #define __FUNCT__ "CellRefinerSetCones"
4377 PetscErrorCode CellRefinerSetCones(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4378 {
4379   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;
4380   PetscInt       maxSupportSize, *supportRef;
4381   PetscErrorCode ierr;
4382 
4383   PetscFunctionBegin;
4384   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4385   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4386   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4387   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4388   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4389   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4390   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4391   ierr = GetDepthEnd_Private(depth, depthSize, &cEndNew, &fEndNew, &eEndNew, &vEndNew);CHKERRQ(ierr);
4392   switch (refiner) {
4393   case 1:
4394     /* Simplicial 2D */
4395     /*
4396      2
4397      |\
4398      | \
4399      |  \
4400      |   \
4401      | C  \
4402      |     \
4403      |      \
4404      2---1---1
4405      |\  D  / \
4406      | 2   0   \
4407      |A \ /  B  \
4408      0---0-------1
4409      */
4410     /* All cells have 3 faces */
4411     for (c = cStart; c < cEnd; ++c) {
4412       const PetscInt  newp = cStartNew + (c - cStart)*4;
4413       const PetscInt *cone, *ornt;
4414       PetscInt        coneNew[3], orntNew[3];
4415 
4416       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4417       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4418       /* A triangle */
4419       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4420       orntNew[0] = ornt[0];
4421       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4422       orntNew[1] = -2;
4423       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4424       orntNew[2] = ornt[2];
4425       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4426       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4427 #if 1
4428       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);
4429       for (p = 0; p < 3; ++p) {
4430         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);
4431       }
4432 #endif
4433       /* B triangle */
4434       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4435       orntNew[0] = ornt[0];
4436       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4437       orntNew[1] = ornt[1];
4438       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4439       orntNew[2] = -2;
4440       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4441       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4442 #if 1
4443       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);
4444       for (p = 0; p < 3; ++p) {
4445         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);
4446       }
4447 #endif
4448       /* C triangle */
4449       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4450       orntNew[0] = -2;
4451       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4452       orntNew[1] = ornt[1];
4453       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4454       orntNew[2] = ornt[2];
4455       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4456       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4457 #if 1
4458       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);
4459       for (p = 0; p < 3; ++p) {
4460         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);
4461       }
4462 #endif
4463       /* D triangle */
4464       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4465       orntNew[0] = 0;
4466       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4467       orntNew[1] = 0;
4468       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4469       orntNew[2] = 0;
4470       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4471       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4472 #if 1
4473       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);
4474       for (p = 0; p < 3; ++p) {
4475         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);
4476       }
4477 #endif
4478     }
4479     /* Split faces have 2 vertices and the same cells as the parent */
4480     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4481     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4482     for (f = fStart; f < fEnd; ++f) {
4483       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4484 
4485       for (r = 0; r < 2; ++r) {
4486         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4487         const PetscInt *cone, *support;
4488         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4489 
4490         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4491         coneNew[0]       = vStartNew + (cone[0] - vStart);
4492         coneNew[1]       = vStartNew + (cone[1] - vStart);
4493         coneNew[(r+1)%2] = newv;
4494         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4495 #if 1
4496         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4497         for (p = 0; p < 2; ++p) {
4498           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);
4499         }
4500 #endif
4501         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4502         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4503         for (s = 0; s < supportSize; ++s) {
4504           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4505           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4506           for (c = 0; c < coneSize; ++c) {
4507             if (cone[c] == f) break;
4508           }
4509           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
4510         }
4511         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4512 #if 1
4513         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4514         for (p = 0; p < supportSize; ++p) {
4515           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);
4516         }
4517 #endif
4518       }
4519     }
4520     /* Interior faces have 2 vertices and 2 cells */
4521     for (c = cStart; c < cEnd; ++c) {
4522       const PetscInt *cone;
4523 
4524       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4525       for (r = 0; r < 3; ++r) {
4526         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4527         PetscInt       coneNew[2];
4528         PetscInt       supportNew[2];
4529 
4530         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
4531         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
4532         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4533 #if 1
4534         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4535         for (p = 0; p < 2; ++p) {
4536           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4537         }
4538 #endif
4539         supportNew[0] = (c - cStart)*4 + (r+1)%3;
4540         supportNew[1] = (c - cStart)*4 + 3;
4541         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4542 #if 1
4543         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4544         for (p = 0; p < 2; ++p) {
4545           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);
4546         }
4547 #endif
4548       }
4549     }
4550     /* Old vertices have identical supports */
4551     for (v = vStart; v < vEnd; ++v) {
4552       const PetscInt  newp = vStartNew + (v - vStart);
4553       const PetscInt *support, *cone;
4554       PetscInt        size, s;
4555 
4556       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4557       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
4558       for (s = 0; s < size; ++s) {
4559         PetscInt r = 0;
4560 
4561         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4562         if (cone[1] == v) r = 1;
4563         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
4564       }
4565       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4566 #if 1
4567       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4568       for (p = 0; p < size; ++p) {
4569         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);
4570       }
4571 #endif
4572     }
4573     /* Face vertices have 2 + cells*2 supports */
4574     for (f = fStart; f < fEnd; ++f) {
4575       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
4576       const PetscInt *cone, *support;
4577       PetscInt        size, s;
4578 
4579       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4580       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4581       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
4582       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
4583       for (s = 0; s < size; ++s) {
4584         PetscInt r = 0;
4585 
4586         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4587         if      (cone[1] == f) r = 1;
4588         else if (cone[2] == f) r = 2;
4589         supportRef[2+s*2+0] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
4590         supportRef[2+s*2+1] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + r;
4591       }
4592       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4593 #if 1
4594       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4595       for (p = 0; p < 2+size*2; ++p) {
4596         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);
4597       }
4598 #endif
4599     }
4600     ierr = PetscFree(supportRef);CHKERRQ(ierr);
4601     break;
4602   case 2:
4603     /* Hex 2D */
4604     /*
4605      3---------2---------2
4606      |         |         |
4607      |    D    2    C    |
4608      |         |         |
4609      3----3----0----1----1
4610      |         |         |
4611      |    A    0    B    |
4612      |         |         |
4613      0---------0---------1
4614      */
4615     /* All cells have 4 faces */
4616     for (c = cStart; c < cEnd; ++c) {
4617       const PetscInt  newp = (c - cStart)*4;
4618       const PetscInt *cone, *ornt;
4619       PetscInt        coneNew[4], orntNew[4];
4620 
4621       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4622       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4623       /* A quad */
4624       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4625       orntNew[0] = ornt[0];
4626       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4627       orntNew[1] = 0;
4628       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4629       orntNew[2] = -2;
4630       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 0 : 1);
4631       orntNew[3] = ornt[3];
4632       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4633       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4634 #if 1
4635       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);
4636       for (p = 0; p < 4; ++p) {
4637         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);
4638       }
4639 #endif
4640       /* B quad */
4641       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4642       orntNew[0] = ornt[0];
4643       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4644       orntNew[1] = ornt[1];
4645       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4646       orntNew[2] = 0;
4647       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4648       orntNew[3] = -2;
4649       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4650       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4651 #if 1
4652       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);
4653       for (p = 0; p < 4; ++p) {
4654         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);
4655       }
4656 #endif
4657       /* C quad */
4658       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4659       orntNew[0] = -2;
4660       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4661       orntNew[1] = ornt[1];
4662       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4663       orntNew[2] = ornt[2];
4664       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4665       orntNew[3] = 0;
4666       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4667       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4668 #if 1
4669       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);
4670       for (p = 0; p < 4; ++p) {
4671         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);
4672       }
4673 #endif
4674       /* D quad */
4675       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4676       orntNew[0] = 0;
4677       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4678       orntNew[1] = -2;
4679       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4680       orntNew[2] = ornt[2];
4681       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 1 : 0);
4682       orntNew[3] = ornt[3];
4683       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4684       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4685 #if 1
4686       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);
4687       for (p = 0; p < 4; ++p) {
4688         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);
4689       }
4690 #endif
4691     }
4692     /* Split faces have 2 vertices and the same cells as the parent */
4693     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4694     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4695     for (f = fStart; f < fEnd; ++f) {
4696       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4697 
4698       for (r = 0; r < 2; ++r) {
4699         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4700         const PetscInt *cone, *support;
4701         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4702 
4703         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4704         coneNew[0]       = vStartNew + (cone[0] - vStart);
4705         coneNew[1]       = vStartNew + (cone[1] - vStart);
4706         coneNew[(r+1)%2] = newv;
4707         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4708 #if 1
4709         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4710         for (p = 0; p < 2; ++p) {
4711           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);
4712         }
4713 #endif
4714         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4715         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4716         for (s = 0; s < supportSize; ++s) {
4717           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4718           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4719           for (c = 0; c < coneSize; ++c) {
4720             if (cone[c] == f) break;
4721           }
4722           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%4;
4723         }
4724         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4725 #if 1
4726         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4727         for (p = 0; p < supportSize; ++p) {
4728           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);
4729         }
4730 #endif
4731       }
4732     }
4733     /* Interior faces have 2 vertices and 2 cells */
4734     for (c = cStart; c < cEnd; ++c) {
4735       const PetscInt *cone;
4736       PetscInt        coneNew[2], supportNew[2];
4737 
4738       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4739       for (r = 0; r < 4; ++r) {
4740         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4741 
4742         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r] - fStart);
4743         coneNew[1] = vStartNew + (vEnd - vStart) + (fEnd    - fStart) + (c - cStart);
4744         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4745 #if 1
4746         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4747         for (p = 0; p < 2; ++p) {
4748           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);
4749         }
4750 #endif
4751         supportNew[0] = (c - cStart)*4 + r;
4752         supportNew[1] = (c - cStart)*4 + (r+1)%4;
4753         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4754 #if 1
4755         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4756         for (p = 0; p < 2; ++p) {
4757           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);
4758         }
4759 #endif
4760       }
4761     }
4762     /* Old vertices have identical supports */
4763     for (v = vStart; v < vEnd; ++v) {
4764       const PetscInt  newp = vStartNew + (v - vStart);
4765       const PetscInt *support, *cone;
4766       PetscInt        size, s;
4767 
4768       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4769       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
4770       for (s = 0; s < size; ++s) {
4771         PetscInt r = 0;
4772 
4773         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4774         if (cone[1] == v) r = 1;
4775         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
4776       }
4777       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4778 #if 1
4779       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4780       for (p = 0; p < size; ++p) {
4781         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);
4782       }
4783 #endif
4784     }
4785     /* Face vertices have 2 + cells supports */
4786     for (f = fStart; f < fEnd; ++f) {
4787       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
4788       const PetscInt *cone, *support;
4789       PetscInt        size, s;
4790 
4791       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4792       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4793       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
4794       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
4795       for (s = 0; s < size; ++s) {
4796         PetscInt r = 0;
4797 
4798         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4799         if      (cone[1] == f) r = 1;
4800         else if (cone[2] == f) r = 2;
4801         else if (cone[3] == f) r = 3;
4802         supportRef[2+s] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*4 + r;
4803       }
4804       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4805 #if 1
4806       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4807       for (p = 0; p < 2+size; ++p) {
4808         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);
4809       }
4810 #endif
4811     }
4812     /* Cell vertices have 4 supports */
4813     for (c = cStart; c < cEnd; ++c) {
4814       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
4815       PetscInt       supportNew[4];
4816 
4817       for (r = 0; r < 4; ++r) {
4818         supportNew[r] = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4819       }
4820       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4821     }
4822     break;
4823   case 3:
4824     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4825     cMax = PetscMin(cEnd, cMax);
4826     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4827     fMax = PetscMin(fEnd, fMax);
4828     /* Interior cells have 3 faces */
4829     for (c = cStart; c < cMax; ++c) {
4830       const PetscInt  newp = cStartNew + (c - cStart)*4;
4831       const PetscInt *cone, *ornt;
4832       PetscInt        coneNew[3], orntNew[3];
4833 
4834       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4835       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4836       /* A triangle */
4837       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4838       orntNew[0] = ornt[0];
4839       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
4840       orntNew[1] = -2;
4841       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4842       orntNew[2] = ornt[2];
4843       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4844       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4845 #if 1
4846       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);
4847       for (p = 0; p < 3; ++p) {
4848         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);
4849       }
4850 #endif
4851       /* B triangle */
4852       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4853       orntNew[0] = ornt[0];
4854       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4855       orntNew[1] = ornt[1];
4856       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
4857       orntNew[2] = -2;
4858       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4859       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4860 #if 1
4861       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);
4862       for (p = 0; p < 3; ++p) {
4863         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);
4864       }
4865 #endif
4866       /* C triangle */
4867       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
4868       orntNew[0] = -2;
4869       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4870       orntNew[1] = ornt[1];
4871       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4872       orntNew[2] = ornt[2];
4873       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4874       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4875 #if 1
4876       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);
4877       for (p = 0; p < 3; ++p) {
4878         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);
4879       }
4880 #endif
4881       /* D triangle */
4882       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
4883       orntNew[0] = 0;
4884       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
4885       orntNew[1] = 0;
4886       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
4887       orntNew[2] = 0;
4888       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4889       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4890 #if 1
4891       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);
4892       for (p = 0; p < 3; ++p) {
4893         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);
4894       }
4895 #endif
4896     }
4897     /*
4898      2----3----3
4899      |         |
4900      |    B    |
4901      |         |
4902      0----4--- 1
4903      |         |
4904      |    A    |
4905      |         |
4906      0----2----1
4907      */
4908     /* Hybrid cells have 4 faces */
4909     for (c = cMax; c < cEnd; ++c) {
4910       const PetscInt  newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2;
4911       const PetscInt *cone, *ornt;
4912       PetscInt        coneNew[4], orntNew[4];
4913 
4914       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4915       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4916       /* A quad */
4917       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4918       orntNew[0] = ornt[0];
4919       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4920       orntNew[1] = ornt[1];
4921       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[2] - fMax);
4922       orntNew[2] = 0;
4923       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
4924       orntNew[3] = 0;
4925       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4926       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4927 #if 1
4928       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);
4929       for (p = 0; p < 4; ++p) {
4930         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);
4931       }
4932 #endif
4933       /* B quad */
4934       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4935       orntNew[0] = ornt[0];
4936       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4937       orntNew[1] = ornt[1];
4938       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
4939       orntNew[2] = 0;
4940       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[3] - fMax);
4941       orntNew[3] = 0;
4942       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4943       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4944 #if 1
4945       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);
4946       for (p = 0; p < 4; ++p) {
4947         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);
4948       }
4949 #endif
4950     }
4951     /* Interior split faces have 2 vertices and the same cells as the parent */
4952     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4953     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4954     for (f = fStart; f < fMax; ++f) {
4955       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4956 
4957       for (r = 0; r < 2; ++r) {
4958         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4959         const PetscInt *cone, *support;
4960         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4961 
4962         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4963         coneNew[0]       = vStartNew + (cone[0] - vStart);
4964         coneNew[1]       = vStartNew + (cone[1] - vStart);
4965         coneNew[(r+1)%2] = newv;
4966         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4967 #if 1
4968         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4969         for (p = 0; p < 2; ++p) {
4970           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);
4971         }
4972 #endif
4973         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4974         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4975         for (s = 0; s < supportSize; ++s) {
4976           if (support[s] >= cMax) {
4977             supportRef[s] = cStartNew + (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
4978           } else {
4979             ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4980             ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4981             for (c = 0; c < coneSize; ++c) {
4982               if (cone[c] == f) break;
4983             }
4984             supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
4985           }
4986         }
4987         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4988 #if 1
4989         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4990         for (p = 0; p < supportSize; ++p) {
4991           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);
4992         }
4993 #endif
4994       }
4995     }
4996     /* Interior cell faces have 2 vertices and 2 cells */
4997     for (c = cStart; c < cMax; ++c) {
4998       const PetscInt *cone;
4999 
5000       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5001       for (r = 0; r < 3; ++r) {
5002         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
5003         PetscInt       coneNew[2];
5004         PetscInt       supportNew[2];
5005 
5006         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
5007         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
5008         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5009 #if 1
5010         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5011         for (p = 0; p < 2; ++p) {
5012           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);
5013         }
5014 #endif
5015         supportNew[0] = (c - cStart)*4 + (r+1)%3;
5016         supportNew[1] = (c - cStart)*4 + 3;
5017         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5018 #if 1
5019         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5020         for (p = 0; p < 2; ++p) {
5021           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);
5022         }
5023 #endif
5024       }
5025     }
5026     /* Interior hybrid faces have 2 vertices and the same cells */
5027     for (f = fMax; f < fEnd; ++f) {
5028       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
5029       const PetscInt *cone;
5030       const PetscInt *support;
5031       PetscInt        coneNew[2];
5032       PetscInt        supportNew[2];
5033       PetscInt        size, s, r;
5034 
5035       ierr       = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5036       coneNew[0] = vStartNew + (cone[0] - vStart);
5037       coneNew[1] = vStartNew + (cone[1] - vStart);
5038       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5039 #if 1
5040       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5041       for (p = 0; p < 2; ++p) {
5042         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);
5043       }
5044 #endif
5045       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5046       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5047       for (s = 0; s < size; ++s) {
5048         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5049         for (r = 0; r < 2; ++r) {
5050           if (cone[r+2] == f) break;
5051         }
5052         supportNew[s] = (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
5053       }
5054       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5055 #if 1
5056       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5057       for (p = 0; p < size; ++p) {
5058         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);
5059       }
5060 #endif
5061     }
5062     /* Cell hybrid faces have 2 vertices and 2 cells */
5063     for (c = cMax; c < cEnd; ++c) {
5064       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
5065       const PetscInt *cone;
5066       PetscInt        coneNew[2];
5067       PetscInt        supportNew[2];
5068 
5069       ierr       = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5070       coneNew[0] = vStartNew + (vEnd - vStart) + (cone[0] - fStart);
5071       coneNew[1] = vStartNew + (vEnd - vStart) + (cone[1] - fStart);
5072       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5073 #if 1
5074       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5075       for (p = 0; p < 2; ++p) {
5076         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);
5077       }
5078 #endif
5079       supportNew[0] = (cMax - cStart)*4 + (c - cMax)*2 + 0;
5080       supportNew[1] = (cMax - cStart)*4 + (c - cMax)*2 + 1;
5081       ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5082 #if 1
5083       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5084       for (p = 0; p < 2; ++p) {
5085         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);
5086       }
5087 #endif
5088     }
5089     /* Old vertices have identical supports */
5090     for (v = vStart; v < vEnd; ++v) {
5091       const PetscInt  newp = vStartNew + (v - vStart);
5092       const PetscInt *support, *cone;
5093       PetscInt        size, s;
5094 
5095       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
5096       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
5097       for (s = 0; s < size; ++s) {
5098         if (support[s] >= fMax) {
5099           supportRef[s] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (support[s] - fMax);
5100         } else {
5101           PetscInt r = 0;
5102 
5103           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5104           if (cone[1] == v) r = 1;
5105           supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
5106         }
5107       }
5108       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5109 #if 1
5110       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5111       for (p = 0; p < size; ++p) {
5112         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);
5113       }
5114 #endif
5115     }
5116     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
5117     for (f = fStart; f < fMax; ++f) {
5118       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
5119       const PetscInt *cone, *support;
5120       PetscInt        size, newSize = 2, s;
5121 
5122       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5123       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5124       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
5125       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
5126       for (s = 0; s < size; ++s) {
5127         PetscInt r = 0;
5128 
5129         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5130         if (support[s] >= cMax) {
5131           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (support[s] - cMax);
5132 
5133           newSize += 1;
5134         } else {
5135           if      (cone[1] == f) r = 1;
5136           else if (cone[2] == f) r = 2;
5137           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
5138           supportRef[newSize+1] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + r;
5139 
5140           newSize += 2;
5141         }
5142       }
5143       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5144 #if 1
5145       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5146       for (p = 0; p < newSize; ++p) {
5147         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5148       }
5149 #endif
5150     }
5151     ierr = PetscFree(supportRef);CHKERRQ(ierr);
5152     break;
5153   default:
5154     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5155   }
5156   PetscFunctionReturn(0);
5157 }
5158 
5159 #undef __FUNCT__
5160 #define __FUNCT__ "CellRefinerSetCoordinates"
5161 PetscErrorCode CellRefinerSetCoordinates(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5162 {
5163   PetscSection   coordSection, coordSectionNew;
5164   Vec            coordinates, coordinatesNew;
5165   PetscScalar   *coords, *coordsNew;
5166   PetscInt       dim, depth, coordSizeNew, cStart, cEnd, c, vStart, vStartNew, vEnd, v, fStart, fEnd, fMax, f;
5167   PetscErrorCode ierr;
5168 
5169   PetscFunctionBegin;
5170   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5171   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5172   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5173   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5174   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5175   ierr = DMPlexGetHybridBounds(dm, NULL, &fMax, NULL, NULL);CHKERRQ(ierr);
5176   ierr = GetDepthStart_Private(depth, depthSize, NULL, NULL, NULL, &vStartNew);CHKERRQ(ierr);
5177   ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
5178   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &coordSectionNew);CHKERRQ(ierr);
5179   ierr = PetscSectionSetNumFields(coordSectionNew, 1);CHKERRQ(ierr);
5180   ierr = PetscSectionSetFieldComponents(coordSectionNew, 0, dim);CHKERRQ(ierr);
5181   ierr = PetscSectionSetChart(coordSectionNew, vStartNew, vStartNew+depthSize[0]);CHKERRQ(ierr);
5182   if (fMax < 0) fMax = fEnd;
5183   switch (refiner) {
5184   case 1:
5185   case 2:
5186   case 3:
5187     /* Simplicial and Hex 2D */
5188     /* All vertices have the dim coordinates */
5189     for (v = vStartNew; v < vStartNew+depthSize[0]; ++v) {
5190       ierr = PetscSectionSetDof(coordSectionNew, v, dim);CHKERRQ(ierr);
5191       ierr = PetscSectionSetFieldDof(coordSectionNew, v, 0, dim);CHKERRQ(ierr);
5192     }
5193     ierr = PetscSectionSetUp(coordSectionNew);CHKERRQ(ierr);
5194     ierr = DMPlexSetCoordinateSection(rdm, coordSectionNew);CHKERRQ(ierr);
5195     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
5196     ierr = PetscSectionGetStorageSize(coordSectionNew, &coordSizeNew);CHKERRQ(ierr);
5197     ierr = VecCreate(PetscObjectComm((PetscObject)dm), &coordinatesNew);CHKERRQ(ierr);
5198     ierr = PetscObjectSetName((PetscObject) coordinatesNew, "coordinates");CHKERRQ(ierr);
5199     ierr = VecSetSizes(coordinatesNew, coordSizeNew, PETSC_DETERMINE);CHKERRQ(ierr);
5200     ierr = VecSetFromOptions(coordinatesNew);CHKERRQ(ierr);
5201     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
5202     ierr = VecGetArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5203     /* Old vertices have the same coordinates */
5204     for (v = vStart; v < vEnd; ++v) {
5205       const PetscInt newv = vStartNew + (v - vStart);
5206       PetscInt       off, offnew, d;
5207 
5208       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
5209       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5210       for (d = 0; d < dim; ++d) {
5211         coordsNew[offnew+d] = coords[off+d];
5212       }
5213     }
5214     /* Face vertices have the average of endpoint coordinates */
5215     for (f = fStart; f < fMax; ++f) {
5216       const PetscInt  newv = vStartNew + (vEnd - vStart) + (f - fStart);
5217       const PetscInt *cone;
5218       PetscInt        coneSize, offA, offB, offnew, d;
5219 
5220       ierr = DMPlexGetConeSize(dm, f, &coneSize);CHKERRQ(ierr);
5221       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Face %d cone should have two vertices, not %d", f, coneSize);
5222       ierr = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5223       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5224       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5225       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5226       for (d = 0; d < dim; ++d) {
5227         coordsNew[offnew+d] = 0.5*(coords[offA+d] + coords[offB+d]);
5228       }
5229     }
5230     /* Just Hex 2D */
5231     if (refiner == 2) {
5232       /* Cell vertices have the average of corner coordinates */
5233       for (c = cStart; c < cEnd; ++c) {
5234         const PetscInt newv = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
5235         PetscInt      *cone = NULL;
5236         PetscInt       closureSize, coneSize = 0, offA, offB, offC, offD, offnew, p, d;
5237 
5238         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5239         for (p = 0; p < closureSize*2; p += 2) {
5240           const PetscInt point = cone[p];
5241           if ((point >= vStart) && (point < vEnd)) cone[coneSize++] = point;
5242         }
5243         if (coneSize != 4) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Quad %d cone should have four vertices, not %d", c, coneSize);
5244         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5245         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5246         ierr = PetscSectionGetOffset(coordSection, cone[2], &offC);CHKERRQ(ierr);
5247         ierr = PetscSectionGetOffset(coordSection, cone[3], &offD);CHKERRQ(ierr);
5248         ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5249         for (d = 0; d < dim; ++d) {
5250           coordsNew[offnew+d] = 0.25*(coords[offA+d] + coords[offB+d] + coords[offC+d] + coords[offD+d]);
5251         }
5252         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5253       }
5254     }
5255     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
5256     ierr = VecRestoreArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5257     ierr = DMSetCoordinatesLocal(rdm, coordinatesNew);CHKERRQ(ierr);
5258     ierr = VecDestroy(&coordinatesNew);CHKERRQ(ierr);
5259     ierr = PetscSectionDestroy(&coordSectionNew);CHKERRQ(ierr);
5260     break;
5261   default:
5262     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5263   }
5264   PetscFunctionReturn(0);
5265 }
5266 
5267 #undef __FUNCT__
5268 #define __FUNCT__ "DMPlexCreateProcessSF"
5269 PetscErrorCode DMPlexCreateProcessSF(DM dm, PetscSF sfPoint, IS *processRanks, PetscSF *sfProcess)
5270 {
5271   PetscInt           numRoots, numLeaves, l;
5272   const PetscInt    *localPoints;
5273   const PetscSFNode *remotePoints;
5274   PetscInt          *localPointsNew;
5275   PetscSFNode       *remotePointsNew;
5276   PetscInt          *ranks, *ranksNew;
5277   PetscErrorCode     ierr;
5278 
5279   PetscFunctionBegin;
5280   ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5281   ierr = PetscMalloc(numLeaves * sizeof(PetscInt), &ranks);CHKERRQ(ierr);
5282   for (l = 0; l < numLeaves; ++l) {
5283     ranks[l] = remotePoints[l].rank;
5284   }
5285   ierr = PetscSortRemoveDupsInt(&numLeaves, ranks);CHKERRQ(ierr);
5286   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &ranksNew);CHKERRQ(ierr);
5287   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5288   ierr = PetscMalloc(numLeaves * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5289   for (l = 0; l < numLeaves; ++l) {
5290     ranksNew[l]              = ranks[l];
5291     localPointsNew[l]        = l;
5292     remotePointsNew[l].index = 0;
5293     remotePointsNew[l].rank  = ranksNew[l];
5294   }
5295   ierr = PetscFree(ranks);CHKERRQ(ierr);
5296   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), numLeaves, ranksNew, PETSC_OWN_POINTER, processRanks);CHKERRQ(ierr);
5297   ierr = PetscSFCreate(PetscObjectComm((PetscObject)dm), sfProcess);CHKERRQ(ierr);
5298   ierr = PetscSFSetFromOptions(*sfProcess);CHKERRQ(ierr);
5299   ierr = PetscSFSetGraph(*sfProcess, 1, numLeaves, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5300   PetscFunctionReturn(0);
5301 }
5302 
5303 #undef __FUNCT__
5304 #define __FUNCT__ "CellRefinerCreateSF"
5305 PetscErrorCode CellRefinerCreateSF(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5306 {
5307   PetscSF            sf, sfNew, sfProcess;
5308   IS                 processRanks;
5309   MPI_Datatype       depthType;
5310   PetscInt           numRoots, numLeaves, numLeavesNew = 0, l, m;
5311   const PetscInt    *localPoints, *neighbors;
5312   const PetscSFNode *remotePoints;
5313   PetscInt          *localPointsNew;
5314   PetscSFNode       *remotePointsNew;
5315   PetscInt          *depthSizeOld, *rdepthSize, *rdepthSizeOld, *rdepthMaxOld, *rvStart, *rvStartNew, *reStart, *reStartNew, *rfStart, *rfStartNew, *rcStart, *rcStartNew;
5316   PetscInt           depth, numNeighbors, pStartNew, pEndNew, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eStartNew, eEnd, eMax, r, n;
5317   PetscErrorCode     ierr;
5318 
5319   PetscFunctionBegin;
5320   ierr = DMPlexGetChart(rdm, &pStartNew, &pEndNew);CHKERRQ(ierr);
5321   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5322   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5323   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5324   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5325   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5326   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5327   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
5328   switch (refiner) {
5329   case 3:
5330     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5331     cMax = PetscMin(cEnd, cMax);
5332     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5333     fMax = PetscMin(fEnd, fMax);
5334   }
5335   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
5336   ierr = DMGetPointSF(rdm, &sfNew);CHKERRQ(ierr);
5337   /* Caculate size of new SF */
5338   ierr = PetscSFGetGraph(sf, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5339   if (numRoots < 0) PetscFunctionReturn(0);
5340   for (l = 0; l < numLeaves; ++l) {
5341     const PetscInt p = localPoints[l];
5342 
5343     switch (refiner) {
5344     case 1:
5345       /* Simplicial 2D */
5346       if ((p >= vStart) && (p < vEnd)) {
5347         /* Old vertices stay the same */
5348         ++numLeavesNew;
5349       } else if ((p >= fStart) && (p < fEnd)) {
5350         /* Old faces add new faces and vertex */
5351         numLeavesNew += 1 + 2;
5352       } else if ((p >= cStart) && (p < cEnd)) {
5353         /* Old cells add new cells and interior faces */
5354         numLeavesNew += 4 + 3;
5355       }
5356       break;
5357     case 2:
5358       /* Hex 2D */
5359       if ((p >= vStart) && (p < vEnd)) {
5360         /* Old vertices stay the same */
5361         ++numLeavesNew;
5362       } else if ((p >= fStart) && (p < fEnd)) {
5363         /* Old faces add new faces and vertex */
5364         numLeavesNew += 1 + 2;
5365       } else if ((p >= cStart) && (p < cEnd)) {
5366         /* Old cells add new cells and interior faces */
5367         numLeavesNew += 4 + 4;
5368       }
5369       break;
5370     default:
5371       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5372     }
5373   }
5374   /* Communicate depthSizes for each remote rank */
5375   ierr = DMPlexCreateProcessSF(dm, sf, &processRanks, &sfProcess);CHKERRQ(ierr);
5376   ierr = ISGetLocalSize(processRanks, &numNeighbors);CHKERRQ(ierr);
5377   ierr = PetscMalloc5((depth+1)*numNeighbors,PetscInt,&rdepthSize,numNeighbors,PetscInt,&rvStartNew,numNeighbors,PetscInt,&reStartNew,numNeighbors,PetscInt,&rfStartNew,numNeighbors,PetscInt,&rcStartNew);CHKERRQ(ierr);
5378   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);
5379   ierr = MPI_Type_contiguous(depth+1, MPIU_INT, &depthType);CHKERRQ(ierr);
5380   ierr = MPI_Type_commit(&depthType);CHKERRQ(ierr);
5381   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5382   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5383   for (n = 0; n < numNeighbors; ++n) {
5384     ierr = GetDepthStart_Private(depth, &rdepthSize[n*(depth+1)], &rcStartNew[n], &rfStartNew[n], &reStartNew[n], &rvStartNew[n]);CHKERRQ(ierr);
5385   }
5386   depthSizeOld[depth]   = cMax;
5387   depthSizeOld[0]       = vMax;
5388   depthSizeOld[depth-1] = fMax;
5389   depthSizeOld[1]       = eMax;
5390 
5391   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5392   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5393 
5394   depthSizeOld[depth]   = cEnd - cStart;
5395   depthSizeOld[0]       = vEnd - vStart;
5396   depthSizeOld[depth-1] = fEnd - fStart;
5397   depthSizeOld[1]       = eEnd - eStart;
5398 
5399   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5400   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5401   for (n = 0; n < numNeighbors; ++n) {
5402     ierr = GetDepthStart_Private(depth, &rdepthSizeOld[n*(depth+1)], &rcStart[n], &rfStart[n], &reStart[n], &rvStart[n]);CHKERRQ(ierr);
5403   }
5404   ierr = MPI_Type_free(&depthType);CHKERRQ(ierr);
5405   ierr = PetscSFDestroy(&sfProcess);CHKERRQ(ierr);
5406   /* Calculate new point SF */
5407   ierr = PetscMalloc(numLeavesNew * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5408   ierr = PetscMalloc(numLeavesNew * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5409   ierr = ISGetIndices(processRanks, &neighbors);CHKERRQ(ierr);
5410   for (l = 0, m = 0; l < numLeaves; ++l) {
5411     PetscInt    p     = localPoints[l];
5412     PetscInt    rp    = remotePoints[l].index, n;
5413     PetscMPIInt rrank = remotePoints[l].rank;
5414 
5415     ierr = PetscFindInt(rrank, numNeighbors, neighbors, &n);CHKERRQ(ierr);
5416     if (n < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Could not locate remote rank %d", rrank);
5417     switch (refiner) {
5418     case 1:
5419       /* Simplicial 2D */
5420       if ((p >= vStart) && (p < vEnd)) {
5421         /* Old vertices stay the same */
5422         localPointsNew[m]        = vStartNew     + (p  - vStart);
5423         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5424         remotePointsNew[m].rank  = rrank;
5425         ++m;
5426       } else if ((p >= fStart) && (p < fEnd)) {
5427         /* Old faces add new faces and vertex */
5428         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5429         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5430         remotePointsNew[m].rank  = rrank;
5431         ++m;
5432         for (r = 0; r < 2; ++r, ++m) {
5433           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5434           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5435           remotePointsNew[m].rank  = rrank;
5436         }
5437       } else if ((p >= cStart) && (p < cEnd)) {
5438         /* Old cells add new cells and interior faces */
5439         for (r = 0; r < 4; ++r, ++m) {
5440           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5441           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5442           remotePointsNew[m].rank  = rrank;
5443         }
5444         for (r = 0; r < 3; ++r, ++m) {
5445           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*3     + r;
5446           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*3 + r;
5447           remotePointsNew[m].rank  = rrank;
5448         }
5449       }
5450       break;
5451     case 2:
5452       /* Hex 2D */
5453       if ((p >= vStart) && (p < vEnd)) {
5454         /* Old vertices stay the same */
5455         localPointsNew[m]        = vStartNew     + (p  - vStart);
5456         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5457         remotePointsNew[m].rank  = rrank;
5458         ++m;
5459       } else if ((p >= fStart) && (p < fEnd)) {
5460         /* Old faces add new faces and vertex */
5461         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5462         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5463         remotePointsNew[m].rank  = rrank;
5464         ++m;
5465         for (r = 0; r < 2; ++r, ++m) {
5466           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5467           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5468           remotePointsNew[m].rank  = rrank;
5469         }
5470       } else if ((p >= cStart) && (p < cEnd)) {
5471         /* Old cells add new cells and interior faces */
5472         for (r = 0; r < 4; ++r, ++m) {
5473           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5474           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5475           remotePointsNew[m].rank  = rrank;
5476         }
5477         for (r = 0; r < 4; ++r, ++m) {
5478           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*4     + r;
5479           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*4 + r;
5480           remotePointsNew[m].rank  = rrank;
5481         }
5482       }
5483       break;
5484     case 3:
5485       /* Hybrid simplicial 2D */
5486       if ((p >= vStart) && (p < vEnd)) {
5487         /* Old vertices stay the same */
5488         localPointsNew[m]        = vStartNew     + (p  - vStart);
5489         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5490         remotePointsNew[m].rank  = rrank;
5491         ++m;
5492       } else if ((p >= fStart) && (p < fMax)) {
5493         /* Old interior faces add new faces and vertex */
5494         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5495         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5496         remotePointsNew[m].rank  = rrank;
5497         ++m;
5498         for (r = 0; r < 2; ++r, ++m) {
5499           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5500           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5501           remotePointsNew[m].rank  = rrank;
5502         }
5503       } else if ((p >= fMax) && (p < fEnd)) {
5504         /* Old hybrid faces stay the same */
5505         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - fMax);
5506         remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rdepthMaxOld[n*(depth+1)+depth-1]);
5507         remotePointsNew[m].rank  = rrank;
5508         ++m;
5509       } else if ((p >= cStart) && (p < cMax)) {
5510         /* Old interior cells add new cells and interior faces */
5511         for (r = 0; r < 4; ++r, ++m) {
5512           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5513           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5514           remotePointsNew[m].rank  = rrank;
5515         }
5516         for (r = 0; r < 3; ++r, ++m) {
5517           localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - cStart)*3     + r;
5518           remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rcStart[n])*3 + r;
5519           remotePointsNew[m].rank  = rrank;
5520         }
5521       } else if ((p >= cStart) && (p < cMax)) {
5522         /* Old hybrid cells add new cells and hybrid face */
5523         for (r = 0; r < 2; ++r, ++m) {
5524           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5525           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5526           remotePointsNew[m].rank  = rrank;
5527         }
5528         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (cMax                            - cStart)*3     + (p  - cMax);
5529         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]);
5530         remotePointsNew[m].rank  = rrank;
5531         ++m;
5532       }
5533       break;
5534     default:
5535       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5536     }
5537   }
5538   ierr = ISRestoreIndices(processRanks, &neighbors);CHKERRQ(ierr);
5539   ierr = ISDestroy(&processRanks);CHKERRQ(ierr);
5540   ierr = PetscSFSetGraph(sfNew, pEndNew-pStartNew, numLeavesNew, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5541   ierr = PetscFree5(rdepthSize,rvStartNew,reStartNew,rfStartNew,rcStartNew);CHKERRQ(ierr);
5542   ierr = PetscFree6(depthSizeOld,rdepthSizeOld,rvStart,reStart,rfStart,rcStart);CHKERRQ(ierr);
5543   PetscFunctionReturn(0);
5544 }
5545 
5546 #undef __FUNCT__
5547 #define __FUNCT__ "CellRefinerCreateLabels"
5548 PetscErrorCode CellRefinerCreateLabels(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5549 {
5550   PetscInt       numLabels, l;
5551   PetscInt       newp, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eEnd, eMax, r;
5552   PetscErrorCode ierr;
5553 
5554   PetscFunctionBegin;
5555   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5556   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5557   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5558   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5559 
5560   cStartNew = 0;
5561   vStartNew = depthSize[2];
5562   fStartNew = depthSize[2] + depthSize[0];
5563 
5564   ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
5565   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5566   switch (refiner) {
5567   case 3:
5568     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5569     cMax = PetscMin(cEnd, cMax);
5570     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5571     fMax = PetscMin(fEnd, fMax);
5572   }
5573   for (l = 0; l < numLabels; ++l) {
5574     DMLabel         label, labelNew;
5575     const char     *lname;
5576     PetscBool       isDepth;
5577     IS              valueIS;
5578     const PetscInt *values;
5579     PetscInt        numValues, val;
5580 
5581     ierr = DMPlexGetLabelName(dm, l, &lname);CHKERRQ(ierr);
5582     ierr = PetscStrcmp(lname, "depth", &isDepth);CHKERRQ(ierr);
5583     if (isDepth) continue;
5584     ierr = DMPlexCreateLabel(rdm, lname);CHKERRQ(ierr);
5585     ierr = DMPlexGetLabel(dm, lname, &label);CHKERRQ(ierr);
5586     ierr = DMPlexGetLabel(rdm, lname, &labelNew);CHKERRQ(ierr);
5587     ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
5588     ierr = ISGetLocalSize(valueIS, &numValues);CHKERRQ(ierr);
5589     ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
5590     for (val = 0; val < numValues; ++val) {
5591       IS              pointIS;
5592       const PetscInt *points;
5593       PetscInt        numPoints, n;
5594 
5595       ierr = DMLabelGetStratumIS(label, values[val], &pointIS);CHKERRQ(ierr);
5596       ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
5597       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
5598       for (n = 0; n < numPoints; ++n) {
5599         const PetscInt p = points[n];
5600         switch (refiner) {
5601         case 1:
5602           /* Simplicial 2D */
5603           if ((p >= vStart) && (p < vEnd)) {
5604             /* Old vertices stay the same */
5605             newp = vStartNew + (p - vStart);
5606             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5607           } else if ((p >= fStart) && (p < fEnd)) {
5608             /* Old faces add new faces and vertex */
5609             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5610             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5611             for (r = 0; r < 2; ++r) {
5612               newp = fStartNew + (p - fStart)*2 + r;
5613               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5614             }
5615           } else if ((p >= cStart) && (p < cEnd)) {
5616             /* Old cells add new cells and interior faces */
5617             for (r = 0; r < 4; ++r) {
5618               newp = cStartNew + (p - cStart)*4 + r;
5619               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5620             }
5621             for (r = 0; r < 3; ++r) {
5622               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
5623               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5624             }
5625           }
5626           break;
5627         case 2:
5628           /* Hex 2D */
5629           if ((p >= vStart) && (p < vEnd)) {
5630             /* Old vertices stay the same */
5631             newp = vStartNew + (p - vStart);
5632             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5633           } else if ((p >= fStart) && (p < fEnd)) {
5634             /* Old faces add new faces and vertex */
5635             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5636             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5637             for (r = 0; r < 2; ++r) {
5638               newp = fStartNew + (p - fStart)*2 + r;
5639               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5640             }
5641           } else if ((p >= cStart) && (p < cEnd)) {
5642             /* Old cells add new cells and interior faces and vertex */
5643             for (r = 0; r < 4; ++r) {
5644               newp = cStartNew + (p - cStart)*4 + r;
5645               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5646             }
5647             for (r = 0; r < 4; ++r) {
5648               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*4 + r;
5649               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5650             }
5651             newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (p - cStart);
5652             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5653           }
5654           break;
5655         case 3:
5656           /* Hybrid simplicial 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 < fMax)) {
5662             /* Old interior 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 >= fMax) && (p < fEnd)) {
5670             /* Old hybrid faces stay the same */
5671             newp = fStartNew + (fMax - fStart)*2 + (p - fMax);
5672             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5673           } else if ((p >= cStart) && (p < cMax)) {
5674             /* Old interior cells add new cells and interior faces */
5675             for (r = 0; r < 4; ++r) {
5676               newp = cStartNew + (p - cStart)*4 + r;
5677               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5678             }
5679             for (r = 0; r < 3; ++r) {
5680               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
5681               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5682             }
5683           } else if ((p >= cMax) && (p < cEnd)) {
5684             /* Old hybrid cells add new cells and hybrid face */
5685             for (r = 0; r < 2; ++r) {
5686               newp = cStartNew + (cMax - cStart)*4 + (p - cMax)*2 + r;
5687               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5688             }
5689             newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (p - cMax);
5690             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5691           }
5692           break;
5693         default:
5694           SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5695         }
5696       }
5697       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
5698       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
5699     }
5700     ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
5701     ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
5702     if (0) {
5703       ierr = PetscViewerASCIISynchronizedAllow(PETSC_VIEWER_STDOUT_WORLD, PETSC_TRUE);CHKERRQ(ierr);
5704       ierr = DMLabelView(labelNew, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
5705       ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
5706     }
5707   }
5708   PetscFunctionReturn(0);
5709 }
5710 
5711 #undef __FUNCT__
5712 #define __FUNCT__ "DMPlexRefine_Uniform"
5713 /* This will only work for interpolated meshes */
5714 PetscErrorCode DMPlexRefine_Uniform(DM dm, CellRefiner cellRefiner, DM *dmRefined)
5715 {
5716   DM             rdm;
5717   PetscInt      *depthSize;
5718   PetscInt       dim, depth = 0, d, pStart = 0, pEnd = 0;
5719   PetscErrorCode ierr;
5720 
5721   PetscFunctionBegin;
5722   ierr = DMCreate(PetscObjectComm((PetscObject)dm), &rdm);CHKERRQ(ierr);
5723   ierr = DMSetType(rdm, DMPLEX);CHKERRQ(ierr);
5724   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5725   ierr = DMPlexSetDimension(rdm, dim);CHKERRQ(ierr);
5726   /* Calculate number of new points of each depth */
5727   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5728   ierr = PetscMalloc((depth+1) * sizeof(PetscInt), &depthSize);CHKERRQ(ierr);
5729   ierr = PetscMemzero(depthSize, (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
5730   ierr = CellRefinerGetSizes(cellRefiner, dm, depthSize);CHKERRQ(ierr);
5731   /* Step 1: Set chart */
5732   for (d = 0; d <= depth; ++d) pEnd += depthSize[d];
5733   ierr = DMPlexSetChart(rdm, pStart, pEnd);CHKERRQ(ierr);
5734   /* Step 2: Set cone/support sizes */
5735   ierr = CellRefinerSetConeSizes(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5736   /* Step 3: Setup refined DM */
5737   ierr = DMSetUp(rdm);CHKERRQ(ierr);
5738   /* Step 4: Set cones and supports */
5739   ierr = CellRefinerSetCones(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5740   /* Step 5: Stratify */
5741   ierr = DMPlexStratify(rdm);CHKERRQ(ierr);
5742   /* Step 6: Set coordinates for vertices */
5743   ierr = CellRefinerSetCoordinates(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5744   /* Step 7: Create pointSF */
5745   ierr = CellRefinerCreateSF(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5746   /* Step 8: Create labels */
5747   ierr = CellRefinerCreateLabels(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
5748   ierr = PetscFree(depthSize);CHKERRQ(ierr);
5749 
5750   *dmRefined = rdm;
5751   PetscFunctionReturn(0);
5752 }
5753 
5754 #undef __FUNCT__
5755 #define __FUNCT__ "DMPlexSetRefinementUniform"
5756 PetscErrorCode DMPlexSetRefinementUniform(DM dm, PetscBool refinementUniform)
5757 {
5758   DM_Plex *mesh = (DM_Plex*) dm->data;
5759 
5760   PetscFunctionBegin;
5761   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5762   mesh->refinementUniform = refinementUniform;
5763   PetscFunctionReturn(0);
5764 }
5765 
5766 #undef __FUNCT__
5767 #define __FUNCT__ "DMPlexGetRefinementUniform"
5768 PetscErrorCode DMPlexGetRefinementUniform(DM dm, PetscBool *refinementUniform)
5769 {
5770   DM_Plex *mesh = (DM_Plex*) dm->data;
5771 
5772   PetscFunctionBegin;
5773   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5774   PetscValidPointer(refinementUniform,  2);
5775   *refinementUniform = mesh->refinementUniform;
5776   PetscFunctionReturn(0);
5777 }
5778 
5779 #undef __FUNCT__
5780 #define __FUNCT__ "DMPlexSetRefinementLimit"
5781 PetscErrorCode DMPlexSetRefinementLimit(DM dm, PetscReal refinementLimit)
5782 {
5783   DM_Plex *mesh = (DM_Plex*) dm->data;
5784 
5785   PetscFunctionBegin;
5786   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5787   mesh->refinementLimit = refinementLimit;
5788   PetscFunctionReturn(0);
5789 }
5790 
5791 #undef __FUNCT__
5792 #define __FUNCT__ "DMPlexGetRefinementLimit"
5793 PetscErrorCode DMPlexGetRefinementLimit(DM dm, PetscReal *refinementLimit)
5794 {
5795   DM_Plex *mesh = (DM_Plex*) dm->data;
5796 
5797   PetscFunctionBegin;
5798   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5799   PetscValidPointer(refinementLimit,  2);
5800   /* if (mesh->refinementLimit < 0) = getMaxVolume()/2.0; */
5801   *refinementLimit = mesh->refinementLimit;
5802   PetscFunctionReturn(0);
5803 }
5804 
5805 #undef __FUNCT__
5806 #define __FUNCT__ "DMPlexGetCellRefiner_Private"
5807 PetscErrorCode DMPlexGetCellRefiner_Private(DM dm, CellRefiner *cellRefiner)
5808 {
5809   PetscInt       dim, cStart, coneSize, cMax;
5810   PetscErrorCode ierr;
5811 
5812   PetscFunctionBegin;
5813   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5814   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
5815   ierr = DMPlexGetConeSize(dm, cStart, &coneSize);CHKERRQ(ierr);
5816   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5817   switch (dim) {
5818   case 2:
5819     switch (coneSize) {
5820     case 3:
5821       if (cMax >= 0) *cellRefiner = 3; /* Hybrid */
5822       else *cellRefiner = 1; /* Triangular */
5823       break;
5824     case 4:
5825       if (cMax >= 0) *cellRefiner = 4; /* Hybrid */
5826       else *cellRefiner = 2; /* Quadrilateral */
5827       break;
5828     default:
5829       SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown coneSize %d in dimension %d for cell refiner", coneSize, dim);
5830     }
5831     break;
5832   default:
5833     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown dimension %d for cell refiner", dim);
5834   }
5835   PetscFunctionReturn(0);
5836 }
5837 
5838 #undef __FUNCT__
5839 #define __FUNCT__ "DMRefine_Plex"
5840 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
5841 {
5842   PetscReal      refinementLimit;
5843   PetscInt       dim, cStart, cEnd;
5844   char           genname[1024], *name = NULL;
5845   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
5846   PetscErrorCode ierr;
5847 
5848   PetscFunctionBegin;
5849   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
5850   if (isUniform) {
5851     CellRefiner cellRefiner;
5852 
5853     ierr = DMPlexGetCellRefiner_Private(dm, &cellRefiner);CHKERRQ(ierr);
5854     ierr = DMPlexRefine_Uniform(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
5855     PetscFunctionReturn(0);
5856   }
5857   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
5858   if (refinementLimit == 0.0) PetscFunctionReturn(0);
5859   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5860   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5861   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
5862   if (flg) name = genname;
5863   if (name) {
5864     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
5865     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
5866     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
5867   }
5868   switch (dim) {
5869   case 2:
5870     if (!name || isTriangle) {
5871 #if defined(PETSC_HAVE_TRIANGLE)
5872       double  *maxVolumes;
5873       PetscInt c;
5874 
5875       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
5876       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5877       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5878       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
5879 #else
5880       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
5881 #endif
5882     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
5883     break;
5884   case 3:
5885     if (!name || isCTetgen) {
5886 #if defined(PETSC_HAVE_CTETGEN)
5887       PetscReal *maxVolumes;
5888       PetscInt   c;
5889 
5890       ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscReal), &maxVolumes);CHKERRQ(ierr);
5891       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5892       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5893 #else
5894       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
5895 #endif
5896     } else if (isTetgen) {
5897 #if defined(PETSC_HAVE_TETGEN)
5898       double  *maxVolumes;
5899       PetscInt c;
5900 
5901       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
5902       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
5903       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
5904 #else
5905       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
5906 #endif
5907     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
5908     break;
5909   default:
5910     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
5911   }
5912   PetscFunctionReturn(0);
5913 }
5914 
5915 #undef __FUNCT__
5916 #define __FUNCT__ "DMPlexGetDepthLabel"
5917 /*@
5918   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
5919 
5920   Not Collective
5921 
5922   Input Parameter:
5923 . dm    - The DMPlex object
5924 
5925   Output Parameter:
5926 . depthLabel - The DMLabel recording point depth
5927 
5928   Level: developer
5929 
5930 .keywords: mesh, points
5931 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
5932 @*/
5933 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
5934 {
5935   DM_Plex       *mesh = (DM_Plex*) dm->data;
5936   PetscErrorCode ierr;
5937 
5938   PetscFunctionBegin;
5939   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5940   PetscValidPointer(depthLabel, 2);
5941   if (!mesh->depthLabel) {
5942     ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);
5943   }
5944   *depthLabel = mesh->depthLabel;
5945   PetscFunctionReturn(0);
5946 }
5947 
5948 #undef __FUNCT__
5949 #define __FUNCT__ "DMPlexGetDepth"
5950 /*@
5951   DMPlexGetDepth - Get the depth of the DAG representing this mesh
5952 
5953   Not Collective
5954 
5955   Input Parameter:
5956 . dm    - The DMPlex object
5957 
5958   Output Parameter:
5959 . depth - The number of strata (breadth first levels) in the DAG
5960 
5961   Level: developer
5962 
5963 .keywords: mesh, points
5964 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
5965 @*/
5966 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
5967 {
5968   DMLabel        label;
5969   PetscInt       d = 0;
5970   PetscErrorCode ierr;
5971 
5972   PetscFunctionBegin;
5973   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5974   PetscValidPointer(depth, 2);
5975   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
5976   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
5977   *depth = d-1;
5978   PetscFunctionReturn(0);
5979 }
5980 
5981 #undef __FUNCT__
5982 #define __FUNCT__ "DMPlexGetDepthStratum"
5983 /*@
5984   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
5985 
5986   Not Collective
5987 
5988   Input Parameters:
5989 + dm           - The DMPlex object
5990 - stratumValue - The requested depth
5991 
5992   Output Parameters:
5993 + start - The first point at this depth
5994 - end   - One beyond the last point at this depth
5995 
5996   Level: developer
5997 
5998 .keywords: mesh, points
5999 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
6000 @*/
6001 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6002 {
6003   DMLabel        label;
6004   PetscInt       depth;
6005   PetscErrorCode ierr;
6006 
6007   PetscFunctionBegin;
6008   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6009   if (stratumValue < 0) {
6010     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6011     PetscFunctionReturn(0);
6012   } else {
6013     PetscInt pStart, pEnd;
6014 
6015     if (start) *start = 0;
6016     if (end)   *end   = 0;
6017     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6018     if (pStart == pEnd) PetscFunctionReturn(0);
6019   }
6020   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
6021   if (!label) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6022   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6023   depth = stratumValue;
6024   if ((depth < 0) || (depth >= label->numStrata)) {
6025     if (start) *start = 0;
6026     if (end)   *end   = 0;
6027   } else {
6028     if (start) *start = label->points[label->stratumOffsets[depth]];
6029     if (end)   *end   = label->points[label->stratumOffsets[depth]+label->stratumSizes[depth]-1]+1;
6030   }
6031   PetscFunctionReturn(0);
6032 }
6033 
6034 #undef __FUNCT__
6035 #define __FUNCT__ "DMPlexGetHeightStratum"
6036 /*@
6037   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
6038 
6039   Not Collective
6040 
6041   Input Parameters:
6042 + dm           - The DMPlex object
6043 - stratumValue - The requested height
6044 
6045   Output Parameters:
6046 + start - The first point at this height
6047 - end   - One beyond the last point at this height
6048 
6049   Level: developer
6050 
6051 .keywords: mesh, points
6052 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
6053 @*/
6054 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6055 {
6056   DMLabel        label;
6057   PetscInt       depth;
6058   PetscErrorCode ierr;
6059 
6060   PetscFunctionBegin;
6061   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6062   if (stratumValue < 0) {
6063     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6064   } else {
6065     PetscInt pStart, pEnd;
6066 
6067     if (start) *start = 0;
6068     if (end)   *end   = 0;
6069     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6070     if (pStart == pEnd) PetscFunctionReturn(0);
6071   }
6072   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
6073   if (!label) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6074   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6075   depth = label->stratumValues[label->numStrata-1] - stratumValue;
6076   if ((depth < 0) || (depth >= label->numStrata)) {
6077     if (start) *start = 0;
6078     if (end)   *end   = 0;
6079   } else {
6080     if (start) *start = label->points[label->stratumOffsets[depth]];
6081     if (end)   *end   = label->points[label->stratumOffsets[depth]+label->stratumSizes[depth]-1]+1;
6082   }
6083   PetscFunctionReturn(0);
6084 }
6085 
6086 #undef __FUNCT__
6087 #define __FUNCT__ "DMPlexCreateSectionInitial"
6088 /* Set the number of dof on each point and separate by fields */
6089 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
6090 {
6091   PetscInt      *numDofTot;
6092   PetscInt       pStart = 0, pEnd = 0;
6093   PetscInt       p, d, f;
6094   PetscErrorCode ierr;
6095 
6096   PetscFunctionBegin;
6097   ierr = PetscMalloc((dim+1) * sizeof(PetscInt), &numDofTot);CHKERRQ(ierr);
6098   for (d = 0; d <= dim; ++d) {
6099     numDofTot[d] = 0;
6100     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
6101   }
6102   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
6103   if (numFields > 0) {
6104     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
6105     if (numComp) {
6106       for (f = 0; f < numFields; ++f) {
6107         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
6108       }
6109     }
6110   }
6111   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6112   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
6113   for (d = 0; d <= dim; ++d) {
6114     ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
6115     for (p = pStart; p < pEnd; ++p) {
6116       for (f = 0; f < numFields; ++f) {
6117         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
6118       }
6119       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
6120     }
6121   }
6122   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
6123   PetscFunctionReturn(0);
6124 }
6125 
6126 #undef __FUNCT__
6127 #define __FUNCT__ "DMPlexCreateSectionBCDof"
6128 /* Set the number of dof on each point and separate by fields
6129    If constDof is PETSC_DETERMINE, constrain every dof on the point
6130 */
6131 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
6132 {
6133   PetscInt       numFields;
6134   PetscInt       bc;
6135   PetscErrorCode ierr;
6136 
6137   PetscFunctionBegin;
6138   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6139   for (bc = 0; bc < numBC; ++bc) {
6140     PetscInt        field = 0;
6141     const PetscInt *idx;
6142     PetscInt        n, i;
6143 
6144     if (numFields) field = bcField[bc];
6145     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
6146     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6147     for (i = 0; i < n; ++i) {
6148       const PetscInt p        = idx[i];
6149       PetscInt       numConst = constDof;
6150 
6151       /* Constrain every dof on the point */
6152       if (numConst < 0) {
6153         if (numFields) {
6154           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
6155         } else {
6156           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
6157         }
6158       }
6159       if (numFields) {
6160         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
6161       }
6162       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
6163     }
6164     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6165   }
6166   PetscFunctionReturn(0);
6167 }
6168 
6169 #undef __FUNCT__
6170 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
6171 /* Set the constrained indices on each point and separate by fields */
6172 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
6173 {
6174   PetscInt      *maxConstraints;
6175   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
6176   PetscErrorCode ierr;
6177 
6178   PetscFunctionBegin;
6179   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6180   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6181   ierr = PetscMalloc((numFields+1) * sizeof(PetscInt), &maxConstraints);CHKERRQ(ierr);
6182   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
6183   for (p = pStart; p < pEnd; ++p) {
6184     PetscInt cdof;
6185 
6186     if (numFields) {
6187       for (f = 0; f < numFields; ++f) {
6188         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
6189         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
6190       }
6191     } else {
6192       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6193       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
6194     }
6195   }
6196   for (f = 0; f < numFields; ++f) {
6197     maxConstraints[numFields] += maxConstraints[f];
6198   }
6199   if (maxConstraints[numFields]) {
6200     PetscInt *indices;
6201 
6202     ierr = PetscMalloc(maxConstraints[numFields] * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6203     for (p = pStart; p < pEnd; ++p) {
6204       PetscInt cdof, d;
6205 
6206       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6207       if (cdof) {
6208         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
6209         if (numFields) {
6210           PetscInt numConst = 0, foff = 0;
6211 
6212           for (f = 0; f < numFields; ++f) {
6213             PetscInt cfdof, fdof;
6214 
6215             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6216             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
6217             /* Change constraint numbering from absolute local dof number to field relative local dof number */
6218             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
6219             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
6220             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
6221             numConst += cfdof;
6222             foff     += fdof;
6223           }
6224           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6225         } else {
6226           for (d = 0; d < cdof; ++d) indices[d] = d;
6227         }
6228         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6229       }
6230     }
6231     ierr = PetscFree(indices);CHKERRQ(ierr);
6232   }
6233   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
6234   PetscFunctionReturn(0);
6235 }
6236 
6237 #undef __FUNCT__
6238 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
6239 /* Set the constrained field indices on each point */
6240 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
6241 {
6242   const PetscInt *points, *indices;
6243   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
6244   PetscErrorCode  ierr;
6245 
6246   PetscFunctionBegin;
6247   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6248   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
6249 
6250   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
6251   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
6252   if (!constraintIndices) {
6253     PetscInt *idx, i;
6254 
6255     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6256     ierr = PetscMalloc(maxDof * sizeof(PetscInt), &idx);CHKERRQ(ierr);
6257     for (i = 0; i < maxDof; ++i) idx[i] = i;
6258     for (p = 0; p < numPoints; ++p) {
6259       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
6260     }
6261     ierr = PetscFree(idx);CHKERRQ(ierr);
6262   } else {
6263     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
6264     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
6265     for (p = 0; p < numPoints; ++p) {
6266       PetscInt fcdof;
6267 
6268       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
6269       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);
6270       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
6271     }
6272     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
6273   }
6274   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
6275   PetscFunctionReturn(0);
6276 }
6277 
6278 #undef __FUNCT__
6279 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
6280 /* Set the constrained indices on each point and separate by fields */
6281 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
6282 {
6283   PetscInt      *indices;
6284   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
6285   PetscErrorCode ierr;
6286 
6287   PetscFunctionBegin;
6288   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6289   ierr = PetscMalloc(maxDof * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6290   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6291   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
6292   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6293   for (p = pStart; p < pEnd; ++p) {
6294     PetscInt cdof, d;
6295 
6296     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6297     if (cdof) {
6298       PetscInt numConst = 0, foff = 0;
6299 
6300       for (f = 0; f < numFields; ++f) {
6301         const PetscInt *fcind;
6302         PetscInt        fdof, fcdof;
6303 
6304         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6305         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
6306         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
6307         /* Change constraint numbering from field relative local dof number to absolute local dof number */
6308         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
6309         foff     += fdof;
6310         numConst += fcdof;
6311       }
6312       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6313       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6314     }
6315   }
6316   ierr = PetscFree(indices);CHKERRQ(ierr);
6317   PetscFunctionReturn(0);
6318 }
6319 
6320 #undef __FUNCT__
6321 #define __FUNCT__ "DMPlexCreateSection"
6322 /*@C
6323   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
6324 
6325   Not Collective
6326 
6327   Input Parameters:
6328 + dm        - The DMPlex object
6329 . dim       - The spatial dimension of the problem
6330 . numFields - The number of fields in the problem
6331 . numComp   - An array of size numFields that holds the number of components for each field
6332 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
6333 . numBC     - The number of boundary conditions
6334 . bcField   - An array of size numBC giving the field number for each boundry condition
6335 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
6336 
6337   Output Parameter:
6338 . section - The PetscSection object
6339 
6340   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
6341   nubmer of dof for field 0 on each edge.
6342 
6343   Level: developer
6344 
6345   Fortran Notes:
6346   A Fortran 90 version is available as DMPlexCreateSectionF90()
6347 
6348 .keywords: mesh, elements
6349 .seealso: DMPlexCreate(), PetscSectionCreate()
6350 @*/
6351 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
6352 {
6353   PetscErrorCode ierr;
6354 
6355   PetscFunctionBegin;
6356   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
6357   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
6358   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
6359   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
6360   {
6361     PetscBool view = PETSC_FALSE;
6362 
6363     ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-section_view", &view);CHKERRQ(ierr);
6364     if (view) {ierr = PetscSectionView(*section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
6365   }
6366   PetscFunctionReturn(0);
6367 }
6368 
6369 #undef __FUNCT__
6370 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
6371 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
6372 {
6373   PetscSection   section;
6374   PetscErrorCode ierr;
6375 
6376   PetscFunctionBegin;
6377   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
6378   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6379   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
6380   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6381   PetscFunctionReturn(0);
6382 }
6383 
6384 #undef __FUNCT__
6385 #define __FUNCT__ "DMPlexGetCoordinateSection"
6386 /*@
6387   DMPlexGetCoordinateSection - Retrieve the layout of coordinate values over the mesh.
6388 
6389   Not Collective
6390 
6391   Input Parameter:
6392 . dm - The DMPlex object
6393 
6394   Output Parameter:
6395 . section - The PetscSection object
6396 
6397   Level: intermediate
6398 
6399 .keywords: mesh, coordinates
6400 .seealso: DMGetCoordinateDM(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6401 @*/
6402 PetscErrorCode DMPlexGetCoordinateSection(DM dm, PetscSection *section)
6403 {
6404   DM             cdm;
6405   PetscErrorCode ierr;
6406 
6407   PetscFunctionBegin;
6408   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6409   PetscValidPointer(section, 2);
6410   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6411   ierr = DMGetDefaultSection(cdm, section);CHKERRQ(ierr);
6412   PetscFunctionReturn(0);
6413 }
6414 
6415 #undef __FUNCT__
6416 #define __FUNCT__ "DMPlexSetCoordinateSection"
6417 /*@
6418   DMPlexSetCoordinateSection - Set the layout of coordinate values over the mesh.
6419 
6420   Not Collective
6421 
6422   Input Parameters:
6423 + dm      - The DMPlex object
6424 - section - The PetscSection object
6425 
6426   Level: intermediate
6427 
6428 .keywords: mesh, coordinates
6429 .seealso: DMPlexGetCoordinateSection(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6430 @*/
6431 PetscErrorCode DMPlexSetCoordinateSection(DM dm, PetscSection section)
6432 {
6433   DM             cdm;
6434   PetscErrorCode ierr;
6435 
6436   PetscFunctionBegin;
6437   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
6438   PetscValidHeaderSpecific(section,PETSC_SECTION_CLASSID,2);
6439   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6440   ierr = DMSetDefaultSection(cdm, section);CHKERRQ(ierr);
6441   PetscFunctionReturn(0);
6442 }
6443 
6444 #undef __FUNCT__
6445 #define __FUNCT__ "DMPlexGetConeSection"
6446 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
6447 {
6448   DM_Plex *mesh = (DM_Plex*) dm->data;
6449 
6450   PetscFunctionBegin;
6451   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6452   if (section) *section = mesh->coneSection;
6453   PetscFunctionReturn(0);
6454 }
6455 
6456 #undef __FUNCT__
6457 #define __FUNCT__ "DMPlexGetCones"
6458 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
6459 {
6460   DM_Plex *mesh = (DM_Plex*) dm->data;
6461 
6462   PetscFunctionBegin;
6463   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6464   if (cones) *cones = mesh->cones;
6465   PetscFunctionReturn(0);
6466 }
6467 
6468 #undef __FUNCT__
6469 #define __FUNCT__ "DMPlexGetConeOrientations"
6470 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
6471 {
6472   DM_Plex *mesh = (DM_Plex*) dm->data;
6473 
6474   PetscFunctionBegin;
6475   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6476   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
6477   PetscFunctionReturn(0);
6478 }
6479 
6480 /******************************** FEM Support **********************************/
6481 
6482 #undef __FUNCT__
6483 #define __FUNCT__ "DMPlexVecGetClosure"
6484 /*@C
6485   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
6486 
6487   Not collective
6488 
6489   Input Parameters:
6490 + dm - The DM
6491 . section - The section describing the layout in v, or NULL to use the default section
6492 . v - The local vector
6493 - point - The sieve point in the DM
6494 
6495   Output Parameters:
6496 + csize - The number of values in the closure, or NULL
6497 - values - The array of values, which is a borrowed array and should not be freed
6498 
6499   Fortran Notes:
6500   Since it returns an array, this routine is only available in Fortran 90, and you must
6501   include petsc.h90 in your code.
6502 
6503   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6504 
6505   Level: intermediate
6506 
6507 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6508 @*/
6509 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6510 {
6511   PetscScalar   *array, *vArray;
6512   PetscInt      *points = NULL;
6513   PetscInt       offsets[32];
6514   PetscInt       depth, numFields, size = 0, numPoints, pStart, pEnd, p, q, f;
6515   PetscErrorCode ierr;
6516 
6517   PetscFunctionBegin;
6518   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6519   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
6520   if (!section) {
6521     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
6522   }
6523   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6524   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6525   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6526   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6527   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6528   if (depth == 1 && numFields < 2) {
6529     const PetscInt *cone, *coneO;
6530 
6531     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
6532     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
6533     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
6534     if (!*values) {
6535       if ((point >= pStart) && (point < pEnd)) {
6536         PetscInt dof;
6537         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
6538         size += dof;
6539       }
6540       for (p = 0; p < numPoints; ++p) {
6541         const PetscInt cp = cone[p];
6542         PetscInt       dof;
6543 
6544         if ((cp < pStart) || (cp >= pEnd)) continue;
6545         ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6546         size += dof;
6547       }
6548       ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
6549     } else {
6550       array = *values;
6551     }
6552     size = 0;
6553     ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
6554     if ((point >= pStart) && (point < pEnd)) {
6555       PetscInt     dof, off, d;
6556       PetscScalar *varr;
6557       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
6558       ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6559       varr = &vArray[off];
6560       for (d = 0; d < dof; ++d, ++offsets[0]) {
6561         array[offsets[0]] = varr[d];
6562       }
6563       size += dof;
6564     }
6565     for (p = 0; p < numPoints; ++p) {
6566       const PetscInt cp = cone[p];
6567       PetscInt       o  = coneO[p];
6568       PetscInt       dof, off, d;
6569       PetscScalar   *varr;
6570 
6571       if ((cp < pStart) || (cp >= pEnd)) continue;
6572       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6573       ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
6574       varr = &vArray[off];
6575       if (o >= 0) {
6576         for (d = 0; d < dof; ++d, ++offsets[0]) {
6577           array[offsets[0]] = varr[d];
6578         }
6579       } else {
6580         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
6581           array[offsets[0]] = varr[d];
6582         }
6583       }
6584       size += dof;
6585     }
6586     ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
6587     if (!*values) {
6588       if (csize) *csize = size;
6589       *values = array;
6590     } else {
6591       if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
6592       *csize = size;
6593     }
6594     PetscFunctionReturn(0);
6595   }
6596   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6597   /* Compress out points not in the section */
6598   for (p = 0, q = 0; p < numPoints*2; p += 2) {
6599     if ((points[p] >= pStart) && (points[p] < pEnd)) {
6600       points[q*2]   = points[p];
6601       points[q*2+1] = points[p+1];
6602       ++q;
6603     }
6604   }
6605   numPoints = q;
6606   for (p = 0, size = 0; p < numPoints*2; p += 2) {
6607     PetscInt dof, fdof;
6608 
6609     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6610     for (f = 0; f < numFields; ++f) {
6611       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6612       offsets[f+1] += fdof;
6613     }
6614     size += dof;
6615   }
6616   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
6617   if (numFields && offsets[numFields] != size) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], size);
6618   ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
6619   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
6620   for (p = 0; p < numPoints*2; p += 2) {
6621     PetscInt     o = points[p+1];
6622     PetscInt     dof, off, d;
6623     PetscScalar *varr;
6624 
6625     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6626     ierr = PetscSectionGetOffset(section, points[p], &off);CHKERRQ(ierr);
6627     varr = &vArray[off];
6628     if (numFields) {
6629       PetscInt fdof, foff, fcomp, f, c;
6630 
6631       for (f = 0, foff = 0; f < numFields; ++f) {
6632         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6633         if (o >= 0) {
6634           for (d = 0; d < fdof; ++d, ++offsets[f]) {
6635             array[offsets[f]] = varr[foff+d];
6636           }
6637         } else {
6638           ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6639           for (d = fdof/fcomp-1; d >= 0; --d) {
6640             for (c = 0; c < fcomp; ++c, ++offsets[f]) {
6641               array[offsets[f]] = varr[foff+d*fcomp+c];
6642             }
6643           }
6644         }
6645         foff += fdof;
6646       }
6647     } else {
6648       if (o >= 0) {
6649         for (d = 0; d < dof; ++d, ++offsets[0]) {
6650           array[offsets[0]] = varr[d];
6651         }
6652       } else {
6653         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
6654           array[offsets[0]] = varr[d];
6655         }
6656       }
6657     }
6658   }
6659   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6660   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
6661   if (csize) *csize = size;
6662   *values = array;
6663   PetscFunctionReturn(0);
6664 }
6665 
6666 #undef __FUNCT__
6667 #define __FUNCT__ "DMPlexVecRestoreClosure"
6668 /*@C
6669   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
6670 
6671   Not collective
6672 
6673   Input Parameters:
6674 + dm - The DM
6675 . section - The section describing the layout in v, or NULL to use the default section
6676 . v - The local vector
6677 . point - The sieve point in the DM
6678 . csize - The number of values in the closure, or NULL
6679 - values - The array of values, which is a borrowed array and should not be freed
6680 
6681   Fortran Notes:
6682   Since it returns an array, this routine is only available in Fortran 90, and you must
6683   include petsc.h90 in your code.
6684 
6685   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6686 
6687   Level: intermediate
6688 
6689 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6690 @*/
6691 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6692 {
6693   PetscInt       size = 0;
6694   PetscErrorCode ierr;
6695 
6696   PetscFunctionBegin;
6697   /* Should work without recalculating size */
6698   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
6699   PetscFunctionReturn(0);
6700 }
6701 
6702 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
6703 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
6704 
6705 #undef __FUNCT__
6706 #define __FUNCT__ "updatePoint_private"
6707 PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6708 {
6709   PetscInt        cdof;   /* The number of constraints on this point */
6710   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6711   PetscScalar    *a;
6712   PetscInt        off, cind = 0, k;
6713   PetscErrorCode  ierr;
6714 
6715   PetscFunctionBegin;
6716   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
6717   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6718   a    = &array[off];
6719   if (!cdof || setBC) {
6720     if (orientation >= 0) {
6721       for (k = 0; k < dof; ++k) {
6722         fuse(&a[k], values[k]);
6723       }
6724     } else {
6725       for (k = 0; k < dof; ++k) {
6726         fuse(&a[k], values[dof-k-1]);
6727       }
6728     }
6729   } else {
6730     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
6731     if (orientation >= 0) {
6732       for (k = 0; k < dof; ++k) {
6733         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6734         fuse(&a[k], values[k]);
6735       }
6736     } else {
6737       for (k = 0; k < dof; ++k) {
6738         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6739         fuse(&a[k], values[dof-k-1]);
6740       }
6741     }
6742   }
6743   PetscFunctionReturn(0);
6744 }
6745 
6746 #undef __FUNCT__
6747 #define __FUNCT__ "updatePointFields_private"
6748 PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6749 {
6750   PetscScalar   *a;
6751   PetscInt       numFields, off, foff, f;
6752   PetscErrorCode ierr;
6753 
6754   PetscFunctionBegin;
6755   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6756   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6757   a    = &array[off];
6758   for (f = 0, foff = 0; f < numFields; ++f) {
6759     PetscInt        fdof, fcomp, fcdof;
6760     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
6761     PetscInt        cind = 0, k, c;
6762 
6763     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6764     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
6765     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
6766     if (!fcdof || setBC) {
6767       if (orientation >= 0) {
6768         for (k = 0; k < fdof; ++k) {
6769           fuse(&a[foff+k], values[foffs[f]+k]);
6770         }
6771       } else {
6772         for (k = fdof/fcomp-1; k >= 0; --k) {
6773           for (c = 0; c < fcomp; ++c) {
6774             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
6775           }
6776         }
6777       }
6778     } else {
6779       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
6780       if (orientation >= 0) {
6781         for (k = 0; k < fdof; ++k) {
6782           if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
6783           fuse(&a[foff+k], values[foffs[f]+k]);
6784         }
6785       } else {
6786         for (k = fdof/fcomp-1; k >= 0; --k) {
6787           for (c = 0; c < fcomp; ++c) {
6788             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
6789             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
6790           }
6791         }
6792       }
6793     }
6794     foff     += fdof;
6795     foffs[f] += fdof;
6796   }
6797   PetscFunctionReturn(0);
6798 }
6799 
6800 #undef __FUNCT__
6801 #define __FUNCT__ "DMPlexVecSetClosure"
6802 /*@C
6803   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
6804 
6805   Not collective
6806 
6807   Input Parameters:
6808 + dm - The DM
6809 . section - The section describing the layout in v, or NULL to use the default section
6810 . v - The local vector
6811 . point - The sieve point in the DM
6812 . values - The array of values
6813 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6814 
6815   Fortran Notes:
6816   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
6817 
6818   Level: intermediate
6819 
6820 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
6821 @*/
6822 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
6823 {
6824   PetscScalar   *array;
6825   PetscInt      *points = NULL;
6826   PetscInt       offsets[32];
6827   PetscInt       depth, numFields, numPoints, off, dof, pStart, pEnd, p, q, f;
6828   PetscErrorCode ierr;
6829 
6830   PetscFunctionBegin;
6831   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6832   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
6833   if (!section) {
6834     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
6835   }
6836   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6837   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6838   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6839   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6840   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6841   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
6842     const PetscInt *cone, *coneO;
6843 
6844     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
6845     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
6846     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
6847     ierr = VecGetArray(v, &array);CHKERRQ(ierr);
6848     for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
6849       const PetscInt cp = !p ? point : cone[p-1];
6850       const PetscInt o  = !p ? 0     : coneO[p-1];
6851 
6852       if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
6853       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
6854       /* ADD_VALUES */
6855       {
6856         const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6857         PetscScalar    *a;
6858         PetscInt        cdof, coff, cind = 0, k;
6859 
6860         ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
6861         ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
6862         a    = &array[coff];
6863         if (!cdof) {
6864           if (o >= 0) {
6865             for (k = 0; k < dof; ++k) {
6866               a[k] += values[off+k];
6867             }
6868           } else {
6869             for (k = 0; k < dof; ++k) {
6870               a[k] += values[off+dof-k-1];
6871             }
6872           }
6873         } else {
6874           ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
6875           if (o >= 0) {
6876             for (k = 0; k < dof; ++k) {
6877               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6878               a[k] += values[off+k];
6879             }
6880           } else {
6881             for (k = 0; k < dof; ++k) {
6882               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6883               a[k] += values[off+dof-k-1];
6884             }
6885           }
6886         }
6887       }
6888     }
6889     ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
6890     PetscFunctionReturn(0);
6891   }
6892   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6893   /* Compress out points not in the section */
6894   for (p = 0, q = 0; p < numPoints*2; p += 2) {
6895     if ((points[p] >= pStart) && (points[p] < pEnd)) {
6896       points[q*2]   = points[p];
6897       points[q*2+1] = points[p+1];
6898       ++q;
6899     }
6900   }
6901   numPoints = q;
6902   for (p = 0; p < numPoints*2; p += 2) {
6903     PetscInt fdof;
6904 
6905     for (f = 0; f < numFields; ++f) {
6906       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6907       offsets[f+1] += fdof;
6908     }
6909   }
6910   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
6911   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
6912   if (numFields) {
6913     switch (mode) {
6914     case INSERT_VALUES:
6915       for (p = 0; p < numPoints*2; p += 2) {
6916         PetscInt o = points[p+1];
6917         updatePointFields_private(section, points[p], offsets, insert, PETSC_FALSE, o, values, array);
6918       } break;
6919     case INSERT_ALL_VALUES:
6920       for (p = 0; p < numPoints*2; p += 2) {
6921         PetscInt o = points[p+1];
6922         updatePointFields_private(section, points[p], offsets, insert, PETSC_TRUE,  o, values, array);
6923       } break;
6924     case ADD_VALUES:
6925       for (p = 0; p < numPoints*2; p += 2) {
6926         PetscInt o = points[p+1];
6927         updatePointFields_private(section, points[p], offsets, add,    PETSC_FALSE, o, values, array);
6928       } break;
6929     case ADD_ALL_VALUES:
6930       for (p = 0; p < numPoints*2; p += 2) {
6931         PetscInt o = points[p+1];
6932         updatePointFields_private(section, points[p], offsets, add,    PETSC_TRUE,  o, values, array);
6933       } break;
6934     default:
6935       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
6936     }
6937   } else {
6938     switch (mode) {
6939     case INSERT_VALUES:
6940       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
6941         PetscInt o = points[p+1];
6942         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6943         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
6944       } break;
6945     case INSERT_ALL_VALUES:
6946       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
6947         PetscInt o = points[p+1];
6948         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6949         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
6950       } break;
6951     case ADD_VALUES:
6952       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
6953         PetscInt o = points[p+1];
6954         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6955         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
6956       } break;
6957     case ADD_ALL_VALUES:
6958       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
6959         PetscInt o = points[p+1];
6960         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6961         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
6962       } break;
6963     default:
6964       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
6965     }
6966   }
6967   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6968   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
6969   PetscFunctionReturn(0);
6970 }
6971 
6972 #undef __FUNCT__
6973 #define __FUNCT__ "DMPlexPrintMatSetValues"
6974 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numIndices, const PetscInt indices[], const PetscScalar values[])
6975 {
6976   PetscMPIInt    rank;
6977   PetscInt       i, j;
6978   PetscErrorCode ierr;
6979 
6980   PetscFunctionBegin;
6981   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
6982   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
6983   for (i = 0; i < numIndices; i++) {
6984     ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat indices[%D] = %D\n", rank, i, indices[i]);CHKERRQ(ierr);
6985   }
6986   for (i = 0; i < numIndices; i++) {
6987     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
6988     for (j = 0; j < numIndices; j++) {
6989 #if defined(PETSC_USE_COMPLEX)
6990       ierr = PetscViewerASCIIPrintf(viewer, " (%G,%G)", PetscRealPart(values[i*numIndices+j]), PetscImaginaryPart(values[i*numIndices+j]));CHKERRQ(ierr);
6991 #else
6992       ierr = PetscViewerASCIIPrintf(viewer, " %G", values[i*numIndices+j]);CHKERRQ(ierr);
6993 #endif
6994     }
6995     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
6996   }
6997   PetscFunctionReturn(0);
6998 }
6999 
7000 #undef __FUNCT__
7001 #define __FUNCT__ "indicesPoint_private"
7002 /* . off - The global offset of this point */
7003 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
7004 {
7005   PetscInt        dof;    /* The number of unknowns on this point */
7006   PetscInt        cdof;   /* The number of constraints on this point */
7007   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
7008   PetscInt        cind = 0, k;
7009   PetscErrorCode  ierr;
7010 
7011   PetscFunctionBegin;
7012   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
7013   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
7014   if (!cdof || setBC) {
7015     if (orientation >= 0) {
7016       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
7017     } else {
7018       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
7019     }
7020   } else {
7021     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
7022     if (orientation >= 0) {
7023       for (k = 0; k < dof; ++k) {
7024         if ((cind < cdof) && (k == cdofs[cind])) {
7025           /* Insert check for returning constrained indices */
7026           indices[*loff+k] = -(off+k+1);
7027           ++cind;
7028         } else {
7029           indices[*loff+k] = off+k-cind;
7030         }
7031       }
7032     } else {
7033       for (k = 0; k < dof; ++k) {
7034         if ((cind < cdof) && (k == cdofs[cind])) {
7035           /* Insert check for returning constrained indices */
7036           indices[*loff+dof-k-1] = -(off+k+1);
7037           ++cind;
7038         } else {
7039           indices[*loff+dof-k-1] = off+k-cind;
7040         }
7041       }
7042     }
7043   }
7044   *loff += dof;
7045   PetscFunctionReturn(0);
7046 }
7047 
7048 #undef __FUNCT__
7049 #define __FUNCT__ "indicesPointFields_private"
7050 /* . off - The global offset of this point */
7051 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
7052 {
7053   PetscInt       numFields, foff, f;
7054   PetscErrorCode ierr;
7055 
7056   PetscFunctionBegin;
7057   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7058   for (f = 0, foff = 0; f < numFields; ++f) {
7059     PetscInt        fdof, fcomp, cfdof;
7060     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
7061     PetscInt        cind = 0, k, c;
7062 
7063     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
7064     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
7065     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
7066     if (!cfdof || setBC) {
7067       if (orientation >= 0) {
7068         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
7069       } else {
7070         for (k = fdof/fcomp-1; k >= 0; --k) {
7071           for (c = 0; c < fcomp; ++c) {
7072             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
7073           }
7074         }
7075       }
7076     } else {
7077       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
7078       if (orientation >= 0) {
7079         for (k = 0; k < fdof; ++k) {
7080           if ((cind < cfdof) && (k == fcdofs[cind])) {
7081             indices[foffs[f]+k] = -(off+foff+k+1);
7082             ++cind;
7083           } else {
7084             indices[foffs[f]+k] = off+foff+k-cind;
7085           }
7086         }
7087       } else {
7088         for (k = fdof/fcomp-1; k >= 0; --k) {
7089           for (c = 0; c < fcomp; ++c) {
7090             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
7091               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
7092               ++cind;
7093             } else {
7094               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
7095             }
7096           }
7097         }
7098       }
7099     }
7100     foff     += fdof - cfdof;
7101     foffs[f] += fdof;
7102   }
7103   PetscFunctionReturn(0);
7104 }
7105 
7106 #undef __FUNCT__
7107 #define __FUNCT__ "DMPlexMatSetClosure"
7108 /*@C
7109   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
7110 
7111   Not collective
7112 
7113   Input Parameters:
7114 + dm - The DM
7115 . section - The section describing the layout in v
7116 . globalSection - The section describing the layout in v
7117 . A - The matrix
7118 . point - The sieve point in the DM
7119 . values - The array of values
7120 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
7121 
7122   Fortran Notes:
7123   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
7124 
7125   Level: intermediate
7126 
7127 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
7128 @*/
7129 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
7130 {
7131   DM_Plex       *mesh   = (DM_Plex*) dm->data;
7132   PetscInt      *points = NULL;
7133   PetscInt      *indices;
7134   PetscInt       offsets[32];
7135   PetscInt       numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
7136   PetscErrorCode ierr;
7137 
7138   PetscFunctionBegin;
7139   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7140   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
7141   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
7142   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
7143   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7144   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
7145   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
7146   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7147   /* Compress out points not in the section */
7148   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
7149   for (p = 0, q = 0; p < numPoints*2; p += 2) {
7150     if ((points[p] >= pStart) && (points[p] < pEnd)) {
7151       points[q*2]   = points[p];
7152       points[q*2+1] = points[p+1];
7153       ++q;
7154     }
7155   }
7156   numPoints = q;
7157   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
7158     PetscInt fdof;
7159 
7160     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7161     for (f = 0; f < numFields; ++f) {
7162       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
7163       offsets[f+1] += fdof;
7164     }
7165     numIndices += dof;
7166   }
7167   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
7168 
7169   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
7170   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7171   if (numFields) {
7172     for (p = 0; p < numPoints*2; p += 2) {
7173       PetscInt o = points[p+1];
7174       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7175       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
7176     }
7177   } else {
7178     for (p = 0, off = 0; p < numPoints*2; p += 2) {
7179       PetscInt o = points[p+1];
7180       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7181       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
7182     }
7183   }
7184   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr);}
7185   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
7186   if (ierr) {
7187     PetscMPIInt    rank;
7188     PetscErrorCode ierr2;
7189 
7190     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
7191     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
7192     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr2);
7193     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
7194     CHKERRQ(ierr);
7195   }
7196   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7197   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7198   PetscFunctionReturn(0);
7199 }
7200 
7201 #undef __FUNCT__
7202 #define __FUNCT__ "DMPlexGetHybridBounds"
7203 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
7204 {
7205   DM_Plex       *mesh = (DM_Plex*) dm->data;
7206   PetscInt       dim;
7207   PetscErrorCode ierr;
7208 
7209   PetscFunctionBegin;
7210   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7211   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7212   if (cMax) *cMax = mesh->hybridPointMax[dim];
7213   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
7214   if (eMax) *eMax = mesh->hybridPointMax[1];
7215   if (vMax) *vMax = mesh->hybridPointMax[0];
7216   PetscFunctionReturn(0);
7217 }
7218 
7219 #undef __FUNCT__
7220 #define __FUNCT__ "DMPlexSetHybridBounds"
7221 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
7222 {
7223   DM_Plex       *mesh = (DM_Plex*) dm->data;
7224   PetscInt       dim;
7225   PetscErrorCode ierr;
7226 
7227   PetscFunctionBegin;
7228   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7229   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7230   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
7231   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
7232   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
7233   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
7234   PetscFunctionReturn(0);
7235 }
7236 
7237 #undef __FUNCT__
7238 #define __FUNCT__ "DMPlexGetVTKCellHeight"
7239 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
7240 {
7241   DM_Plex *mesh = (DM_Plex*) dm->data;
7242 
7243   PetscFunctionBegin;
7244   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7245   PetscValidPointer(cellHeight, 2);
7246   *cellHeight = mesh->vtkCellHeight;
7247   PetscFunctionReturn(0);
7248 }
7249 
7250 #undef __FUNCT__
7251 #define __FUNCT__ "DMPlexSetVTKCellHeight"
7252 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
7253 {
7254   DM_Plex *mesh = (DM_Plex*) dm->data;
7255 
7256   PetscFunctionBegin;
7257   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7258   mesh->vtkCellHeight = cellHeight;
7259   PetscFunctionReturn(0);
7260 }
7261 
7262 #undef __FUNCT__
7263 #define __FUNCT__ "DMPlexCreateNumbering_Private"
7264 /* We can easily have a form that takes an IS instead */
7265 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
7266 {
7267   PetscSection   section, globalSection;
7268   PetscInt      *numbers, p;
7269   PetscErrorCode ierr;
7270 
7271   PetscFunctionBegin;
7272   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
7273   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
7274   for (p = pStart; p < pEnd; ++p) {
7275     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
7276   }
7277   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
7278   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7279   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &numbers);CHKERRQ(ierr);
7280   for (p = pStart; p < pEnd; ++p) {
7281     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
7282   }
7283   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
7284   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
7285   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7286   PetscFunctionReturn(0);
7287 }
7288 
7289 #undef __FUNCT__
7290 #define __FUNCT__ "DMPlexGetCellNumbering"
7291 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7292 {
7293   DM_Plex       *mesh = (DM_Plex*) dm->data;
7294   PetscInt       cellHeight, cStart, cEnd, cMax;
7295   PetscErrorCode ierr;
7296 
7297   PetscFunctionBegin;
7298   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7299   if (!mesh->globalCellNumbers) {
7300     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7301     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7302     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
7303     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
7304     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
7305   }
7306   *globalCellNumbers = mesh->globalCellNumbers;
7307   PetscFunctionReturn(0);
7308 }
7309 
7310 #undef __FUNCT__
7311 #define __FUNCT__ "DMPlexGetVertexNumbering"
7312 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7313 {
7314   DM_Plex       *mesh = (DM_Plex*) dm->data;
7315   PetscInt       vStart, vEnd, vMax;
7316   PetscErrorCode ierr;
7317 
7318   PetscFunctionBegin;
7319   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7320   if (!mesh->globalVertexNumbers) {
7321     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7322     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
7323     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
7324     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
7325   }
7326   *globalVertexNumbers = mesh->globalVertexNumbers;
7327   PetscFunctionReturn(0);
7328 }
7329 
7330 
7331 #undef __FUNCT__
7332 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
7333 /*@C
7334   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
7335   the local section and an SF describing the section point overlap.
7336 
7337   Input Parameters:
7338   + s - The PetscSection for the local field layout
7339   . sf - The SF describing parallel layout of the section points
7340   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
7341   . label - The label specifying the points
7342   - labelValue - The label stratum specifying the points
7343 
7344   Output Parameter:
7345   . gsection - The PetscSection for the global field layout
7346 
7347   Note: This gives negative sizes and offsets to points not owned by this process
7348 
7349   Level: developer
7350 
7351 .seealso: PetscSectionCreate()
7352 @*/
7353 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
7354 {
7355   PetscInt      *neg = NULL, *tmpOff = NULL;
7356   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
7357   PetscErrorCode ierr;
7358 
7359   PetscFunctionBegin;
7360   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
7361   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
7362   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
7363   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
7364   if (nroots >= 0) {
7365     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
7366     ierr = PetscMalloc(nroots * sizeof(PetscInt), &neg);CHKERRQ(ierr);
7367     ierr = PetscMemzero(neg, nroots * sizeof(PetscInt));CHKERRQ(ierr);
7368     if (nroots > pEnd-pStart) {
7369       ierr = PetscMalloc(nroots * sizeof(PetscInt), &tmpOff);CHKERRQ(ierr);
7370       ierr = PetscMemzero(tmpOff, nroots * sizeof(PetscInt));CHKERRQ(ierr);
7371     } else {
7372       tmpOff = &(*gsection)->atlasDof[-pStart];
7373     }
7374   }
7375   /* Mark ghost points with negative dof */
7376   for (p = pStart; p < pEnd; ++p) {
7377     PetscInt value;
7378 
7379     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
7380     if (value != labelValue) continue;
7381     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
7382     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
7383     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
7384     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
7385     if (neg) neg[p] = -(dof+1);
7386   }
7387   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
7388   if (nroots >= 0) {
7389     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7390     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7391     if (nroots > pEnd-pStart) {
7392       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
7393     }
7394   }
7395   /* Calculate new sizes, get proccess offset, and calculate point offsets */
7396   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
7397     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
7398     (*gsection)->atlasOff[p] = off;
7399     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
7400   }
7401   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
7402   globalOff -= off;
7403   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
7404     (*gsection)->atlasOff[p] += globalOff;
7405     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
7406   }
7407   /* Put in negative offsets for ghost points */
7408   if (nroots >= 0) {
7409     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7410     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
7411     if (nroots > pEnd-pStart) {
7412       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
7413     }
7414   }
7415   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
7416   ierr = PetscFree(neg);CHKERRQ(ierr);
7417   PetscFunctionReturn(0);
7418 }
7419