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