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