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