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