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