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