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