xref: /petsc/src/dm/impls/plex/plex.c (revision 7eba1a174884e7e3239a3955e65afe5a4d6c0bfa)
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 
2307   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2308   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2309   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2310   for (c = cStart; c < cEnd; ++c) {
2311     const PetscInt *cone, *coneO, *support;
2312     PetscInt        coneSize, supportSize, faceSize, cp, sp;
2313 
2314     if (!PetscBTLookup(flippedCells, c-cStart)) continue;
2315     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
2316     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
2317     ierr = DMPlexGetConeOrientation(dm, c, &coneO);CHKERRQ(ierr);
2318     for (cp = 0; cp < coneSize; ++cp) {
2319       const PetscInt rcp = coneSize-cp-1;
2320 
2321       ierr = DMPlexGetConeSize(dm, cone[rcp], &faceSize);CHKERRQ(ierr);
2322       revcone[cp]  = cone[rcp];
2323       revconeO[cp] = coneO[rcp] >= 0 ? -(faceSize-coneO[rcp]) : faceSize+coneO[rcp];
2324     }
2325     ierr = DMPlexSetCone(dm, c, revcone);CHKERRQ(ierr);
2326     ierr = DMPlexSetConeOrientation(dm, c, revconeO);CHKERRQ(ierr);
2327     /* Reverse orientations of support */
2328     faceSize = coneSize;
2329     ierr = DMPlexGetSupportSize(dm, c, &supportSize);CHKERRQ(ierr);
2330     ierr = DMPlexGetSupport(dm, c, &support);CHKERRQ(ierr);
2331     for (sp = 0; sp < supportSize; ++sp) {
2332       ierr = DMPlexGetConeSize(dm, support[sp], &coneSize);CHKERRQ(ierr);
2333       ierr = DMPlexGetCone(dm, support[sp], &cone);CHKERRQ(ierr);
2334       ierr = DMPlexGetConeOrientation(dm, support[sp], &coneO);CHKERRQ(ierr);
2335       for (cp = 0; cp < coneSize; ++cp) {
2336         if (cone[cp] != c) continue;
2337         ierr = DMPlexInsertConeOrientation(dm, support[sp], cp, coneO[cp] >= 0 ? -(faceSize-coneO[cp]) : faceSize+coneO[cp]);CHKERRQ(ierr);
2338       }
2339     }
2340   }
2341   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2342   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2343   ierr = PetscBTDestroy(&seenCells);CHKERRQ(ierr);
2344   ierr = PetscBTDestroy(&flippedCells);CHKERRQ(ierr);
2345   ierr = PetscBTDestroy(&seenFaces);CHKERRQ(ierr);
2346   ierr = PetscFree(faceFIFO);CHKERRQ(ierr);
2347   PetscFunctionReturn(0);
2348 }
2349 
2350 #undef __FUNCT__
2351 #define __FUNCT__ "DMPlexGetAdjacencySingleLevel_Internal"
2352 static PetscErrorCode DMPlexGetAdjacencySingleLevel_Internal(DM dm, PetscInt p, PetscBool useClosure, const PetscInt *tmpClosure, PetscInt *adjSize, PetscInt adj[])
2353 {
2354   const PetscInt *support = NULL;
2355   PetscInt        numAdj   = 0, maxAdjSize = *adjSize, supportSize, s;
2356   PetscErrorCode  ierr;
2357 
2358   PetscFunctionBegin;
2359   if (useClosure) {
2360     ierr = DMPlexGetConeSize(dm, p, &supportSize);CHKERRQ(ierr);
2361     ierr = DMPlexGetCone(dm, p, &support);CHKERRQ(ierr);
2362     for (s = 0; s < supportSize; ++s) {
2363       const PetscInt *cone = NULL;
2364       PetscInt        coneSize, c, q;
2365 
2366       ierr = DMPlexGetSupportSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2367       ierr = DMPlexGetSupport(dm, support[s], &cone);CHKERRQ(ierr);
2368       for (c = 0; c < coneSize; ++c) {
2369         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2370           if (cone[c] == adj[q]) break;
2371         }
2372         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2373       }
2374     }
2375   } else {
2376     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2377     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
2378     for (s = 0; s < supportSize; ++s) {
2379       const PetscInt *cone = NULL;
2380       PetscInt        coneSize, c, q;
2381 
2382       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2383       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
2384       for (c = 0; c < coneSize; ++c) {
2385         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2386           if (cone[c] == adj[q]) break;
2387         }
2388         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2389       }
2390     }
2391   }
2392   *adjSize = numAdj;
2393   PetscFunctionReturn(0);
2394 }
2395 
2396 #undef __FUNCT__
2397 #define __FUNCT__ "DMPlexCreateNeighborCSR"
2398 PetscErrorCode DMPlexCreateNeighborCSR(DM dm, PetscInt cellHeight, PetscInt *numVertices, PetscInt **offsets, PetscInt **adjacency)
2399 {
2400   const PetscInt maxFaceCases = 30;
2401   PetscInt       numFaceCases = 0;
2402   PetscInt       numFaceVertices[30]; /* maxFaceCases, C89 sucks sucks sucks */
2403   PetscInt      *off, *adj;
2404   PetscInt      *neighborCells, *tmpClosure;
2405   PetscInt       maxConeSize, maxSupportSize, maxClosure, maxNeighbors;
2406   PetscInt       dim, cellDim, depth = 0, faceDepth, cStart, cEnd, c, numCells, cell;
2407   PetscErrorCode ierr;
2408 
2409   PetscFunctionBegin;
2410   /* For parallel partitioning, I think you have to communicate supports */
2411   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2412   cellDim = dim - cellHeight;
2413   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2414   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2415   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
2416   if (cEnd - cStart == 0) {
2417     if (numVertices) *numVertices = 0;
2418     if (offsets)   *offsets   = NULL;
2419     if (adjacency) *adjacency = NULL;
2420     PetscFunctionReturn(0);
2421   }
2422   numCells  = cEnd - cStart;
2423   faceDepth = depth - cellHeight;
2424   if (dim == depth) {
2425     PetscInt f, fStart, fEnd;
2426 
2427     ierr = PetscCalloc1(numCells+1, &off);CHKERRQ(ierr);
2428     /* Count neighboring cells */
2429     ierr = DMPlexGetHeightStratum(dm, cellHeight+1, &fStart, &fEnd);CHKERRQ(ierr);
2430     for (f = fStart; f < fEnd; ++f) {
2431       const PetscInt *support;
2432       PetscInt        supportSize;
2433       ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
2434       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
2435       if (supportSize == 2) {
2436         ++off[support[0]-cStart+1];
2437         ++off[support[1]-cStart+1];
2438       }
2439     }
2440     /* Prefix sum */
2441     for (c = 1; c <= numCells; ++c) off[c] += off[c-1];
2442     if (adjacency) {
2443       PetscInt *tmp;
2444 
2445       ierr = PetscMalloc1(off[numCells], &adj);CHKERRQ(ierr);
2446       ierr = PetscMalloc1((numCells+1), &tmp);CHKERRQ(ierr);
2447       ierr = PetscMemcpy(tmp, off, (numCells+1) * sizeof(PetscInt));CHKERRQ(ierr);
2448       /* Get neighboring cells */
2449       for (f = fStart; f < fEnd; ++f) {
2450         const PetscInt *support;
2451         PetscInt        supportSize;
2452         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
2453         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
2454         if (supportSize == 2) {
2455           adj[tmp[support[0]-cStart]++] = support[1];
2456           adj[tmp[support[1]-cStart]++] = support[0];
2457         }
2458       }
2459 #if defined(PETSC_USE_DEBUG)
2460       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);
2461 #endif
2462       ierr = PetscFree(tmp);CHKERRQ(ierr);
2463     }
2464     if (numVertices) *numVertices = numCells;
2465     if (offsets)   *offsets   = off;
2466     if (adjacency) *adjacency = adj;
2467     PetscFunctionReturn(0);
2468   }
2469   /* Setup face recognition */
2470   if (faceDepth == 1) {
2471     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 */
2472 
2473     for (c = cStart; c < cEnd; ++c) {
2474       PetscInt corners;
2475 
2476       ierr = DMPlexGetConeSize(dm, c, &corners);CHKERRQ(ierr);
2477       if (!cornersSeen[corners]) {
2478         PetscInt nFV;
2479 
2480         if (numFaceCases >= maxFaceCases) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Exceeded maximum number of face recognition cases");
2481         cornersSeen[corners] = 1;
2482 
2483         ierr = DMPlexGetNumFaceVertices(dm, cellDim, corners, &nFV);CHKERRQ(ierr);
2484 
2485         numFaceVertices[numFaceCases++] = nFV;
2486       }
2487     }
2488   }
2489   maxClosure   = 2*PetscMax(PetscPowInt(maxConeSize,depth+1),PetscPowInt(maxSupportSize,depth+1));
2490   maxNeighbors = PetscPowInt(maxConeSize,depth+1)*PetscPowInt(maxSupportSize,depth+1);
2491   ierr         = PetscMalloc2(maxNeighbors,&neighborCells,maxClosure,&tmpClosure);CHKERRQ(ierr);
2492   ierr         = PetscCalloc1(numCells+1, &off);CHKERRQ(ierr);
2493   /* Count neighboring cells */
2494   for (cell = cStart; cell < cEnd; ++cell) {
2495     PetscInt numNeighbors = maxNeighbors, n;
2496 
2497     ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2498     /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2499     for (n = 0; n < numNeighbors; ++n) {
2500       PetscInt        cellPair[2];
2501       PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2502       PetscInt        meetSize = 0;
2503       const PetscInt *meet    = NULL;
2504 
2505       cellPair[0] = cell; cellPair[1] = neighborCells[n];
2506       if (cellPair[0] == cellPair[1]) continue;
2507       if (!found) {
2508         ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2509         if (meetSize) {
2510           PetscInt f;
2511 
2512           for (f = 0; f < numFaceCases; ++f) {
2513             if (numFaceVertices[f] == meetSize) {
2514               found = PETSC_TRUE;
2515               break;
2516             }
2517           }
2518         }
2519         ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2520       }
2521       if (found) ++off[cell-cStart+1];
2522     }
2523   }
2524   /* Prefix sum */
2525   for (cell = 1; cell <= numCells; ++cell) off[cell] += off[cell-1];
2526 
2527   if (adjacency) {
2528     ierr = PetscMalloc1(off[numCells], &adj);CHKERRQ(ierr);
2529     /* Get neighboring cells */
2530     for (cell = cStart; cell < cEnd; ++cell) {
2531       PetscInt numNeighbors = maxNeighbors, n;
2532       PetscInt cellOffset   = 0;
2533 
2534       ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2535       /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2536       for (n = 0; n < numNeighbors; ++n) {
2537         PetscInt        cellPair[2];
2538         PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2539         PetscInt        meetSize = 0;
2540         const PetscInt *meet    = NULL;
2541 
2542         cellPair[0] = cell; cellPair[1] = neighborCells[n];
2543         if (cellPair[0] == cellPair[1]) continue;
2544         if (!found) {
2545           ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2546           if (meetSize) {
2547             PetscInt f;
2548 
2549             for (f = 0; f < numFaceCases; ++f) {
2550               if (numFaceVertices[f] == meetSize) {
2551                 found = PETSC_TRUE;
2552                 break;
2553               }
2554             }
2555           }
2556           ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2557         }
2558         if (found) {
2559           adj[off[cell-cStart]+cellOffset] = neighborCells[n];
2560           ++cellOffset;
2561         }
2562       }
2563     }
2564   }
2565   ierr = PetscFree2(neighborCells,tmpClosure);CHKERRQ(ierr);
2566   if (numVertices) *numVertices = numCells;
2567   if (offsets)   *offsets   = off;
2568   if (adjacency) *adjacency = adj;
2569   PetscFunctionReturn(0);
2570 }
2571 
2572 #if defined(PETSC_HAVE_CHACO)
2573 #if defined(PETSC_HAVE_UNISTD_H)
2574 #include <unistd.h>
2575 #endif
2576 /* Chaco does not have an include file */
2577 PETSC_EXTERN int interface(int nvtxs, int *start, int *adjacency, int *vwgts,
2578                        float *ewgts, float *x, float *y, float *z, char *outassignname,
2579                        char *outfilename, short *assignment, int architecture, int ndims_tot,
2580                        int mesh_dims[3], double *goal, int global_method, int local_method,
2581                        int rqi_flag, int vmax, int ndims, double eigtol, long seed);
2582 
2583 extern int FREE_GRAPH;
2584 
2585 #undef __FUNCT__
2586 #define __FUNCT__ "DMPlexPartition_Chaco"
2587 PetscErrorCode DMPlexPartition_Chaco(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2588 {
2589   enum {DEFAULT_METHOD = 1, INERTIAL_METHOD = 3};
2590   MPI_Comm       comm;
2591   int            nvtxs          = numVertices; /* number of vertices in full graph */
2592   int           *vwgts          = NULL;   /* weights for all vertices */
2593   float         *ewgts          = NULL;   /* weights for all edges */
2594   float         *x              = NULL, *y = NULL, *z = NULL; /* coordinates for inertial method */
2595   char          *outassignname  = NULL;   /*  name of assignment output file */
2596   char          *outfilename    = NULL;   /* output file name */
2597   int            architecture   = 1;      /* 0 => hypercube, d => d-dimensional mesh */
2598   int            ndims_tot      = 0;      /* total number of cube dimensions to divide */
2599   int            mesh_dims[3];            /* dimensions of mesh of processors */
2600   double        *goal          = NULL;    /* desired set sizes for each set */
2601   int            global_method = 1;       /* global partitioning algorithm */
2602   int            local_method  = 1;       /* local partitioning algorithm */
2603   int            rqi_flag      = 0;       /* should I use RQI/Symmlq eigensolver? */
2604   int            vmax          = 200;     /* how many vertices to coarsen down to? */
2605   int            ndims         = 1;       /* number of eigenvectors (2^d sets) */
2606   double         eigtol        = 0.001;   /* tolerance on eigenvectors */
2607   long           seed          = 123636512; /* for random graph mutations */
2608   short int     *assignment;              /* Output partition */
2609   int            fd_stdout, fd_pipe[2];
2610   PetscInt      *points;
2611   PetscMPIInt    commSize;
2612   int            i, v, p;
2613   PetscErrorCode ierr;
2614 
2615   PetscFunctionBegin;
2616   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2617   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2618   if (!numVertices) {
2619     ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2620     ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2621     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2622     ierr = ISCreateGeneral(comm, 0, NULL, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2623     PetscFunctionReturn(0);
2624   }
2625   FREE_GRAPH = 0;                         /* Do not let Chaco free my memory */
2626   for (i = 0; i < start[numVertices]; ++i) ++adjacency[i];
2627 
2628   if (global_method == INERTIAL_METHOD) {
2629     /* manager.createCellCoordinates(nvtxs, &x, &y, &z); */
2630     SETERRQ(comm, PETSC_ERR_SUP, "Inertial partitioning not yet supported");
2631   }
2632   mesh_dims[0] = commSize;
2633   mesh_dims[1] = 1;
2634   mesh_dims[2] = 1;
2635   ierr = PetscMalloc1(nvtxs, &assignment);CHKERRQ(ierr);
2636   /* Chaco outputs to stdout. We redirect this to a buffer. */
2637   /* TODO: check error codes for UNIX calls */
2638 #if defined(PETSC_HAVE_UNISTD_H)
2639   {
2640     int piperet;
2641     piperet = pipe(fd_pipe);
2642     if (piperet) SETERRQ(comm,PETSC_ERR_SYS,"Could not create pipe");
2643     fd_stdout = dup(1);
2644     close(1);
2645     dup2(fd_pipe[1], 1);
2646   }
2647 #endif
2648   ierr = interface(nvtxs, (int*) start, (int*) adjacency, vwgts, ewgts, x, y, z, outassignname, outfilename,
2649                    assignment, architecture, ndims_tot, mesh_dims, goal, global_method, local_method, rqi_flag,
2650                    vmax, ndims, eigtol, seed);
2651 #if defined(PETSC_HAVE_UNISTD_H)
2652   {
2653     char msgLog[10000];
2654     int  count;
2655 
2656     fflush(stdout);
2657     count = read(fd_pipe[0], msgLog, (10000-1)*sizeof(char));
2658     if (count < 0) count = 0;
2659     msgLog[count] = 0;
2660     close(1);
2661     dup2(fd_stdout, 1);
2662     close(fd_stdout);
2663     close(fd_pipe[0]);
2664     close(fd_pipe[1]);
2665     if (ierr) SETERRQ1(comm, PETSC_ERR_LIB, "Error in Chaco library: %s", msgLog);
2666   }
2667 #endif
2668   /* Convert to PetscSection+IS */
2669   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2670   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2671   for (v = 0; v < nvtxs; ++v) {
2672     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2673   }
2674   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2675   ierr = PetscMalloc1(nvtxs, &points);CHKERRQ(ierr);
2676   for (p = 0, i = 0; p < commSize; ++p) {
2677     for (v = 0; v < nvtxs; ++v) {
2678       if (assignment[v] == p) points[i++] = v;
2679     }
2680   }
2681   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2682   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2683   if (global_method == INERTIAL_METHOD) {
2684     /* manager.destroyCellCoordinates(nvtxs, &x, &y, &z); */
2685   }
2686   ierr = PetscFree(assignment);CHKERRQ(ierr);
2687   for (i = 0; i < start[numVertices]; ++i) --adjacency[i];
2688   PetscFunctionReturn(0);
2689 }
2690 #endif
2691 
2692 #if defined(PETSC_HAVE_PARMETIS)
2693 #include <parmetis.h>
2694 
2695 #undef __FUNCT__
2696 #define __FUNCT__ "DMPlexPartition_ParMetis"
2697 PetscErrorCode DMPlexPartition_ParMetis(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2698 {
2699   MPI_Comm       comm;
2700   PetscInt       nvtxs      = numVertices; /* The number of vertices in full graph */
2701   PetscInt      *vtxdist;                  /* Distribution of vertices across processes */
2702   PetscInt      *xadj       = start;       /* Start of edge list for each vertex */
2703   PetscInt      *adjncy     = adjacency;   /* Edge lists for all vertices */
2704   PetscInt      *vwgt       = NULL;        /* Vertex weights */
2705   PetscInt      *adjwgt     = NULL;        /* Edge weights */
2706   PetscInt       wgtflag    = 0;           /* Indicates which weights are present */
2707   PetscInt       numflag    = 0;           /* Indicates initial offset (0 or 1) */
2708   PetscInt       ncon       = 1;           /* The number of weights per vertex */
2709   PetscInt       nparts;                   /* The number of partitions */
2710   PetscReal     *tpwgts;                   /* The fraction of vertex weights assigned to each partition */
2711   PetscReal     *ubvec;                    /* The balance intolerance for vertex weights */
2712   PetscInt       options[5];               /* Options */
2713   /* Outputs */
2714   PetscInt       edgeCut;                  /* The number of edges cut by the partition */
2715   PetscInt      *assignment, *points;
2716   PetscMPIInt    commSize, rank, p, v, i;
2717   PetscErrorCode ierr;
2718 
2719   PetscFunctionBegin;
2720   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
2721   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2722   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2723   nparts = commSize;
2724   options[0] = 0; /* Use all defaults */
2725   /* Calculate vertex distribution */
2726   ierr = PetscMalloc4(nparts+1,&vtxdist,nparts*ncon,&tpwgts,ncon,&ubvec,nvtxs,&assignment);CHKERRQ(ierr);
2727   vtxdist[0] = 0;
2728   ierr = MPI_Allgather(&nvtxs, 1, MPIU_INT, &vtxdist[1], 1, MPIU_INT, comm);CHKERRQ(ierr);
2729   for (p = 2; p <= nparts; ++p) {
2730     vtxdist[p] += vtxdist[p-1];
2731   }
2732   /* Calculate weights */
2733   for (p = 0; p < nparts; ++p) {
2734     tpwgts[p] = 1.0/nparts;
2735   }
2736   ubvec[0] = 1.05;
2737 
2738   if (nparts == 1) {
2739     ierr = PetscMemzero(assignment, nvtxs * sizeof(PetscInt));
2740   } else {
2741     if (vtxdist[1] == vtxdist[nparts]) {
2742       if (!rank) {
2743         PetscStackPush("METIS_PartGraphKway");
2744         ierr = METIS_PartGraphKway(&nvtxs, &ncon, xadj, adjncy, vwgt, NULL, adjwgt, &nparts, tpwgts, ubvec, NULL, &edgeCut, assignment);
2745         PetscStackPop;
2746         if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in METIS_PartGraphKway()");
2747       }
2748     } else {
2749       PetscStackPush("ParMETIS_V3_PartKway");
2750       ierr = ParMETIS_V3_PartKway(vtxdist, xadj, adjncy, vwgt, adjwgt, &wgtflag, &numflag, &ncon, &nparts, tpwgts, ubvec, options, &edgeCut, assignment, &comm);
2751       PetscStackPop;
2752       if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in ParMETIS_V3_PartKway()");
2753     }
2754   }
2755   /* Convert to PetscSection+IS */
2756   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2757   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2758   for (v = 0; v < nvtxs; ++v) {
2759     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2760   }
2761   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2762   ierr = PetscMalloc1(nvtxs, &points);CHKERRQ(ierr);
2763   for (p = 0, i = 0; p < commSize; ++p) {
2764     for (v = 0; v < nvtxs; ++v) {
2765       if (assignment[v] == p) points[i++] = v;
2766     }
2767   }
2768   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2769   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2770   ierr = PetscFree4(vtxdist,tpwgts,ubvec,assignment);CHKERRQ(ierr);
2771   PetscFunctionReturn(0);
2772 }
2773 #endif
2774 
2775 #undef __FUNCT__
2776 #define __FUNCT__ "DMPlexEnlargePartition"
2777 /* Expand the partition by BFS on the adjacency graph */
2778 PetscErrorCode DMPlexEnlargePartition(DM dm, const PetscInt start[], const PetscInt adjacency[], PetscSection origPartSection, IS origPartition, PetscSection *partSection, IS *partition)
2779 {
2780   PetscHashI      h;
2781   const PetscInt *points;
2782   PetscInt      **tmpPoints, *newPoints, totPoints = 0;
2783   PetscInt        pStart, pEnd, part, q;
2784   PetscErrorCode  ierr;
2785 
2786   PetscFunctionBegin;
2787   PetscHashICreate(h);
2788   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2789   ierr = PetscSectionGetChart(origPartSection, &pStart, &pEnd);CHKERRQ(ierr);
2790   ierr = PetscSectionSetChart(*partSection, pStart, pEnd);CHKERRQ(ierr);
2791   ierr = ISGetIndices(origPartition, &points);CHKERRQ(ierr);
2792   ierr = PetscMalloc1((pEnd - pStart), &tmpPoints);CHKERRQ(ierr);
2793   for (part = pStart; part < pEnd; ++part) {
2794     PetscInt numPoints, nP, numNewPoints, off, p, n = 0;
2795 
2796     PetscHashIClear(h);
2797     ierr = PetscSectionGetDof(origPartSection, part, &numPoints);CHKERRQ(ierr);
2798     ierr = PetscSectionGetOffset(origPartSection, part, &off);CHKERRQ(ierr);
2799     /* Add all existing points to h */
2800     for (p = 0; p < numPoints; ++p) {
2801       const PetscInt point = points[off+p];
2802       PetscHashIAdd(h, point, 1);
2803     }
2804     PetscHashISize(h, nP);
2805     if (nP != numPoints) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid partition has %d points, but only %d were unique", numPoints, nP);
2806     /* Add all points in next BFS level */
2807     /*   TODO We are brute forcing here, but could check the adjacency size to find the boundary */
2808     for (p = 0; p < numPoints; ++p) {
2809       const PetscInt point = points[off+p];
2810       PetscInt       s     = start[point], e = start[point+1], a;
2811 
2812       for (a = s; a < e; ++a) PetscHashIAdd(h, adjacency[a], 1);
2813     }
2814     PetscHashISize(h, numNewPoints);
2815     ierr = PetscSectionSetDof(*partSection, part, numNewPoints);CHKERRQ(ierr);
2816     ierr = PetscMalloc1(numNewPoints, &tmpPoints[part]);CHKERRQ(ierr);
2817     ierr =  PetscHashIGetKeys(h, &n, tmpPoints[part]);CHKERRQ(ierr);
2818     totPoints += numNewPoints;
2819   }
2820   ierr = ISRestoreIndices(origPartition, &points);CHKERRQ(ierr);
2821   PetscHashIDestroy(h);
2822   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2823   ierr = PetscMalloc1(totPoints, &newPoints);CHKERRQ(ierr);
2824   for (part = pStart, q = 0; part < pEnd; ++part) {
2825     PetscInt numPoints, p;
2826 
2827     ierr = PetscSectionGetDof(*partSection, part, &numPoints);CHKERRQ(ierr);
2828     for (p = 0; p < numPoints; ++p, ++q) newPoints[q] = tmpPoints[part][p];
2829     ierr = PetscFree(tmpPoints[part]);CHKERRQ(ierr);
2830   }
2831   ierr = PetscFree(tmpPoints);CHKERRQ(ierr);
2832   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), totPoints, newPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2833   PetscFunctionReturn(0);
2834 }
2835 
2836 #undef __FUNCT__
2837 #define __FUNCT__ "DMPlexCreatePartition"
2838 /*
2839   DMPlexCreatePartition - Create a non-overlapping partition of the points at the given height
2840 
2841   Collective on DM
2842 
2843   Input Parameters:
2844   + dm - The DM
2845   . height - The height for points in the partition
2846   - enlarge - Expand each partition with neighbors
2847 
2848   Output Parameters:
2849   + partSection - The PetscSection giving the division of points by partition
2850   . partition - The list of points by partition
2851   . origPartSection - If enlarge is true, the PetscSection giving the division of points before enlarging by partition, otherwise NULL
2852   - origPartition - If enlarge is true, the list of points before enlarging by partition, otherwise NULL
2853 
2854   Level: developer
2855 
2856 .seealso DMPlexDistribute()
2857 */
2858 PetscErrorCode DMPlexCreatePartition(DM dm, const char name[], PetscInt height, PetscBool enlarge, PetscSection *partSection, IS *partition, PetscSection *origPartSection, IS *origPartition)
2859 {
2860   char           partname[1024];
2861   PetscBool      isChaco = PETSC_FALSE, isMetis = PETSC_FALSE, flg;
2862   PetscMPIInt    size;
2863   PetscErrorCode ierr;
2864 
2865   PetscFunctionBegin;
2866   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
2867 
2868   *origPartSection = NULL;
2869   *origPartition   = NULL;
2870   if (size == 1) {
2871     PetscInt *points;
2872     PetscInt  cStart, cEnd, c;
2873 
2874     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2875     ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2876     ierr = PetscSectionSetChart(*partSection, 0, size);CHKERRQ(ierr);
2877     ierr = PetscSectionSetDof(*partSection, 0, cEnd-cStart);CHKERRQ(ierr);
2878     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2879     ierr = PetscMalloc1((cEnd - cStart), &points);CHKERRQ(ierr);
2880     for (c = cStart; c < cEnd; ++c) points[c] = c;
2881     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), cEnd-cStart, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2882     PetscFunctionReturn(0);
2883   }
2884   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_partitioner", partname, 1024, &flg);CHKERRQ(ierr);
2885   if (flg) name = partname;
2886   if (name) {
2887     ierr = PetscStrcmp(name, "chaco", &isChaco);CHKERRQ(ierr);
2888     ierr = PetscStrcmp(name, "metis", &isMetis);CHKERRQ(ierr);
2889   }
2890   if (height == 0) {
2891     PetscInt  numVertices;
2892     PetscInt *start     = NULL;
2893     PetscInt *adjacency = NULL;
2894 
2895     ierr = DMPlexCreateNeighborCSR(dm, 0, &numVertices, &start, &adjacency);CHKERRQ(ierr);
2896     if (!name || isChaco) {
2897 #if defined(PETSC_HAVE_CHACO)
2898       ierr = DMPlexPartition_Chaco(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2899 #else
2900       SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Mesh partitioning needs external package support.\nPlease reconfigure with --download-chaco.");
2901 #endif
2902     } else if (isMetis) {
2903 #if defined(PETSC_HAVE_PARMETIS)
2904       ierr = DMPlexPartition_ParMetis(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2905 #endif
2906     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Unknown mesh partitioning package %s", name);
2907     if (enlarge) {
2908       *origPartSection = *partSection;
2909       *origPartition   = *partition;
2910 
2911       ierr = DMPlexEnlargePartition(dm, start, adjacency, *origPartSection, *origPartition, partSection, partition);CHKERRQ(ierr);
2912     }
2913     ierr = PetscFree(start);CHKERRQ(ierr);
2914     ierr = PetscFree(adjacency);CHKERRQ(ierr);
2915 # if 0
2916   } else if (height == 1) {
2917     /* Build the dual graph for faces and partition the hypergraph */
2918     PetscInt numEdges;
2919 
2920     buildFaceCSRV(mesh, mesh->getFactory()->getNumbering(mesh, mesh->depth()-1), &numEdges, &start, &adjacency, GraphPartitioner::zeroBase());
2921     GraphPartitioner().partition(numEdges, start, adjacency, partition, manager);
2922     destroyCSR(numEdges, start, adjacency);
2923 #endif
2924   } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid partition height %D", height);
2925   PetscFunctionReturn(0);
2926 }
2927 
2928 #undef __FUNCT__
2929 #define __FUNCT__ "DMPlexCreatePartitionClosure"
2930 PetscErrorCode DMPlexCreatePartitionClosure(DM dm, PetscSection pointSection, IS pointPartition, PetscSection *section, IS *partition)
2931 {
2932   /* const PetscInt  height = 0; */
2933   const PetscInt *partArray;
2934   PetscInt       *allPoints, *packPoints;
2935   PetscInt        rStart, rEnd, rank, pStart, pEnd, newSize;
2936   PetscErrorCode  ierr;
2937   PetscBT         bt;
2938   PetscSegBuffer  segpack,segpart;
2939 
2940   PetscFunctionBegin;
2941   ierr = PetscSectionGetChart(pointSection, &rStart, &rEnd);CHKERRQ(ierr);
2942   ierr = ISGetIndices(pointPartition, &partArray);CHKERRQ(ierr);
2943   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2944   ierr = PetscSectionSetChart(*section, rStart, rEnd);CHKERRQ(ierr);
2945   ierr = DMPlexGetChart(dm,&pStart,&pEnd);CHKERRQ(ierr);
2946   ierr = PetscBTCreate(pEnd-pStart,&bt);CHKERRQ(ierr);
2947   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpack);CHKERRQ(ierr);
2948   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpart);CHKERRQ(ierr);
2949   for (rank = rStart; rank < rEnd; ++rank) {
2950     PetscInt partSize = 0, numPoints, offset, p, *PETSC_RESTRICT placePoints;
2951 
2952     ierr = PetscSectionGetDof(pointSection, rank, &numPoints);CHKERRQ(ierr);
2953     ierr = PetscSectionGetOffset(pointSection, rank, &offset);CHKERRQ(ierr);
2954     for (p = 0; p < numPoints; ++p) {
2955       PetscInt  point   = partArray[offset+p], closureSize, c;
2956       PetscInt *closure = NULL;
2957 
2958       /* TODO Include support for height > 0 case */
2959       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2960       for (c=0; c<closureSize; c++) {
2961         PetscInt cpoint = closure[c*2];
2962         if (!PetscBTLookupSet(bt,cpoint-pStart)) {
2963           PetscInt *PETSC_RESTRICT pt;
2964           partSize++;
2965           ierr = PetscSegBufferGetInts(segpart,1,&pt);CHKERRQ(ierr);
2966           *pt = cpoint;
2967         }
2968       }
2969       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2970     }
2971     ierr = PetscSectionSetDof(*section, rank, partSize);CHKERRQ(ierr);
2972     ierr = PetscSegBufferGetInts(segpack,partSize,&placePoints);CHKERRQ(ierr);
2973     ierr = PetscSegBufferExtractTo(segpart,placePoints);CHKERRQ(ierr);
2974     ierr = PetscSortInt(partSize,placePoints);CHKERRQ(ierr);
2975     for (p=0; p<partSize; p++) {ierr = PetscBTClear(bt,placePoints[p]-pStart);CHKERRQ(ierr);}
2976   }
2977   ierr = PetscBTDestroy(&bt);CHKERRQ(ierr);
2978   ierr = PetscSegBufferDestroy(&segpart);CHKERRQ(ierr);
2979 
2980   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
2981   ierr = PetscSectionGetStorageSize(*section, &newSize);CHKERRQ(ierr);
2982   ierr = PetscMalloc1(newSize, &allPoints);CHKERRQ(ierr);
2983 
2984   ierr = PetscSegBufferExtractInPlace(segpack,&packPoints);CHKERRQ(ierr);
2985   for (rank = rStart; rank < rEnd; ++rank) {
2986     PetscInt numPoints, offset;
2987 
2988     ierr = PetscSectionGetDof(*section, rank, &numPoints);CHKERRQ(ierr);
2989     ierr = PetscSectionGetOffset(*section, rank, &offset);CHKERRQ(ierr);
2990     ierr = PetscMemcpy(&allPoints[offset], packPoints, numPoints * sizeof(PetscInt));CHKERRQ(ierr);
2991     packPoints += numPoints;
2992   }
2993 
2994   ierr = PetscSegBufferDestroy(&segpack);CHKERRQ(ierr);
2995   ierr = ISRestoreIndices(pointPartition, &partArray);CHKERRQ(ierr);
2996   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), newSize, allPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2997   PetscFunctionReturn(0);
2998 }
2999 
3000 #undef __FUNCT__
3001 #define __FUNCT__ "DMPlexDistributeField"
3002 /*@
3003   DMPlexDistributeField - Distribute field data to match a given PetscSF, usually the SF from mesh distribution
3004 
3005   Collective on DM
3006 
3007   Input Parameters:
3008 + dm - The DMPlex object
3009 . pointSF - The PetscSF describing the communication pattern
3010 . originalSection - The PetscSection for existing data layout
3011 - originalVec - The existing data
3012 
3013   Output Parameters:
3014 + newSection - The PetscSF describing the new data layout
3015 - newVec - The new data
3016 
3017   Level: developer
3018 
3019 .seealso: DMPlexDistribute(), DMPlexDistributeData()
3020 @*/
3021 PetscErrorCode DMPlexDistributeField(DM dm, PetscSF pointSF, PetscSection originalSection, Vec originalVec, PetscSection newSection, Vec newVec)
3022 {
3023   PetscSF        fieldSF;
3024   PetscInt      *remoteOffsets, fieldSize;
3025   PetscScalar   *originalValues, *newValues;
3026   PetscErrorCode ierr;
3027 
3028   PetscFunctionBegin;
3029   ierr = PetscLogEventBegin(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
3030   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
3031 
3032   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
3033   ierr = VecSetSizes(newVec, fieldSize, PETSC_DETERMINE);CHKERRQ(ierr);
3034   ierr = VecSetType(newVec,dm->vectype);CHKERRQ(ierr);
3035 
3036   ierr = VecGetArray(originalVec, &originalValues);CHKERRQ(ierr);
3037   ierr = VecGetArray(newVec, &newValues);CHKERRQ(ierr);
3038   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
3039   ierr = PetscSFBcastBegin(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3040   ierr = PetscSFBcastEnd(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3041   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
3042   ierr = VecRestoreArray(newVec, &newValues);CHKERRQ(ierr);
3043   ierr = VecRestoreArray(originalVec, &originalValues);CHKERRQ(ierr);
3044   ierr = PetscLogEventEnd(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
3045   PetscFunctionReturn(0);
3046 }
3047 
3048 #undef __FUNCT__
3049 #define __FUNCT__ "DMPlexDistributeData"
3050 /*@
3051   DMPlexDistributeData - Distribute field data to match a given PetscSF, usually the SF from mesh distribution
3052 
3053   Collective on DM
3054 
3055   Input Parameters:
3056 + dm - The DMPlex object
3057 . pointSF - The PetscSF describing the communication pattern
3058 . originalSection - The PetscSection for existing data layout
3059 . datatype - The type of data
3060 - originalData - The existing data
3061 
3062   Output Parameters:
3063 + newSection - The PetscSF describing the new data layout
3064 - newData - The new data
3065 
3066   Level: developer
3067 
3068 .seealso: DMPlexDistribute(), DMPlexDistributeField()
3069 @*/
3070 PetscErrorCode DMPlexDistributeData(DM dm, PetscSF pointSF, PetscSection originalSection, MPI_Datatype datatype, void *originalData, PetscSection newSection, void **newData)
3071 {
3072   PetscSF        fieldSF;
3073   PetscInt      *remoteOffsets, fieldSize;
3074   PetscMPIInt    dataSize;
3075   PetscErrorCode ierr;
3076 
3077   PetscFunctionBegin;
3078   ierr = PetscLogEventBegin(DMPLEX_DistributeData,dm,0,0,0);CHKERRQ(ierr);
3079   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
3080 
3081   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
3082   ierr = MPI_Type_size(datatype, &dataSize);CHKERRQ(ierr);
3083   ierr = PetscMalloc(fieldSize * dataSize, newData);CHKERRQ(ierr);
3084 
3085   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
3086   ierr = PetscSFBcastBegin(fieldSF, datatype, originalData, *newData);CHKERRQ(ierr);
3087   ierr = PetscSFBcastEnd(fieldSF, datatype, originalData, *newData);CHKERRQ(ierr);
3088   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
3089   ierr = PetscLogEventEnd(DMPLEX_DistributeData,dm,0,0,0);CHKERRQ(ierr);
3090   PetscFunctionReturn(0);
3091 }
3092 
3093 #undef __FUNCT__
3094 #define __FUNCT__ "DMPlexDistribute"
3095 /*@C
3096   DMPlexDistribute - Distributes the mesh and any associated sections.
3097 
3098   Not Collective
3099 
3100   Input Parameter:
3101 + dm  - The original DMPlex object
3102 . partitioner - The partitioning package, or NULL for the default
3103 - overlap - The overlap of partitions, 0 is the default
3104 
3105   Output Parameter:
3106 + sf - The PetscSF used for point distribution
3107 - parallelMesh - The distributed DMPlex object, or NULL
3108 
3109   Note: If the mesh was not distributed, the return value is NULL
3110 
3111   Level: intermediate
3112 
3113 .keywords: mesh, elements
3114 .seealso: DMPlexCreate(), DMPlexDistributeByFace()
3115 @*/
3116 PetscErrorCode DMPlexDistribute(DM dm, const char partitioner[], PetscInt overlap, PetscSF *sf, DM *dmParallel)
3117 {
3118   DM_Plex               *mesh   = (DM_Plex*) dm->data, *pmesh;
3119   MPI_Comm               comm;
3120   const PetscInt         height = 0;
3121   PetscInt               dim, numRemoteRanks;
3122   IS                     origCellPart,        origPart,        cellPart,        part;
3123   PetscSection           origCellPartSection, origPartSection, cellPartSection, partSection;
3124   PetscSFNode           *remoteRanks;
3125   PetscSF                partSF, pointSF, coneSF;
3126   ISLocalToGlobalMapping renumbering;
3127   PetscSection           originalConeSection, newConeSection;
3128   PetscInt              *remoteOffsets;
3129   PetscInt              *cones, *newCones, newConesSize;
3130   PetscBool              flg;
3131   PetscMPIInt            rank, numProcs, p;
3132   PetscErrorCode         ierr;
3133 
3134   PetscFunctionBegin;
3135   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3136   if (sf) PetscValidPointer(sf,4);
3137   PetscValidPointer(dmParallel,5);
3138 
3139   ierr = PetscLogEventBegin(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3140   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3141   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3142   ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
3143 
3144   *dmParallel = NULL;
3145   if (numProcs == 1) PetscFunctionReturn(0);
3146 
3147   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
3148   /* Create cell partition - We need to rewrite to use IS, use the MatPartition stuff */
3149   ierr = PetscLogEventBegin(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
3150   if (overlap > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Overlap > 1 not yet implemented");
3151   ierr = DMPlexCreatePartition(dm, partitioner, height, overlap > 0 ? PETSC_TRUE : PETSC_FALSE, &cellPartSection, &cellPart, &origCellPartSection, &origCellPart);CHKERRQ(ierr);
3152   /* Create SF assuming a serial partition for all processes: Could check for IS length here */
3153   if (!rank) numRemoteRanks = numProcs;
3154   else       numRemoteRanks = 0;
3155   ierr = PetscMalloc1(numRemoteRanks, &remoteRanks);CHKERRQ(ierr);
3156   for (p = 0; p < numRemoteRanks; ++p) {
3157     remoteRanks[p].rank  = p;
3158     remoteRanks[p].index = 0;
3159   }
3160   ierr = PetscSFCreate(comm, &partSF);CHKERRQ(ierr);
3161   ierr = PetscSFSetGraph(partSF, 1, numRemoteRanks, NULL, PETSC_OWN_POINTER, remoteRanks, PETSC_OWN_POINTER);CHKERRQ(ierr);
3162   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-partition_view", &flg);CHKERRQ(ierr);
3163   if (flg) {
3164     ierr = PetscPrintf(comm, "Cell Partition:\n");CHKERRQ(ierr);
3165     ierr = PetscSectionView(cellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3166     ierr = ISView(cellPart, NULL);CHKERRQ(ierr);
3167     if (origCellPart) {
3168       ierr = PetscPrintf(comm, "Original Cell Partition:\n");CHKERRQ(ierr);
3169       ierr = PetscSectionView(origCellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3170       ierr = ISView(origCellPart, NULL);CHKERRQ(ierr);
3171     }
3172     ierr = PetscSFView(partSF, NULL);CHKERRQ(ierr);
3173   }
3174   /* Close the partition over the mesh */
3175   ierr = DMPlexCreatePartitionClosure(dm, cellPartSection, cellPart, &partSection, &part);CHKERRQ(ierr);
3176   ierr = ISDestroy(&cellPart);CHKERRQ(ierr);
3177   ierr = PetscSectionDestroy(&cellPartSection);CHKERRQ(ierr);
3178   /* Create new mesh */
3179   ierr  = DMPlexCreate(comm, dmParallel);CHKERRQ(ierr);
3180   ierr  = DMPlexSetDimension(*dmParallel, dim);CHKERRQ(ierr);
3181   ierr  = PetscObjectSetName((PetscObject) *dmParallel, "Parallel Mesh");CHKERRQ(ierr);
3182   pmesh = (DM_Plex*) (*dmParallel)->data;
3183   /* Distribute sieve points and the global point numbering (replaces creating remote bases) */
3184   ierr = PetscSFConvertPartition(partSF, partSection, part, &renumbering, &pointSF);CHKERRQ(ierr);
3185   if (flg) {
3186     ierr = PetscPrintf(comm, "Point Partition:\n");CHKERRQ(ierr);
3187     ierr = PetscSectionView(partSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3188     ierr = ISView(part, NULL);CHKERRQ(ierr);
3189     ierr = PetscSFView(pointSF, NULL);CHKERRQ(ierr);
3190     ierr = PetscPrintf(comm, "Point Renumbering after partition:\n");CHKERRQ(ierr);
3191     ierr = ISLocalToGlobalMappingView(renumbering, NULL);CHKERRQ(ierr);
3192   }
3193   ierr = PetscLogEventEnd(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
3194   ierr = PetscLogEventBegin(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr);
3195   /* Distribute cone section */
3196   ierr = DMPlexGetConeSection(dm, &originalConeSection);CHKERRQ(ierr);
3197   ierr = DMPlexGetConeSection(*dmParallel, &newConeSection);CHKERRQ(ierr);
3198   ierr = PetscSFDistributeSection(pointSF, originalConeSection, &remoteOffsets, newConeSection);CHKERRQ(ierr);
3199   ierr = DMSetUp(*dmParallel);CHKERRQ(ierr);
3200   {
3201     PetscInt pStart, pEnd, p;
3202 
3203     ierr = PetscSectionGetChart(newConeSection, &pStart, &pEnd);CHKERRQ(ierr);
3204     for (p = pStart; p < pEnd; ++p) {
3205       PetscInt coneSize;
3206       ierr               = PetscSectionGetDof(newConeSection, p, &coneSize);CHKERRQ(ierr);
3207       pmesh->maxConeSize = PetscMax(pmesh->maxConeSize, coneSize);
3208     }
3209   }
3210   /* Communicate and renumber cones */
3211   ierr = PetscSFCreateSectionSF(pointSF, originalConeSection, remoteOffsets, newConeSection, &coneSF);CHKERRQ(ierr);
3212   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
3213   ierr = DMPlexGetCones(*dmParallel, &newCones);CHKERRQ(ierr);
3214   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3215   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3216   ierr = PetscSectionGetStorageSize(newConeSection, &newConesSize);CHKERRQ(ierr);
3217   ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newConesSize, newCones, NULL, newCones);CHKERRQ(ierr);
3218   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-cones_view", &flg);CHKERRQ(ierr);
3219   if (flg) {
3220     ierr = PetscPrintf(comm, "Serial Cone Section:\n");CHKERRQ(ierr);
3221     ierr = PetscSectionView(originalConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3222     ierr = PetscPrintf(comm, "Parallel Cone Section:\n");CHKERRQ(ierr);
3223     ierr = PetscSectionView(newConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3224     ierr = PetscSFView(coneSF, NULL);CHKERRQ(ierr);
3225   }
3226   ierr = DMPlexGetConeOrientations(dm, &cones);CHKERRQ(ierr);
3227   ierr = DMPlexGetConeOrientations(*dmParallel, &newCones);CHKERRQ(ierr);
3228   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3229   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3230   ierr = PetscSFDestroy(&coneSF);CHKERRQ(ierr);
3231   ierr = PetscLogEventEnd(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr);
3232   /* Create supports and stratify sieve */
3233   {
3234     PetscInt pStart, pEnd;
3235 
3236     ierr = PetscSectionGetChart(pmesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
3237     ierr = PetscSectionSetChart(pmesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
3238   }
3239   ierr = DMPlexSymmetrize(*dmParallel);CHKERRQ(ierr);
3240   ierr = DMPlexStratify(*dmParallel);CHKERRQ(ierr);
3241   /* Distribute Coordinates */
3242   {
3243     PetscSection originalCoordSection, newCoordSection;
3244     Vec          originalCoordinates, newCoordinates;
3245     const char  *name;
3246 
3247     ierr = DMGetCoordinateSection(dm, &originalCoordSection);CHKERRQ(ierr);
3248     ierr = DMGetCoordinateSection(*dmParallel, &newCoordSection);CHKERRQ(ierr);
3249     ierr = DMGetCoordinatesLocal(dm, &originalCoordinates);CHKERRQ(ierr);
3250     ierr = VecCreate(comm, &newCoordinates);CHKERRQ(ierr);
3251     ierr = PetscObjectGetName((PetscObject) originalCoordinates, &name);CHKERRQ(ierr);
3252     ierr = PetscObjectSetName((PetscObject) newCoordinates, name);CHKERRQ(ierr);
3253 
3254     ierr = DMPlexDistributeField(dm, pointSF, originalCoordSection, originalCoordinates, newCoordSection, newCoordinates);CHKERRQ(ierr);
3255     ierr = DMSetCoordinatesLocal(*dmParallel, newCoordinates);CHKERRQ(ierr);
3256     ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr);
3257   }
3258   /* Distribute labels */
3259   ierr = PetscLogEventBegin(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
3260   {
3261     DMLabel  next      = mesh->labels, newNext = pmesh->labels;
3262     PetscInt numLabels = 0, l;
3263 
3264     /* Bcast number of labels */
3265     while (next) {++numLabels; next = next->next;}
3266     ierr = MPI_Bcast(&numLabels, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3267     next = mesh->labels;
3268     for (l = 0; l < numLabels; ++l) {
3269       DMLabel   labelNew;
3270       PetscBool isdepth;
3271 
3272       /* Skip "depth" because it is recreated */
3273       if (!rank) {ierr = PetscStrcmp(next->name, "depth", &isdepth);CHKERRQ(ierr);}
3274       ierr = MPI_Bcast(&isdepth, 1, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
3275       if (isdepth) {if (!rank) next = next->next; continue;}
3276       ierr = DMLabelDistribute(next, partSection, part, renumbering, &labelNew);CHKERRQ(ierr);
3277       /* Insert into list */
3278       if (newNext) newNext->next = labelNew;
3279       else         pmesh->labels = labelNew;
3280       newNext = labelNew;
3281       if (!rank) next = next->next;
3282     }
3283   }
3284   ierr = PetscLogEventEnd(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
3285   /* Setup hybrid structure */
3286   {
3287     const PetscInt *gpoints;
3288     PetscInt        depth, n, d;
3289 
3290     for (d = 0; d <= dim; ++d) {pmesh->hybridPointMax[d] = mesh->hybridPointMax[d];}
3291     ierr = MPI_Bcast(pmesh->hybridPointMax, dim+1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3292     ierr = ISLocalToGlobalMappingGetSize(renumbering, &n);CHKERRQ(ierr);
3293     ierr = ISLocalToGlobalMappingGetIndices(renumbering, &gpoints);CHKERRQ(ierr);
3294     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3295     for (d = 0; d <= dim; ++d) {
3296       PetscInt pmax = pmesh->hybridPointMax[d], newmax = 0, pEnd, stratum[2], p;
3297 
3298       if (pmax < 0) continue;
3299       ierr = DMPlexGetDepthStratum(dm, d > depth ? depth : d, &stratum[0], &stratum[1]);CHKERRQ(ierr);
3300       ierr = DMPlexGetDepthStratum(*dmParallel, d, NULL, &pEnd);CHKERRQ(ierr);
3301       ierr = MPI_Bcast(stratum, 2, MPIU_INT, 0, comm);CHKERRQ(ierr);
3302       for (p = 0; p < n; ++p) {
3303         const PetscInt point = gpoints[p];
3304 
3305         if ((point >= stratum[0]) && (point < stratum[1]) && (point >= pmax)) ++newmax;
3306       }
3307       if (newmax > 0) pmesh->hybridPointMax[d] = pEnd - newmax;
3308       else            pmesh->hybridPointMax[d] = -1;
3309     }
3310     ierr = ISLocalToGlobalMappingRestoreIndices(renumbering, &gpoints);CHKERRQ(ierr);
3311   }
3312   /* Cleanup Partition */
3313   ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr);
3314   ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr);
3315   ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr);
3316   ierr = ISDestroy(&part);CHKERRQ(ierr);
3317   /* Create point SF for parallel mesh */
3318   ierr = PetscLogEventBegin(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3319   {
3320     const PetscInt *leaves;
3321     PetscSFNode    *remotePoints, *rowners, *lowners;
3322     PetscInt        numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints;
3323     PetscInt        pStart, pEnd;
3324 
3325     ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr);
3326     ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr);
3327     ierr = PetscMalloc2(numRoots,&rowners,numLeaves,&lowners);CHKERRQ(ierr);
3328     for (p=0; p<numRoots; p++) {
3329       rowners[p].rank  = -1;
3330       rowners[p].index = -1;
3331     }
3332     if (origCellPart) {
3333       /* Make sure points in the original partition are not assigned to other procs */
3334       const PetscInt *origPoints;
3335 
3336       ierr = DMPlexCreatePartitionClosure(dm, origCellPartSection, origCellPart, &origPartSection, &origPart);CHKERRQ(ierr);
3337       ierr = ISGetIndices(origPart, &origPoints);CHKERRQ(ierr);
3338       for (p = 0; p < numProcs; ++p) {
3339         PetscInt dof, off, d;
3340 
3341         ierr = PetscSectionGetDof(origPartSection, p, &dof);CHKERRQ(ierr);
3342         ierr = PetscSectionGetOffset(origPartSection, p, &off);CHKERRQ(ierr);
3343         for (d = off; d < off+dof; ++d) {
3344           rowners[origPoints[d]].rank = p;
3345         }
3346       }
3347       ierr = ISRestoreIndices(origPart, &origPoints);CHKERRQ(ierr);
3348       ierr = ISDestroy(&origPart);CHKERRQ(ierr);
3349       ierr = PetscSectionDestroy(&origPartSection);CHKERRQ(ierr);
3350     }
3351     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3352     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3353 
3354     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3355     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3356     for (p = 0; p < numLeaves; ++p) {
3357       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3358         lowners[p].rank  = rank;
3359         lowners[p].index = leaves ? leaves[p] : p;
3360       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3361         lowners[p].rank  = -2;
3362         lowners[p].index = -2;
3363       }
3364     }
3365     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3366       rowners[p].rank  = -3;
3367       rowners[p].index = -3;
3368     }
3369     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3370     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3371     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3372     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3373     for (p = 0; p < numLeaves; ++p) {
3374       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3375       if (lowners[p].rank != rank) ++numGhostPoints;
3376     }
3377     ierr = PetscMalloc1(numGhostPoints,    &ghostPoints);CHKERRQ(ierr);
3378     ierr = PetscMalloc1(numGhostPoints, &remotePoints);CHKERRQ(ierr);
3379     for (p = 0, gp = 0; p < numLeaves; ++p) {
3380       if (lowners[p].rank != rank) {
3381         ghostPoints[gp]        = leaves ? leaves[p] : p;
3382         remotePoints[gp].rank  = lowners[p].rank;
3383         remotePoints[gp].index = lowners[p].index;
3384         ++gp;
3385       }
3386     }
3387     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3388     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3389     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3390   }
3391   ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3392   /* Cleanup */
3393   if (sf) {*sf = pointSF;}
3394   else    {ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);}
3395   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3396   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3397   PetscFunctionReturn(0);
3398 }
3399 
3400 #undef __FUNCT__
3401 #define __FUNCT__ "DMPlexInvertCell"
3402 /*@C
3403   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3404 
3405   Input Parameters:
3406 + numCorners - The number of vertices in a cell
3407 - cone - The incoming cone
3408 
3409   Output Parameter:
3410 . cone - The inverted cone (in-place)
3411 
3412   Level: developer
3413 
3414 .seealso: DMPlexGenerate()
3415 @*/
3416 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3417 {
3418   int tmpc;
3419 
3420   PetscFunctionBegin;
3421   if (dim != 3) PetscFunctionReturn(0);
3422   switch (numCorners) {
3423   case 4:
3424     tmpc    = cone[0];
3425     cone[0] = cone[1];
3426     cone[1] = tmpc;
3427     break;
3428   case 8:
3429     tmpc    = cone[1];
3430     cone[1] = cone[3];
3431     cone[3] = tmpc;
3432     break;
3433   default: break;
3434   }
3435   PetscFunctionReturn(0);
3436 }
3437 
3438 #undef __FUNCT__
3439 #define __FUNCT__ "DMPlexInvertCells_Internal"
3440 /* This is to fix the tetrahedron orientation from TetGen */
3441 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3442 {
3443   PetscInt       bound = numCells*numCorners, coff;
3444   PetscErrorCode ierr;
3445 
3446   PetscFunctionBegin;
3447   for (coff = 0; coff < bound; coff += numCorners) {
3448     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3449   }
3450   PetscFunctionReturn(0);
3451 }
3452 
3453 #if defined(PETSC_HAVE_TRIANGLE)
3454 #include <triangle.h>
3455 
3456 #undef __FUNCT__
3457 #define __FUNCT__ "InitInput_Triangle"
3458 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3459 {
3460   PetscFunctionBegin;
3461   inputCtx->numberofpoints             = 0;
3462   inputCtx->numberofpointattributes    = 0;
3463   inputCtx->pointlist                  = NULL;
3464   inputCtx->pointattributelist         = NULL;
3465   inputCtx->pointmarkerlist            = NULL;
3466   inputCtx->numberofsegments           = 0;
3467   inputCtx->segmentlist                = NULL;
3468   inputCtx->segmentmarkerlist          = NULL;
3469   inputCtx->numberoftriangleattributes = 0;
3470   inputCtx->trianglelist               = NULL;
3471   inputCtx->numberofholes              = 0;
3472   inputCtx->holelist                   = NULL;
3473   inputCtx->numberofregions            = 0;
3474   inputCtx->regionlist                 = NULL;
3475   PetscFunctionReturn(0);
3476 }
3477 
3478 #undef __FUNCT__
3479 #define __FUNCT__ "InitOutput_Triangle"
3480 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3481 {
3482   PetscFunctionBegin;
3483   outputCtx->numberofpoints        = 0;
3484   outputCtx->pointlist             = NULL;
3485   outputCtx->pointattributelist    = NULL;
3486   outputCtx->pointmarkerlist       = NULL;
3487   outputCtx->numberoftriangles     = 0;
3488   outputCtx->trianglelist          = NULL;
3489   outputCtx->triangleattributelist = NULL;
3490   outputCtx->neighborlist          = NULL;
3491   outputCtx->segmentlist           = NULL;
3492   outputCtx->segmentmarkerlist     = NULL;
3493   outputCtx->numberofedges         = 0;
3494   outputCtx->edgelist              = NULL;
3495   outputCtx->edgemarkerlist        = NULL;
3496   PetscFunctionReturn(0);
3497 }
3498 
3499 #undef __FUNCT__
3500 #define __FUNCT__ "FiniOutput_Triangle"
3501 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3502 {
3503   PetscFunctionBegin;
3504   free(outputCtx->pointlist);
3505   free(outputCtx->pointmarkerlist);
3506   free(outputCtx->segmentlist);
3507   free(outputCtx->segmentmarkerlist);
3508   free(outputCtx->edgelist);
3509   free(outputCtx->edgemarkerlist);
3510   free(outputCtx->trianglelist);
3511   free(outputCtx->neighborlist);
3512   PetscFunctionReturn(0);
3513 }
3514 
3515 #undef __FUNCT__
3516 #define __FUNCT__ "DMPlexGenerate_Triangle"
3517 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3518 {
3519   MPI_Comm             comm;
3520   PetscInt             dim              = 2;
3521   const PetscBool      createConvexHull = PETSC_FALSE;
3522   const PetscBool      constrained      = PETSC_FALSE;
3523   struct triangulateio in;
3524   struct triangulateio out;
3525   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3526   PetscMPIInt          rank;
3527   PetscErrorCode       ierr;
3528 
3529   PetscFunctionBegin;
3530   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3531   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3532   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3533   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3534   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3535 
3536   in.numberofpoints = vEnd - vStart;
3537   if (in.numberofpoints > 0) {
3538     PetscSection coordSection;
3539     Vec          coordinates;
3540     PetscScalar *array;
3541 
3542     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3543     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3544     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3545     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3546     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3547     for (v = vStart; v < vEnd; ++v) {
3548       const PetscInt idx = v - vStart;
3549       PetscInt       off, d;
3550 
3551       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3552       for (d = 0; d < dim; ++d) {
3553         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3554       }
3555       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3556     }
3557     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3558   }
3559   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3560   in.numberofsegments = eEnd - eStart;
3561   if (in.numberofsegments > 0) {
3562     ierr = PetscMalloc1(in.numberofsegments*2, &in.segmentlist);CHKERRQ(ierr);
3563     ierr = PetscMalloc1(in.numberofsegments, &in.segmentmarkerlist);CHKERRQ(ierr);
3564     for (e = eStart; e < eEnd; ++e) {
3565       const PetscInt  idx = e - eStart;
3566       const PetscInt *cone;
3567 
3568       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3569 
3570       in.segmentlist[idx*2+0] = cone[0] - vStart;
3571       in.segmentlist[idx*2+1] = cone[1] - vStart;
3572 
3573       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3574     }
3575   }
3576 #if 0 /* Do not currently support holes */
3577   PetscReal *holeCoords;
3578   PetscInt   h, d;
3579 
3580   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3581   if (in.numberofholes > 0) {
3582     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3583     for (h = 0; h < in.numberofholes; ++h) {
3584       for (d = 0; d < dim; ++d) {
3585         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3586       }
3587     }
3588   }
3589 #endif
3590   if (!rank) {
3591     char args[32];
3592 
3593     /* Take away 'Q' for verbose output */
3594     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3595     if (createConvexHull) {
3596       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3597     }
3598     if (constrained) {
3599       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3600     }
3601     triangulate(args, &in, &out, NULL);
3602   }
3603   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3604   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3605   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3606   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3607   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3608 
3609   {
3610     const PetscInt numCorners  = 3;
3611     const PetscInt numCells    = out.numberoftriangles;
3612     const PetscInt numVertices = out.numberofpoints;
3613     const int     *cells      = out.trianglelist;
3614     const double  *meshCoords = out.pointlist;
3615 
3616     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3617     /* Set labels */
3618     for (v = 0; v < numVertices; ++v) {
3619       if (out.pointmarkerlist[v]) {
3620         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3621       }
3622     }
3623     if (interpolate) {
3624       for (e = 0; e < out.numberofedges; e++) {
3625         if (out.edgemarkerlist[e]) {
3626           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3627           const PetscInt *edges;
3628           PetscInt        numEdges;
3629 
3630           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3631           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3632           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3633           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3634         }
3635       }
3636     }
3637     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3638   }
3639 #if 0 /* Do not currently support holes */
3640   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3641 #endif
3642   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3643   PetscFunctionReturn(0);
3644 }
3645 
3646 #undef __FUNCT__
3647 #define __FUNCT__ "DMPlexRefine_Triangle"
3648 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3649 {
3650   MPI_Comm             comm;
3651   PetscInt             dim  = 2;
3652   struct triangulateio in;
3653   struct triangulateio out;
3654   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3655   PetscMPIInt          rank;
3656   PetscErrorCode       ierr;
3657 
3658   PetscFunctionBegin;
3659   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3660   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3661   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3662   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3663   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3664   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3665   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3666 
3667   in.numberofpoints = vEnd - vStart;
3668   if (in.numberofpoints > 0) {
3669     PetscSection coordSection;
3670     Vec          coordinates;
3671     PetscScalar *array;
3672 
3673     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3674     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3675     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3676     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3677     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3678     for (v = vStart; v < vEnd; ++v) {
3679       const PetscInt idx = v - vStart;
3680       PetscInt       off, d;
3681 
3682       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3683       for (d = 0; d < dim; ++d) {
3684         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3685       }
3686       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3687     }
3688     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3689   }
3690   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3691 
3692   in.numberofcorners   = 3;
3693   in.numberoftriangles = cEnd - cStart;
3694 
3695   in.trianglearealist  = (double*) maxVolumes;
3696   if (in.numberoftriangles > 0) {
3697     ierr = PetscMalloc1(in.numberoftriangles*in.numberofcorners, &in.trianglelist);CHKERRQ(ierr);
3698     for (c = cStart; c < cEnd; ++c) {
3699       const PetscInt idx      = c - cStart;
3700       PetscInt      *closure = NULL;
3701       PetscInt       closureSize;
3702 
3703       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3704       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3705       for (v = 0; v < 3; ++v) {
3706         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3707       }
3708       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3709     }
3710   }
3711   /* TODO: Segment markers are missing on input */
3712 #if 0 /* Do not currently support holes */
3713   PetscReal *holeCoords;
3714   PetscInt   h, d;
3715 
3716   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3717   if (in.numberofholes > 0) {
3718     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3719     for (h = 0; h < in.numberofholes; ++h) {
3720       for (d = 0; d < dim; ++d) {
3721         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3722       }
3723     }
3724   }
3725 #endif
3726   if (!rank) {
3727     char args[32];
3728 
3729     /* Take away 'Q' for verbose output */
3730     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3731     triangulate(args, &in, &out, NULL);
3732   }
3733   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3734   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3735   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3736   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3737   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3738 
3739   {
3740     const PetscInt numCorners  = 3;
3741     const PetscInt numCells    = out.numberoftriangles;
3742     const PetscInt numVertices = out.numberofpoints;
3743     const int     *cells      = out.trianglelist;
3744     const double  *meshCoords = out.pointlist;
3745     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3746 
3747     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3748     /* Set labels */
3749     for (v = 0; v < numVertices; ++v) {
3750       if (out.pointmarkerlist[v]) {
3751         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3752       }
3753     }
3754     if (interpolate) {
3755       PetscInt e;
3756 
3757       for (e = 0; e < out.numberofedges; e++) {
3758         if (out.edgemarkerlist[e]) {
3759           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3760           const PetscInt *edges;
3761           PetscInt        numEdges;
3762 
3763           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3764           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3765           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3766           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3767         }
3768       }
3769     }
3770     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3771   }
3772 #if 0 /* Do not currently support holes */
3773   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3774 #endif
3775   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3776   PetscFunctionReturn(0);
3777 }
3778 #endif
3779 
3780 #if defined(PETSC_HAVE_TETGEN)
3781 #include <tetgen.h>
3782 #undef __FUNCT__
3783 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3784 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3785 {
3786   MPI_Comm       comm;
3787   const PetscInt dim  = 3;
3788   ::tetgenio     in;
3789   ::tetgenio     out;
3790   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3791   PetscMPIInt    rank;
3792   PetscErrorCode ierr;
3793 
3794   PetscFunctionBegin;
3795   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3796   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3797   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3798   in.numberofpoints = vEnd - vStart;
3799   if (in.numberofpoints > 0) {
3800     PetscSection coordSection;
3801     Vec          coordinates;
3802     PetscScalar *array;
3803 
3804     in.pointlist       = new double[in.numberofpoints*dim];
3805     in.pointmarkerlist = new int[in.numberofpoints];
3806 
3807     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3808     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3809     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3810     for (v = vStart; v < vEnd; ++v) {
3811       const PetscInt idx = v - vStart;
3812       PetscInt       off, d;
3813 
3814       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3815       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3816       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3817     }
3818     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3819   }
3820   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3821 
3822   in.numberoffacets = fEnd - fStart;
3823   if (in.numberoffacets > 0) {
3824     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3825     in.facetmarkerlist = new int[in.numberoffacets];
3826     for (f = fStart; f < fEnd; ++f) {
3827       const PetscInt idx     = f - fStart;
3828       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3829 
3830       in.facetlist[idx].numberofpolygons = 1;
3831       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3832       in.facetlist[idx].numberofholes    = 0;
3833       in.facetlist[idx].holelist         = NULL;
3834 
3835       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3836       for (p = 0; p < numPoints*2; p += 2) {
3837         const PetscInt point = points[p];
3838         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3839       }
3840 
3841       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3842       poly->numberofvertices = numVertices;
3843       poly->vertexlist       = new int[poly->numberofvertices];
3844       for (v = 0; v < numVertices; ++v) {
3845         const PetscInt vIdx = points[v] - vStart;
3846         poly->vertexlist[v] = vIdx;
3847       }
3848       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3849       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3850     }
3851   }
3852   if (!rank) {
3853     char args[32];
3854 
3855     /* Take away 'Q' for verbose output */
3856     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3857     ::tetrahedralize(args, &in, &out);
3858   }
3859   {
3860     const PetscInt numCorners  = 4;
3861     const PetscInt numCells    = out.numberoftetrahedra;
3862     const PetscInt numVertices = out.numberofpoints;
3863     const double   *meshCoords = out.pointlist;
3864     int            *cells      = out.tetrahedronlist;
3865 
3866     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3867     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3868     /* Set labels */
3869     for (v = 0; v < numVertices; ++v) {
3870       if (out.pointmarkerlist[v]) {
3871         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3872       }
3873     }
3874     if (interpolate) {
3875       PetscInt e;
3876 
3877       for (e = 0; e < out.numberofedges; e++) {
3878         if (out.edgemarkerlist[e]) {
3879           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3880           const PetscInt *edges;
3881           PetscInt        numEdges;
3882 
3883           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3884           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3885           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3886           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3887         }
3888       }
3889       for (f = 0; f < out.numberoftrifaces; f++) {
3890         if (out.trifacemarkerlist[f]) {
3891           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3892           const PetscInt *faces;
3893           PetscInt        numFaces;
3894 
3895           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3896           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3897           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3898           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3899         }
3900       }
3901     }
3902     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3903   }
3904   PetscFunctionReturn(0);
3905 }
3906 
3907 #undef __FUNCT__
3908 #define __FUNCT__ "DMPlexRefine_Tetgen"
3909 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3910 {
3911   MPI_Comm       comm;
3912   const PetscInt dim  = 3;
3913   ::tetgenio     in;
3914   ::tetgenio     out;
3915   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3916   PetscMPIInt    rank;
3917   PetscErrorCode ierr;
3918 
3919   PetscFunctionBegin;
3920   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3921   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3922   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3923   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3924   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3925 
3926   in.numberofpoints = vEnd - vStart;
3927   if (in.numberofpoints > 0) {
3928     PetscSection coordSection;
3929     Vec          coordinates;
3930     PetscScalar *array;
3931 
3932     in.pointlist       = new double[in.numberofpoints*dim];
3933     in.pointmarkerlist = new int[in.numberofpoints];
3934 
3935     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3936     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3937     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3938     for (v = vStart; v < vEnd; ++v) {
3939       const PetscInt idx = v - vStart;
3940       PetscInt       off, d;
3941 
3942       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3943       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3944       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3945     }
3946     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3947   }
3948   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3949 
3950   in.numberofcorners       = 4;
3951   in.numberoftetrahedra    = cEnd - cStart;
3952   in.tetrahedronvolumelist = (double*) maxVolumes;
3953   if (in.numberoftetrahedra > 0) {
3954     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3955     for (c = cStart; c < cEnd; ++c) {
3956       const PetscInt idx      = c - cStart;
3957       PetscInt      *closure = NULL;
3958       PetscInt       closureSize;
3959 
3960       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3961       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3962       for (v = 0; v < 4; ++v) {
3963         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3964       }
3965       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3966     }
3967   }
3968   /* TODO: Put in boundary faces with markers */
3969   if (!rank) {
3970     char args[32];
3971 
3972     /* Take away 'Q' for verbose output */
3973     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3974     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3975     ::tetrahedralize(args, &in, &out);
3976   }
3977   in.tetrahedronvolumelist = NULL;
3978 
3979   {
3980     const PetscInt numCorners  = 4;
3981     const PetscInt numCells    = out.numberoftetrahedra;
3982     const PetscInt numVertices = out.numberofpoints;
3983     const double   *meshCoords = out.pointlist;
3984     int            *cells      = out.tetrahedronlist;
3985 
3986     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3987 
3988     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3989     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3990     /* Set labels */
3991     for (v = 0; v < numVertices; ++v) {
3992       if (out.pointmarkerlist[v]) {
3993         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3994       }
3995     }
3996     if (interpolate) {
3997       PetscInt e, f;
3998 
3999       for (e = 0; e < out.numberofedges; e++) {
4000         if (out.edgemarkerlist[e]) {
4001           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
4002           const PetscInt *edges;
4003           PetscInt        numEdges;
4004 
4005           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4006           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4007           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
4008           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4009         }
4010       }
4011       for (f = 0; f < out.numberoftrifaces; f++) {
4012         if (out.trifacemarkerlist[f]) {
4013           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
4014           const PetscInt *faces;
4015           PetscInt        numFaces;
4016 
4017           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4018           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4019           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
4020           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4021         }
4022       }
4023     }
4024     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4025   }
4026   PetscFunctionReturn(0);
4027 }
4028 #endif
4029 
4030 #if defined(PETSC_HAVE_CTETGEN)
4031 #include <ctetgen.h>
4032 
4033 #undef __FUNCT__
4034 #define __FUNCT__ "DMPlexGenerate_CTetgen"
4035 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
4036 {
4037   MPI_Comm       comm;
4038   const PetscInt dim  = 3;
4039   PLC           *in, *out;
4040   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
4041   PetscMPIInt    rank;
4042   PetscErrorCode ierr;
4043 
4044   PetscFunctionBegin;
4045   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
4046   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4047   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4048   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
4049   ierr = PLCCreate(&in);CHKERRQ(ierr);
4050   ierr = PLCCreate(&out);CHKERRQ(ierr);
4051 
4052   in->numberofpoints = vEnd - vStart;
4053   if (in->numberofpoints > 0) {
4054     PetscSection coordSection;
4055     Vec          coordinates;
4056     PetscScalar *array;
4057 
4058     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4059     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4060     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
4061     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
4062     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4063     for (v = vStart; v < vEnd; ++v) {
4064       const PetscInt idx = v - vStart;
4065       PetscInt       off, d, m;
4066 
4067       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4068       for (d = 0; d < dim; ++d) {
4069         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4070       }
4071       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
4072 
4073       in->pointmarkerlist[idx] = (int) m;
4074     }
4075     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4076   }
4077   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
4078 
4079   in->numberoffacets = fEnd - fStart;
4080   if (in->numberoffacets > 0) {
4081     ierr = PetscMalloc1(in->numberoffacets, &in->facetlist);CHKERRQ(ierr);
4082     ierr = PetscMalloc1(in->numberoffacets,   &in->facetmarkerlist);CHKERRQ(ierr);
4083     for (f = fStart; f < fEnd; ++f) {
4084       const PetscInt idx     = f - fStart;
4085       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
4086       polygon       *poly;
4087 
4088       in->facetlist[idx].numberofpolygons = 1;
4089 
4090       ierr = PetscMalloc1(in->facetlist[idx].numberofpolygons, &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
4091 
4092       in->facetlist[idx].numberofholes    = 0;
4093       in->facetlist[idx].holelist         = NULL;
4094 
4095       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4096       for (p = 0; p < numPoints*2; p += 2) {
4097         const PetscInt point = points[p];
4098         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
4099       }
4100 
4101       poly                   = in->facetlist[idx].polygonlist;
4102       poly->numberofvertices = numVertices;
4103       ierr                   = PetscMalloc1(poly->numberofvertices, &poly->vertexlist);CHKERRQ(ierr);
4104       for (v = 0; v < numVertices; ++v) {
4105         const PetscInt vIdx = points[v] - vStart;
4106         poly->vertexlist[v] = vIdx;
4107       }
4108       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
4109       in->facetmarkerlist[idx] = (int) m;
4110       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4111     }
4112   }
4113   if (!rank) {
4114     TetGenOpts t;
4115 
4116     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4117     t.in        = boundary; /* Should go away */
4118     t.plc       = 1;
4119     t.quality   = 1;
4120     t.edgesout  = 1;
4121     t.zeroindex = 1;
4122     t.quiet     = 1;
4123     t.verbose   = verbose;
4124     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
4125     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4126   }
4127   {
4128     const PetscInt numCorners  = 4;
4129     const PetscInt numCells    = out->numberoftetrahedra;
4130     const PetscInt numVertices = out->numberofpoints;
4131     const double   *meshCoords = out->pointlist;
4132     int            *cells      = out->tetrahedronlist;
4133 
4134     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4135     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
4136     /* Set labels */
4137     for (v = 0; v < numVertices; ++v) {
4138       if (out->pointmarkerlist[v]) {
4139         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4140       }
4141     }
4142     if (interpolate) {
4143       PetscInt e;
4144 
4145       for (e = 0; e < out->numberofedges; e++) {
4146         if (out->edgemarkerlist[e]) {
4147           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4148           const PetscInt *edges;
4149           PetscInt        numEdges;
4150 
4151           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4152           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4153           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4154           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4155         }
4156       }
4157       for (f = 0; f < out->numberoftrifaces; f++) {
4158         if (out->trifacemarkerlist[f]) {
4159           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4160           const PetscInt *faces;
4161           PetscInt        numFaces;
4162 
4163           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4164           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4165           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4166           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4167         }
4168       }
4169     }
4170     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
4171   }
4172 
4173   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4174   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4175   PetscFunctionReturn(0);
4176 }
4177 
4178 #undef __FUNCT__
4179 #define __FUNCT__ "DMPlexRefine_CTetgen"
4180 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
4181 {
4182   MPI_Comm       comm;
4183   const PetscInt dim  = 3;
4184   PLC           *in, *out;
4185   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
4186   PetscMPIInt    rank;
4187   PetscErrorCode ierr;
4188 
4189   PetscFunctionBegin;
4190   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
4191   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4192   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4193   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4194   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
4195   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4196   ierr = PLCCreate(&in);CHKERRQ(ierr);
4197   ierr = PLCCreate(&out);CHKERRQ(ierr);
4198 
4199   in->numberofpoints = vEnd - vStart;
4200   if (in->numberofpoints > 0) {
4201     PetscSection coordSection;
4202     Vec          coordinates;
4203     PetscScalar *array;
4204 
4205     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4206     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4207     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4208     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4209     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4210     for (v = vStart; v < vEnd; ++v) {
4211       const PetscInt idx = v - vStart;
4212       PetscInt       off, d, m;
4213 
4214       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4215       for (d = 0; d < dim; ++d) {
4216         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4217       }
4218       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
4219 
4220       in->pointmarkerlist[idx] = (int) m;
4221     }
4222     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4223   }
4224   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4225 
4226   in->numberofcorners       = 4;
4227   in->numberoftetrahedra    = cEnd - cStart;
4228   in->tetrahedronvolumelist = maxVolumes;
4229   if (in->numberoftetrahedra > 0) {
4230     ierr = PetscMalloc1(in->numberoftetrahedra*in->numberofcorners, &in->tetrahedronlist);CHKERRQ(ierr);
4231     for (c = cStart; c < cEnd; ++c) {
4232       const PetscInt idx      = c - cStart;
4233       PetscInt      *closure = NULL;
4234       PetscInt       closureSize;
4235 
4236       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4237       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4238       for (v = 0; v < 4; ++v) {
4239         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4240       }
4241       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4242     }
4243   }
4244   if (!rank) {
4245     TetGenOpts t;
4246 
4247     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4248 
4249     t.in        = dm; /* Should go away */
4250     t.refine    = 1;
4251     t.varvolume = 1;
4252     t.quality   = 1;
4253     t.edgesout  = 1;
4254     t.zeroindex = 1;
4255     t.quiet     = 1;
4256     t.verbose   = verbose; /* Change this */
4257 
4258     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4259     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4260   }
4261   {
4262     const PetscInt numCorners  = 4;
4263     const PetscInt numCells    = out->numberoftetrahedra;
4264     const PetscInt numVertices = out->numberofpoints;
4265     const double   *meshCoords = out->pointlist;
4266     int            *cells      = out->tetrahedronlist;
4267     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4268 
4269     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4270     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4271     /* Set labels */
4272     for (v = 0; v < numVertices; ++v) {
4273       if (out->pointmarkerlist[v]) {
4274         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4275       }
4276     }
4277     if (interpolate) {
4278       PetscInt e, f;
4279 
4280       for (e = 0; e < out->numberofedges; e++) {
4281         if (out->edgemarkerlist[e]) {
4282           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4283           const PetscInt *edges;
4284           PetscInt        numEdges;
4285 
4286           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4287           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4288           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4289           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4290         }
4291       }
4292       for (f = 0; f < out->numberoftrifaces; f++) {
4293         if (out->trifacemarkerlist[f]) {
4294           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4295           const PetscInt *faces;
4296           PetscInt        numFaces;
4297 
4298           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4299           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4300           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4301           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4302         }
4303       }
4304     }
4305     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4306   }
4307   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4308   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4309   PetscFunctionReturn(0);
4310 }
4311 #endif
4312 
4313 #undef __FUNCT__
4314 #define __FUNCT__ "DMPlexGenerate"
4315 /*@C
4316   DMPlexGenerate - Generates a mesh.
4317 
4318   Not Collective
4319 
4320   Input Parameters:
4321 + boundary - The DMPlex boundary object
4322 . name - The mesh generation package name
4323 - interpolate - Flag to create intermediate mesh elements
4324 
4325   Output Parameter:
4326 . mesh - The DMPlex object
4327 
4328   Level: intermediate
4329 
4330 .keywords: mesh, elements
4331 .seealso: DMPlexCreate(), DMRefine()
4332 @*/
4333 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4334 {
4335   PetscInt       dim;
4336   char           genname[1024];
4337   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4338   PetscErrorCode ierr;
4339 
4340   PetscFunctionBegin;
4341   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4342   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4343   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4344   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4345   if (flg) name = genname;
4346   if (name) {
4347     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4348     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4349     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4350   }
4351   switch (dim) {
4352   case 1:
4353     if (!name || isTriangle) {
4354 #if defined(PETSC_HAVE_TRIANGLE)
4355       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4356 #else
4357       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4358 #endif
4359     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4360     break;
4361   case 2:
4362     if (!name || isCTetgen) {
4363 #if defined(PETSC_HAVE_CTETGEN)
4364       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4365 #else
4366       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4367 #endif
4368     } else if (isTetgen) {
4369 #if defined(PETSC_HAVE_TETGEN)
4370       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4371 #else
4372       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4373 #endif
4374     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4375     break;
4376   default:
4377     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4378   }
4379   PetscFunctionReturn(0);
4380 }
4381 
4382 #undef __FUNCT__
4383 #define __FUNCT__ "DMRefine_Plex"
4384 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
4385 {
4386   PetscReal      refinementLimit;
4387   PetscInt       dim, cStart, cEnd;
4388   char           genname[1024], *name = NULL;
4389   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4390   PetscErrorCode ierr;
4391 
4392   PetscFunctionBegin;
4393   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4394   if (isUniform) {
4395     CellRefiner cellRefiner;
4396 
4397     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
4398     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
4399     PetscFunctionReturn(0);
4400   }
4401   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
4402   if (refinementLimit == 0.0) PetscFunctionReturn(0);
4403   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
4404   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4405   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4406   if (flg) name = genname;
4407   if (name) {
4408     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4409     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4410     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4411   }
4412   switch (dim) {
4413   case 2:
4414     if (!name || isTriangle) {
4415 #if defined(PETSC_HAVE_TRIANGLE)
4416       double  *maxVolumes;
4417       PetscInt c;
4418 
4419       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4420       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4421       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4422       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
4423 #else
4424       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
4425 #endif
4426     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4427     break;
4428   case 3:
4429     if (!name || isCTetgen) {
4430 #if defined(PETSC_HAVE_CTETGEN)
4431       PetscReal *maxVolumes;
4432       PetscInt   c;
4433 
4434       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4435       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4436       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4437 #else
4438       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4439 #endif
4440     } else if (isTetgen) {
4441 #if defined(PETSC_HAVE_TETGEN)
4442       double  *maxVolumes;
4443       PetscInt c;
4444 
4445       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4446       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4447       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4448 #else
4449       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4450 #endif
4451     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4452     break;
4453   default:
4454     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
4455   }
4456   PetscFunctionReturn(0);
4457 }
4458 
4459 #undef __FUNCT__
4460 #define __FUNCT__ "DMRefineHierarchy_Plex"
4461 PetscErrorCode DMRefineHierarchy_Plex(DM dm, PetscInt nlevels, DM dmRefined[])
4462 {
4463   DM             cdm = dm;
4464   PetscInt       r;
4465   PetscBool      isUniform;
4466   PetscErrorCode ierr;
4467 
4468   PetscFunctionBegin;
4469   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4470   if (!isUniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Non-uniform refinement is incompatible with the hierarchy");
4471   for (r = 0; r < nlevels; ++r) {
4472     CellRefiner cellRefiner;
4473 
4474     ierr = DMPlexGetCellRefiner_Internal(cdm, &cellRefiner);CHKERRQ(ierr);
4475     ierr = DMPlexRefineUniform_Internal(cdm, cellRefiner, &dmRefined[r]);CHKERRQ(ierr);
4476     ierr = DMPlexSetCoarseDM(dmRefined[r], cdm);CHKERRQ(ierr);
4477     cdm  = dmRefined[r];
4478   }
4479   PetscFunctionReturn(0);
4480 }
4481 
4482 #undef __FUNCT__
4483 #define __FUNCT__ "DMCoarsen_Plex"
4484 PetscErrorCode DMCoarsen_Plex(DM dm, MPI_Comm comm, DM *dmCoarsened)
4485 {
4486   DM_Plex       *mesh = (DM_Plex*) dm->data;
4487   PetscErrorCode ierr;
4488 
4489   PetscFunctionBegin;
4490   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
4491   *dmCoarsened = mesh->coarseMesh;
4492   PetscFunctionReturn(0);
4493 }
4494 
4495 #undef __FUNCT__
4496 #define __FUNCT__ "DMPlexGetDepthLabel"
4497 /*@
4498   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
4499 
4500   Not Collective
4501 
4502   Input Parameter:
4503 . dm    - The DMPlex object
4504 
4505   Output Parameter:
4506 . depthLabel - The DMLabel recording point depth
4507 
4508   Level: developer
4509 
4510 .keywords: mesh, points
4511 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4512 @*/
4513 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
4514 {
4515   DM_Plex       *mesh = (DM_Plex*) dm->data;
4516   PetscErrorCode ierr;
4517 
4518   PetscFunctionBegin;
4519   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4520   PetscValidPointer(depthLabel, 2);
4521   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
4522   *depthLabel = mesh->depthLabel;
4523   PetscFunctionReturn(0);
4524 }
4525 
4526 #undef __FUNCT__
4527 #define __FUNCT__ "DMPlexGetDepth"
4528 /*@
4529   DMPlexGetDepth - Get the depth of the DAG representing this mesh
4530 
4531   Not Collective
4532 
4533   Input Parameter:
4534 . dm    - The DMPlex object
4535 
4536   Output Parameter:
4537 . depth - The number of strata (breadth first levels) in the DAG
4538 
4539   Level: developer
4540 
4541 .keywords: mesh, points
4542 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4543 @*/
4544 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
4545 {
4546   DMLabel        label;
4547   PetscInt       d = 0;
4548   PetscErrorCode ierr;
4549 
4550   PetscFunctionBegin;
4551   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4552   PetscValidPointer(depth, 2);
4553   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4554   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
4555   *depth = d-1;
4556   PetscFunctionReturn(0);
4557 }
4558 
4559 #undef __FUNCT__
4560 #define __FUNCT__ "DMPlexGetDepthStratum"
4561 /*@
4562   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
4563 
4564   Not Collective
4565 
4566   Input Parameters:
4567 + dm           - The DMPlex object
4568 - stratumValue - The requested depth
4569 
4570   Output Parameters:
4571 + start - The first point at this depth
4572 - end   - One beyond the last point at this depth
4573 
4574   Level: developer
4575 
4576 .keywords: mesh, points
4577 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
4578 @*/
4579 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4580 {
4581   DMLabel        label;
4582   PetscInt       pStart, pEnd;
4583   PetscErrorCode ierr;
4584 
4585   PetscFunctionBegin;
4586   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4587   if (start) {PetscValidPointer(start, 3); *start = 0;}
4588   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4589   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4590   if (pStart == pEnd) PetscFunctionReturn(0);
4591   if (stratumValue < 0) {
4592     if (start) *start = pStart;
4593     if (end)   *end   = pEnd;
4594     PetscFunctionReturn(0);
4595   }
4596   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4597   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
4598   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
4599   PetscFunctionReturn(0);
4600 }
4601 
4602 #undef __FUNCT__
4603 #define __FUNCT__ "DMPlexGetHeightStratum"
4604 /*@
4605   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4606 
4607   Not Collective
4608 
4609   Input Parameters:
4610 + dm           - The DMPlex object
4611 - stratumValue - The requested height
4612 
4613   Output Parameters:
4614 + start - The first point at this height
4615 - end   - One beyond the last point at this height
4616 
4617   Level: developer
4618 
4619 .keywords: mesh, points
4620 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4621 @*/
4622 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4623 {
4624   DMLabel        label;
4625   PetscInt       depth, pStart, pEnd;
4626   PetscErrorCode ierr;
4627 
4628   PetscFunctionBegin;
4629   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4630   if (start) {PetscValidPointer(start, 3); *start = 0;}
4631   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4632   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4633   if (pStart == pEnd) PetscFunctionReturn(0);
4634   if (stratumValue < 0) {
4635     if (start) *start = pStart;
4636     if (end)   *end   = pEnd;
4637     PetscFunctionReturn(0);
4638   }
4639   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4640   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4641   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4642   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4643   PetscFunctionReturn(0);
4644 }
4645 
4646 #undef __FUNCT__
4647 #define __FUNCT__ "DMPlexCreateSectionInitial"
4648 /* Set the number of dof on each point and separate by fields */
4649 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4650 {
4651   PetscInt      *numDofTot;
4652   PetscInt       depth, pStart = 0, pEnd = 0;
4653   PetscInt       p, d, dep, f;
4654   PetscErrorCode ierr;
4655 
4656   PetscFunctionBegin;
4657   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
4658   for (d = 0; d <= dim; ++d) {
4659     numDofTot[d] = 0;
4660     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4661   }
4662   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4663   if (numFields > 0) {
4664     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4665     if (numComp) {
4666       for (f = 0; f < numFields; ++f) {
4667         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4668       }
4669     }
4670   }
4671   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4672   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4673   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4674   for (dep = 0; dep <= depth; ++dep) {
4675     d    = dim == depth ? dep : (!dep ? 0 : dim);
4676     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
4677     for (p = pStart; p < pEnd; ++p) {
4678       for (f = 0; f < numFields; ++f) {
4679         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4680       }
4681       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4682     }
4683   }
4684   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4685   PetscFunctionReturn(0);
4686 }
4687 
4688 #undef __FUNCT__
4689 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4690 /* Set the number of dof on each point and separate by fields
4691    If constDof is PETSC_DETERMINE, constrain every dof on the point
4692 */
4693 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4694 {
4695   PetscInt       numFields;
4696   PetscInt       bc;
4697   PetscErrorCode ierr;
4698 
4699   PetscFunctionBegin;
4700   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4701   for (bc = 0; bc < numBC; ++bc) {
4702     PetscInt        field = 0;
4703     const PetscInt *idx;
4704     PetscInt        n, i;
4705 
4706     if (numFields) field = bcField[bc];
4707     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4708     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4709     for (i = 0; i < n; ++i) {
4710       const PetscInt p        = idx[i];
4711       PetscInt       numConst = constDof;
4712 
4713       /* Constrain every dof on the point */
4714       if (numConst < 0) {
4715         if (numFields) {
4716           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4717         } else {
4718           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4719         }
4720       }
4721       if (numFields) {
4722         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4723       }
4724       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4725     }
4726     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4727   }
4728   PetscFunctionReturn(0);
4729 }
4730 
4731 #undef __FUNCT__
4732 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4733 /* Set the constrained indices on each point and separate by fields */
4734 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4735 {
4736   PetscInt      *maxConstraints;
4737   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4738   PetscErrorCode ierr;
4739 
4740   PetscFunctionBegin;
4741   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4742   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4743   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
4744   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4745   for (p = pStart; p < pEnd; ++p) {
4746     PetscInt cdof;
4747 
4748     if (numFields) {
4749       for (f = 0; f < numFields; ++f) {
4750         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4751         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4752       }
4753     } else {
4754       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4755       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4756     }
4757   }
4758   for (f = 0; f < numFields; ++f) {
4759     maxConstraints[numFields] += maxConstraints[f];
4760   }
4761   if (maxConstraints[numFields]) {
4762     PetscInt *indices;
4763 
4764     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
4765     for (p = pStart; p < pEnd; ++p) {
4766       PetscInt cdof, d;
4767 
4768       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4769       if (cdof) {
4770         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4771         if (numFields) {
4772           PetscInt numConst = 0, foff = 0;
4773 
4774           for (f = 0; f < numFields; ++f) {
4775             PetscInt cfdof, fdof;
4776 
4777             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4778             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4779             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4780             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4781             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4782             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4783             numConst += cfdof;
4784             foff     += fdof;
4785           }
4786           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4787         } else {
4788           for (d = 0; d < cdof; ++d) indices[d] = d;
4789         }
4790         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4791       }
4792     }
4793     ierr = PetscFree(indices);CHKERRQ(ierr);
4794   }
4795   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4796   PetscFunctionReturn(0);
4797 }
4798 
4799 #undef __FUNCT__
4800 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4801 /* Set the constrained field indices on each point */
4802 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4803 {
4804   const PetscInt *points, *indices;
4805   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4806   PetscErrorCode  ierr;
4807 
4808   PetscFunctionBegin;
4809   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4810   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4811 
4812   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4813   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4814   if (!constraintIndices) {
4815     PetscInt *idx, i;
4816 
4817     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4818     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
4819     for (i = 0; i < maxDof; ++i) idx[i] = i;
4820     for (p = 0; p < numPoints; ++p) {
4821       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4822     }
4823     ierr = PetscFree(idx);CHKERRQ(ierr);
4824   } else {
4825     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4826     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4827     for (p = 0; p < numPoints; ++p) {
4828       PetscInt fcdof;
4829 
4830       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4831       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);
4832       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4833     }
4834     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4835   }
4836   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4837   PetscFunctionReturn(0);
4838 }
4839 
4840 #undef __FUNCT__
4841 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4842 /* Set the constrained indices on each point and separate by fields */
4843 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4844 {
4845   PetscInt      *indices;
4846   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4847   PetscErrorCode ierr;
4848 
4849   PetscFunctionBegin;
4850   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4851   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
4852   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4853   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4854   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4855   for (p = pStart; p < pEnd; ++p) {
4856     PetscInt cdof, d;
4857 
4858     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4859     if (cdof) {
4860       PetscInt numConst = 0, foff = 0;
4861 
4862       for (f = 0; f < numFields; ++f) {
4863         const PetscInt *fcind;
4864         PetscInt        fdof, fcdof;
4865 
4866         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4867         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4868         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4869         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4870         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4871         foff     += fdof;
4872         numConst += fcdof;
4873       }
4874       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4875       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4876     }
4877   }
4878   ierr = PetscFree(indices);CHKERRQ(ierr);
4879   PetscFunctionReturn(0);
4880 }
4881 
4882 #undef __FUNCT__
4883 #define __FUNCT__ "DMPlexCreateSection"
4884 /*@C
4885   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4886 
4887   Not Collective
4888 
4889   Input Parameters:
4890 + dm        - The DMPlex object
4891 . dim       - The spatial dimension of the problem
4892 . numFields - The number of fields in the problem
4893 . numComp   - An array of size numFields that holds the number of components for each field
4894 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4895 . numBC     - The number of boundary conditions
4896 . bcField   - An array of size numBC giving the field number for each boundry condition
4897 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4898 
4899   Output Parameter:
4900 . section - The PetscSection object
4901 
4902   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
4903   nubmer of dof for field 0 on each edge.
4904 
4905   Level: developer
4906 
4907   Fortran Notes:
4908   A Fortran 90 version is available as DMPlexCreateSectionF90()
4909 
4910 .keywords: mesh, elements
4911 .seealso: DMPlexCreate(), PetscSectionCreate()
4912 @*/
4913 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
4914 {
4915   PetscErrorCode ierr;
4916 
4917   PetscFunctionBegin;
4918   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4919   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4920   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4921   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4922   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
4923   PetscFunctionReturn(0);
4924 }
4925 
4926 #undef __FUNCT__
4927 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4928 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4929 {
4930   PetscSection   section;
4931   PetscErrorCode ierr;
4932 
4933   PetscFunctionBegin;
4934   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4935   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4936   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4937   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4938   PetscFunctionReturn(0);
4939 }
4940 
4941 #undef __FUNCT__
4942 #define __FUNCT__ "DMPlexGetConeSection"
4943 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4944 {
4945   DM_Plex *mesh = (DM_Plex*) dm->data;
4946 
4947   PetscFunctionBegin;
4948   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4949   if (section) *section = mesh->coneSection;
4950   PetscFunctionReturn(0);
4951 }
4952 
4953 #undef __FUNCT__
4954 #define __FUNCT__ "DMPlexGetSupportSection"
4955 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4956 {
4957   DM_Plex *mesh = (DM_Plex*) dm->data;
4958 
4959   PetscFunctionBegin;
4960   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4961   if (section) *section = mesh->supportSection;
4962   PetscFunctionReturn(0);
4963 }
4964 
4965 #undef __FUNCT__
4966 #define __FUNCT__ "DMPlexGetCones"
4967 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4968 {
4969   DM_Plex *mesh = (DM_Plex*) dm->data;
4970 
4971   PetscFunctionBegin;
4972   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4973   if (cones) *cones = mesh->cones;
4974   PetscFunctionReturn(0);
4975 }
4976 
4977 #undef __FUNCT__
4978 #define __FUNCT__ "DMPlexGetConeOrientations"
4979 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4980 {
4981   DM_Plex *mesh = (DM_Plex*) dm->data;
4982 
4983   PetscFunctionBegin;
4984   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4985   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4986   PetscFunctionReturn(0);
4987 }
4988 
4989 /******************************** FEM Support **********************************/
4990 
4991 #undef __FUNCT__
4992 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
4993 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4994 {
4995   PetscScalar    *array, *vArray;
4996   const PetscInt *cone, *coneO;
4997   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4998   PetscErrorCode  ierr;
4999 
5000   PetscFunctionBeginHot;
5001   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5002   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5003   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5004   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5005   if (!values || !*values) {
5006     if ((point >= pStart) && (point < pEnd)) {
5007       PetscInt dof;
5008 
5009       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5010       size += dof;
5011     }
5012     for (p = 0; p < numPoints; ++p) {
5013       const PetscInt cp = cone[p];
5014       PetscInt       dof;
5015 
5016       if ((cp < pStart) || (cp >= pEnd)) continue;
5017       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5018       size += dof;
5019     }
5020     if (!values) {
5021       if (csize) *csize = size;
5022       PetscFunctionReturn(0);
5023     }
5024     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
5025   } else {
5026     array = *values;
5027   }
5028   size = 0;
5029   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5030   if ((point >= pStart) && (point < pEnd)) {
5031     PetscInt     dof, off, d;
5032     PetscScalar *varr;
5033 
5034     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5035     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5036     varr = &vArray[off];
5037     for (d = 0; d < dof; ++d, ++offset) {
5038       array[offset] = varr[d];
5039     }
5040     size += dof;
5041   }
5042   for (p = 0; p < numPoints; ++p) {
5043     const PetscInt cp = cone[p];
5044     PetscInt       o  = coneO[p];
5045     PetscInt       dof, off, d;
5046     PetscScalar   *varr;
5047 
5048     if ((cp < pStart) || (cp >= pEnd)) continue;
5049     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5050     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
5051     varr = &vArray[off];
5052     if (o >= 0) {
5053       for (d = 0; d < dof; ++d, ++offset) {
5054         array[offset] = varr[d];
5055       }
5056     } else {
5057       for (d = dof-1; d >= 0; --d, ++offset) {
5058         array[offset] = varr[d];
5059       }
5060     }
5061     size += dof;
5062   }
5063   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5064   if (!*values) {
5065     if (csize) *csize = size;
5066     *values = array;
5067   } else {
5068     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5069     *csize = size;
5070   }
5071   PetscFunctionReturn(0);
5072 }
5073 
5074 #undef __FUNCT__
5075 #define __FUNCT__ "DMPlexVecGetClosure_Static"
5076 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5077 {
5078   PetscInt       offset = 0, p;
5079   PetscErrorCode ierr;
5080 
5081   PetscFunctionBeginHot;
5082   *size = 0;
5083   for (p = 0; p < numPoints*2; p += 2) {
5084     const PetscInt point = points[p];
5085     const PetscInt o     = points[p+1];
5086     PetscInt       dof, off, d;
5087     const PetscScalar *varr;
5088 
5089     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5090     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5091     varr = &vArray[off];
5092     if (o >= 0) {
5093       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
5094     } else {
5095       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
5096     }
5097   }
5098   *size = offset;
5099   PetscFunctionReturn(0);
5100 }
5101 
5102 #undef __FUNCT__
5103 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
5104 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5105 {
5106   PetscInt       offset = 0, f;
5107   PetscErrorCode ierr;
5108 
5109   PetscFunctionBeginHot;
5110   *size = 0;
5111   for (f = 0; f < numFields; ++f) {
5112     PetscInt fcomp, p;
5113 
5114     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5115     for (p = 0; p < numPoints*2; p += 2) {
5116       const PetscInt point = points[p];
5117       const PetscInt o     = points[p+1];
5118       PetscInt       fdof, foff, d, c;
5119       const PetscScalar *varr;
5120 
5121       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5122       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5123       varr = &vArray[foff];
5124       if (o >= 0) {
5125         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
5126       } else {
5127         for (d = fdof/fcomp-1; d >= 0; --d) {
5128           for (c = 0; c < fcomp; ++c, ++offset) {
5129             array[offset] = varr[d*fcomp+c];
5130           }
5131         }
5132       }
5133     }
5134   }
5135   *size = offset;
5136   PetscFunctionReturn(0);
5137 }
5138 
5139 #undef __FUNCT__
5140 #define __FUNCT__ "DMPlexVecGetClosure"
5141 /*@C
5142   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
5143 
5144   Not collective
5145 
5146   Input Parameters:
5147 + dm - The DM
5148 . section - The section describing the layout in v, or NULL to use the default section
5149 . v - The local vector
5150 - point - The sieve point in the DM
5151 
5152   Output Parameters:
5153 + csize - The number of values in the closure, or NULL
5154 - values - The array of values, which is a borrowed array and should not be freed
5155 
5156   Fortran Notes:
5157   Since it returns an array, this routine is only available in Fortran 90, and you must
5158   include petsc.h90 in your code.
5159 
5160   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5161 
5162   Level: intermediate
5163 
5164 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5165 @*/
5166 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5167 {
5168   PetscSection    clSection;
5169   IS              clPoints;
5170   PetscScalar    *array, *vArray;
5171   PetscInt       *points = NULL;
5172   const PetscInt *clp;
5173   PetscInt        depth, numFields, numPoints, size;
5174   PetscErrorCode  ierr;
5175 
5176   PetscFunctionBeginHot;
5177   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5178   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5179   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5180   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5181   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5182   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5183   if (depth == 1 && numFields < 2) {
5184     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
5185     PetscFunctionReturn(0);
5186   }
5187   /* Get points */
5188   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5189   if (!clPoints) {
5190     PetscInt pStart, pEnd, p, q;
5191 
5192     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5193     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5194     /* Compress out points not in the section */
5195     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5196       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5197         points[q*2]   = points[p];
5198         points[q*2+1] = points[p+1];
5199         ++q;
5200       }
5201     }
5202     numPoints = q;
5203   } else {
5204     PetscInt dof, off;
5205 
5206     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5207     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5208     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5209     numPoints = dof/2;
5210     points    = (PetscInt *) &clp[off];
5211   }
5212   /* Get array */
5213   if (!values || !*values) {
5214     PetscInt asize = 0, dof, p;
5215 
5216     for (p = 0; p < numPoints*2; p += 2) {
5217       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5218       asize += dof;
5219     }
5220     if (!values) {
5221       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5222       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5223       if (csize) *csize = asize;
5224       PetscFunctionReturn(0);
5225     }
5226     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
5227   } else {
5228     array = *values;
5229   }
5230   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5231   /* Get values */
5232   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
5233   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
5234   /* Cleanup points */
5235   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5236   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5237   /* Cleanup array */
5238   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5239   if (!*values) {
5240     if (csize) *csize = size;
5241     *values = array;
5242   } else {
5243     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5244     *csize = size;
5245   }
5246   PetscFunctionReturn(0);
5247 }
5248 
5249 #undef __FUNCT__
5250 #define __FUNCT__ "DMPlexVecRestoreClosure"
5251 /*@C
5252   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
5253 
5254   Not collective
5255 
5256   Input Parameters:
5257 + dm - The DM
5258 . section - The section describing the layout in v, or NULL to use the default section
5259 . v - The local vector
5260 . point - The sieve point in the DM
5261 . csize - The number of values in the closure, or NULL
5262 - values - The array of values, which is a borrowed array and should not be freed
5263 
5264   Fortran Notes:
5265   Since it returns an array, this routine is only available in Fortran 90, and you must
5266   include petsc.h90 in your code.
5267 
5268   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5269 
5270   Level: intermediate
5271 
5272 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5273 @*/
5274 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5275 {
5276   PetscInt       size = 0;
5277   PetscErrorCode ierr;
5278 
5279   PetscFunctionBegin;
5280   /* Should work without recalculating size */
5281   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
5282   PetscFunctionReturn(0);
5283 }
5284 
5285 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
5286 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
5287 
5288 #undef __FUNCT__
5289 #define __FUNCT__ "updatePoint_private"
5290 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[])
5291 {
5292   PetscInt        cdof;   /* The number of constraints on this point */
5293   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5294   PetscScalar    *a;
5295   PetscInt        off, cind = 0, k;
5296   PetscErrorCode  ierr;
5297 
5298   PetscFunctionBegin;
5299   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5300   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5301   a    = &array[off];
5302   if (!cdof || setBC) {
5303     if (orientation >= 0) {
5304       for (k = 0; k < dof; ++k) {
5305         fuse(&a[k], values[k]);
5306       }
5307     } else {
5308       for (k = 0; k < dof; ++k) {
5309         fuse(&a[k], values[dof-k-1]);
5310       }
5311     }
5312   } else {
5313     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5314     if (orientation >= 0) {
5315       for (k = 0; k < dof; ++k) {
5316         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5317         fuse(&a[k], values[k]);
5318       }
5319     } else {
5320       for (k = 0; k < dof; ++k) {
5321         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5322         fuse(&a[k], values[dof-k-1]);
5323       }
5324     }
5325   }
5326   PetscFunctionReturn(0);
5327 }
5328 
5329 #undef __FUNCT__
5330 #define __FUNCT__ "updatePointBC_private"
5331 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5332 {
5333   PetscInt        cdof;   /* The number of constraints on this point */
5334   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5335   PetscScalar    *a;
5336   PetscInt        off, cind = 0, k;
5337   PetscErrorCode  ierr;
5338 
5339   PetscFunctionBegin;
5340   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5341   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5342   a    = &array[off];
5343   if (cdof) {
5344     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5345     if (orientation >= 0) {
5346       for (k = 0; k < dof; ++k) {
5347         if ((cind < cdof) && (k == cdofs[cind])) {
5348           fuse(&a[k], values[k]);
5349           ++cind;
5350         }
5351       }
5352     } else {
5353       for (k = 0; k < dof; ++k) {
5354         if ((cind < cdof) && (k == cdofs[cind])) {
5355           fuse(&a[k], values[dof-k-1]);
5356           ++cind;
5357         }
5358       }
5359     }
5360   }
5361   PetscFunctionReturn(0);
5362 }
5363 
5364 #undef __FUNCT__
5365 #define __FUNCT__ "updatePointFields_private"
5366 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[])
5367 {
5368   PetscScalar    *a;
5369   PetscInt        fdof, foff, fcdof, foffset = *offset;
5370   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5371   PetscInt        cind = 0, k, c;
5372   PetscErrorCode  ierr;
5373 
5374   PetscFunctionBegin;
5375   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5376   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5377   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5378   a    = &array[foff];
5379   if (!fcdof || setBC) {
5380     if (o >= 0) {
5381       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
5382     } else {
5383       for (k = fdof/fcomp-1; k >= 0; --k) {
5384         for (c = 0; c < fcomp; ++c) {
5385           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5386         }
5387       }
5388     }
5389   } else {
5390     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5391     if (o >= 0) {
5392       for (k = 0; k < fdof; ++k) {
5393         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
5394         fuse(&a[k], values[foffset+k]);
5395       }
5396     } else {
5397       for (k = fdof/fcomp-1; k >= 0; --k) {
5398         for (c = 0; c < fcomp; ++c) {
5399           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
5400           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5401         }
5402       }
5403     }
5404   }
5405   *offset += fdof;
5406   PetscFunctionReturn(0);
5407 }
5408 
5409 #undef __FUNCT__
5410 #define __FUNCT__ "updatePointFieldsBC_private"
5411 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[])
5412 {
5413   PetscScalar    *a;
5414   PetscInt        fdof, foff, fcdof, foffset = *offset;
5415   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5416   PetscInt        cind = 0, k, c;
5417   PetscErrorCode  ierr;
5418 
5419   PetscFunctionBegin;
5420   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5421   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5422   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5423   a    = &array[foff];
5424   if (fcdof) {
5425     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5426     if (o >= 0) {
5427       for (k = 0; k < fdof; ++k) {
5428         if ((cind < fcdof) && (k == fcdofs[cind])) {
5429           fuse(&a[k], values[foffset+k]);
5430           ++cind;
5431         }
5432       }
5433     } else {
5434       for (k = fdof/fcomp-1; k >= 0; --k) {
5435         for (c = 0; c < fcomp; ++c) {
5436           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
5437             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5438             ++cind;
5439           }
5440         }
5441       }
5442     }
5443   }
5444   *offset += fdof;
5445   PetscFunctionReturn(0);
5446 }
5447 
5448 #undef __FUNCT__
5449 #define __FUNCT__ "DMPlexVecSetClosure_Static"
5450 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5451 {
5452   PetscScalar    *array;
5453   const PetscInt *cone, *coneO;
5454   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5455   PetscErrorCode  ierr;
5456 
5457   PetscFunctionBeginHot;
5458   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5459   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5460   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5461   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5462   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5463   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5464     const PetscInt cp = !p ? point : cone[p-1];
5465     const PetscInt o  = !p ? 0     : coneO[p-1];
5466 
5467     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5468     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5469     /* ADD_VALUES */
5470     {
5471       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5472       PetscScalar    *a;
5473       PetscInt        cdof, coff, cind = 0, k;
5474 
5475       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5476       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5477       a    = &array[coff];
5478       if (!cdof) {
5479         if (o >= 0) {
5480           for (k = 0; k < dof; ++k) {
5481             a[k] += values[off+k];
5482           }
5483         } else {
5484           for (k = 0; k < dof; ++k) {
5485             a[k] += values[off+dof-k-1];
5486           }
5487         }
5488       } else {
5489         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5490         if (o >= 0) {
5491           for (k = 0; k < dof; ++k) {
5492             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5493             a[k] += values[off+k];
5494           }
5495         } else {
5496           for (k = 0; k < dof; ++k) {
5497             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5498             a[k] += values[off+dof-k-1];
5499           }
5500         }
5501       }
5502     }
5503   }
5504   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5505   PetscFunctionReturn(0);
5506 }
5507 
5508 #undef __FUNCT__
5509 #define __FUNCT__ "DMPlexVecSetClosure"
5510 /*@C
5511   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5512 
5513   Not collective
5514 
5515   Input Parameters:
5516 + dm - The DM
5517 . section - The section describing the layout in v, or NULL to use the default section
5518 . v - The local vector
5519 . point - The sieve point in the DM
5520 . values - The array of values
5521 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5522 
5523   Fortran Notes:
5524   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5525 
5526   Level: intermediate
5527 
5528 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5529 @*/
5530 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5531 {
5532   PetscSection    clSection;
5533   IS              clPoints;
5534   PetscScalar    *array;
5535   PetscInt       *points = NULL;
5536   const PetscInt *clp;
5537   PetscInt        depth, numFields, numPoints, p;
5538   PetscErrorCode  ierr;
5539 
5540   PetscFunctionBeginHot;
5541   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5542   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5543   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5544   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5545   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5546   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5547   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5548     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5549     PetscFunctionReturn(0);
5550   }
5551   /* Get points */
5552   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5553   if (!clPoints) {
5554     PetscInt pStart, pEnd, q;
5555 
5556     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5557     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5558     /* Compress out points not in the section */
5559     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5560       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5561         points[q*2]   = points[p];
5562         points[q*2+1] = points[p+1];
5563         ++q;
5564       }
5565     }
5566     numPoints = q;
5567   } else {
5568     PetscInt dof, off;
5569 
5570     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5571     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5572     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5573     numPoints = dof/2;
5574     points    = (PetscInt *) &clp[off];
5575   }
5576   /* Get array */
5577   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5578   /* Get values */
5579   if (numFields > 0) {
5580     PetscInt offset = 0, fcomp, f;
5581     for (f = 0; f < numFields; ++f) {
5582       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5583       switch (mode) {
5584       case INSERT_VALUES:
5585         for (p = 0; p < numPoints*2; p += 2) {
5586           const PetscInt point = points[p];
5587           const PetscInt o     = points[p+1];
5588           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
5589         } break;
5590       case INSERT_ALL_VALUES:
5591         for (p = 0; p < numPoints*2; p += 2) {
5592           const PetscInt point = points[p];
5593           const PetscInt o     = points[p+1];
5594           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
5595         } break;
5596       case INSERT_BC_VALUES:
5597         for (p = 0; p < numPoints*2; p += 2) {
5598           const PetscInt point = points[p];
5599           const PetscInt o     = points[p+1];
5600           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
5601         } break;
5602       case ADD_VALUES:
5603         for (p = 0; p < numPoints*2; p += 2) {
5604           const PetscInt point = points[p];
5605           const PetscInt o     = points[p+1];
5606           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
5607         } break;
5608       case ADD_ALL_VALUES:
5609         for (p = 0; p < numPoints*2; p += 2) {
5610           const PetscInt point = points[p];
5611           const PetscInt o     = points[p+1];
5612           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
5613         } break;
5614       default:
5615         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5616       }
5617     }
5618   } else {
5619     PetscInt dof, off;
5620 
5621     switch (mode) {
5622     case INSERT_VALUES:
5623       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5624         PetscInt o = points[p+1];
5625         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5626         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5627       } break;
5628     case INSERT_ALL_VALUES:
5629       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5630         PetscInt o = points[p+1];
5631         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5632         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5633       } break;
5634     case INSERT_BC_VALUES:
5635       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5636         PetscInt o = points[p+1];
5637         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5638         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5639       } break;
5640     case ADD_VALUES:
5641       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5642         PetscInt o = points[p+1];
5643         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5644         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5645       } break;
5646     case ADD_ALL_VALUES:
5647       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5648         PetscInt o = points[p+1];
5649         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5650         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5651       } break;
5652     default:
5653       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5654     }
5655   }
5656   /* Cleanup points */
5657   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5658   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5659   /* Cleanup array */
5660   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5661   PetscFunctionReturn(0);
5662 }
5663 
5664 #undef __FUNCT__
5665 #define __FUNCT__ "DMPlexPrintMatSetValues"
5666 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5667 {
5668   PetscMPIInt    rank;
5669   PetscInt       i, j;
5670   PetscErrorCode ierr;
5671 
5672   PetscFunctionBegin;
5673   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5674   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5675   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5676   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5677   numCIndices = numCIndices ? numCIndices : numRIndices;
5678   for (i = 0; i < numRIndices; i++) {
5679     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5680     for (j = 0; j < numCIndices; j++) {
5681 #if defined(PETSC_USE_COMPLEX)
5682       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5683 #else
5684       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5685 #endif
5686     }
5687     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5688   }
5689   PetscFunctionReturn(0);
5690 }
5691 
5692 #undef __FUNCT__
5693 #define __FUNCT__ "indicesPoint_private"
5694 /* . off - The global offset of this point */
5695 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5696 {
5697   PetscInt        dof;    /* The number of unknowns on this point */
5698   PetscInt        cdof;   /* The number of constraints on this point */
5699   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5700   PetscInt        cind = 0, k;
5701   PetscErrorCode  ierr;
5702 
5703   PetscFunctionBegin;
5704   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5705   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5706   if (!cdof || setBC) {
5707     if (orientation >= 0) {
5708       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5709     } else {
5710       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5711     }
5712   } else {
5713     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5714     if (orientation >= 0) {
5715       for (k = 0; k < dof; ++k) {
5716         if ((cind < cdof) && (k == cdofs[cind])) {
5717           /* Insert check for returning constrained indices */
5718           indices[*loff+k] = -(off+k+1);
5719           ++cind;
5720         } else {
5721           indices[*loff+k] = off+k-cind;
5722         }
5723       }
5724     } else {
5725       for (k = 0; k < dof; ++k) {
5726         if ((cind < cdof) && (k == cdofs[cind])) {
5727           /* Insert check for returning constrained indices */
5728           indices[*loff+dof-k-1] = -(off+k+1);
5729           ++cind;
5730         } else {
5731           indices[*loff+dof-k-1] = off+k-cind;
5732         }
5733       }
5734     }
5735   }
5736   *loff += dof;
5737   PetscFunctionReturn(0);
5738 }
5739 
5740 #undef __FUNCT__
5741 #define __FUNCT__ "indicesPointFields_private"
5742 /* . off - The global offset of this point */
5743 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5744 {
5745   PetscInt       numFields, foff, f;
5746   PetscErrorCode ierr;
5747 
5748   PetscFunctionBegin;
5749   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5750   for (f = 0, foff = 0; f < numFields; ++f) {
5751     PetscInt        fdof, fcomp, cfdof;
5752     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5753     PetscInt        cind = 0, k, c;
5754 
5755     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5756     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5757     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5758     if (!cfdof || setBC) {
5759       if (orientation >= 0) {
5760         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5761       } else {
5762         for (k = fdof/fcomp-1; k >= 0; --k) {
5763           for (c = 0; c < fcomp; ++c) {
5764             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5765           }
5766         }
5767       }
5768     } else {
5769       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5770       if (orientation >= 0) {
5771         for (k = 0; k < fdof; ++k) {
5772           if ((cind < cfdof) && (k == fcdofs[cind])) {
5773             indices[foffs[f]+k] = -(off+foff+k+1);
5774             ++cind;
5775           } else {
5776             indices[foffs[f]+k] = off+foff+k-cind;
5777           }
5778         }
5779       } else {
5780         for (k = fdof/fcomp-1; k >= 0; --k) {
5781           for (c = 0; c < fcomp; ++c) {
5782             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5783               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5784               ++cind;
5785             } else {
5786               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5787             }
5788           }
5789         }
5790       }
5791     }
5792     foff     += fdof - cfdof;
5793     foffs[f] += fdof;
5794   }
5795   PetscFunctionReturn(0);
5796 }
5797 
5798 #undef __FUNCT__
5799 #define __FUNCT__ "DMPlexMatSetClosure"
5800 /*@C
5801   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5802 
5803   Not collective
5804 
5805   Input Parameters:
5806 + dm - The DM
5807 . section - The section describing the layout in v, or NULL to use the default section
5808 . globalSection - The section describing the layout in v, or NULL to use the default global section
5809 . A - The matrix
5810 . point - The sieve point in the DM
5811 . values - The array of values
5812 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5813 
5814   Fortran Notes:
5815   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5816 
5817   Level: intermediate
5818 
5819 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5820 @*/
5821 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5822 {
5823   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5824   PetscSection    clSection;
5825   IS              clPoints;
5826   PetscInt       *points = NULL;
5827   const PetscInt *clp;
5828   PetscInt       *indices;
5829   PetscInt        offsets[32];
5830   PetscInt        numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5831   PetscErrorCode  ierr;
5832 
5833   PetscFunctionBegin;
5834   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5835   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5836   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5837   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5838   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5839   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5840   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5841   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5842   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5843   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5844   if (!clPoints) {
5845     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5846     /* Compress out points not in the section */
5847     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5848     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5849       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5850         points[q*2]   = points[p];
5851         points[q*2+1] = points[p+1];
5852         ++q;
5853       }
5854     }
5855     numPoints = q;
5856   } else {
5857     PetscInt dof, off;
5858 
5859     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5860     numPoints = dof/2;
5861     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5862     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5863     points = (PetscInt *) &clp[off];
5864   }
5865   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5866     PetscInt fdof;
5867 
5868     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5869     for (f = 0; f < numFields; ++f) {
5870       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5871       offsets[f+1] += fdof;
5872     }
5873     numIndices += dof;
5874   }
5875   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5876 
5877   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5878   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5879   if (numFields) {
5880     for (p = 0; p < numPoints*2; p += 2) {
5881       PetscInt o = points[p+1];
5882       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5883       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5884     }
5885   } else {
5886     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5887       PetscInt o = points[p+1];
5888       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5889       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5890     }
5891   }
5892   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5893   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5894   if (ierr) {
5895     PetscMPIInt    rank;
5896     PetscErrorCode ierr2;
5897 
5898     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5899     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5900     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5901     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5902     CHKERRQ(ierr);
5903   }
5904   if (!clPoints) {
5905     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5906   } else {
5907     ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5908   }
5909   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5910   PetscFunctionReturn(0);
5911 }
5912 
5913 #undef __FUNCT__
5914 #define __FUNCT__ "DMPlexMatSetClosureRefined"
5915 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5916 {
5917   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5918   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5919   PetscInt       *cpoints = NULL;
5920   PetscInt       *findices, *cindices;
5921   PetscInt        foffsets[32], coffsets[32];
5922   CellRefiner     cellRefiner;
5923   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5924   PetscErrorCode  ierr;
5925 
5926   PetscFunctionBegin;
5927   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5928   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5929   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5930   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5931   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5932   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5933   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5934   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5935   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5936   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5937   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5938   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5939   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5940   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5941   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5942   /* Column indices */
5943   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5944   maxFPoints = numCPoints;
5945   /* Compress out points not in the section */
5946   /*   TODO: Squeeze out points with 0 dof as well */
5947   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5948   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5949     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5950       cpoints[q*2]   = cpoints[p];
5951       cpoints[q*2+1] = cpoints[p+1];
5952       ++q;
5953     }
5954   }
5955   numCPoints = q;
5956   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5957     PetscInt fdof;
5958 
5959     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5960     if (!dof) continue;
5961     for (f = 0; f < numFields; ++f) {
5962       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5963       coffsets[f+1] += fdof;
5964     }
5965     numCIndices += dof;
5966   }
5967   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5968   /* Row indices */
5969   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5970   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5971   ierr = DMGetWorkArray(dmf, maxFPoints*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5972   for (r = 0, q = 0; r < numSubcells; ++r) {
5973     /* TODO Map from coarse to fine cells */
5974     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5975     /* Compress out points not in the section */
5976     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5977     for (p = 0; p < numFPoints*2; p += 2) {
5978       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5979         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5980         if (!dof) continue;
5981         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5982         if (s < q) continue;
5983         ftotpoints[q*2]   = fpoints[p];
5984         ftotpoints[q*2+1] = fpoints[p+1];
5985         ++q;
5986       }
5987     }
5988     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5989   }
5990   numFPoints = q;
5991   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5992     PetscInt fdof;
5993 
5994     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5995     if (!dof) continue;
5996     for (f = 0; f < numFields; ++f) {
5997       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5998       foffsets[f+1] += fdof;
5999     }
6000     numFIndices += dof;
6001   }
6002   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6003 
6004   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
6005   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
6006   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
6007   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
6008   if (numFields) {
6009     for (p = 0; p < numFPoints*2; p += 2) {
6010       PetscInt o = ftotpoints[p+1];
6011       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6012       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
6013     }
6014     for (p = 0; p < numCPoints*2; p += 2) {
6015       PetscInt o = cpoints[p+1];
6016       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6017       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
6018     }
6019   } else {
6020     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
6021       PetscInt o = ftotpoints[p+1];
6022       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6023       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
6024     }
6025     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
6026       PetscInt o = cpoints[p+1];
6027       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6028       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
6029     }
6030   }
6031   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6032   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6033   if (ierr) {
6034     PetscMPIInt    rank;
6035     PetscErrorCode ierr2;
6036 
6037     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6038     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6039     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6040     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
6041     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
6042     CHKERRQ(ierr);
6043   }
6044   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
6045   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6046   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
6047   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
6048   PetscFunctionReturn(0);
6049 }
6050 
6051 #undef __FUNCT__
6052 #define __FUNCT__ "DMPlexGetHybridBounds"
6053 /*@
6054   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
6055 
6056   Input Parameter:
6057 . dm - The DMPlex object
6058 
6059   Output Parameters:
6060 + cMax - The first hybrid cell
6061 . cMax - The first hybrid face
6062 . cMax - The first hybrid edge
6063 - cMax - The first hybrid vertex
6064 
6065   Level: developer
6066 
6067 .seealso DMPlexCreateHybridMesh()
6068 @*/
6069 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
6070 {
6071   DM_Plex       *mesh = (DM_Plex*) dm->data;
6072   PetscInt       dim;
6073   PetscErrorCode ierr;
6074 
6075   PetscFunctionBegin;
6076   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6077   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6078   if (cMax) *cMax = mesh->hybridPointMax[dim];
6079   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
6080   if (eMax) *eMax = mesh->hybridPointMax[1];
6081   if (vMax) *vMax = mesh->hybridPointMax[0];
6082   PetscFunctionReturn(0);
6083 }
6084 
6085 #undef __FUNCT__
6086 #define __FUNCT__ "DMPlexSetHybridBounds"
6087 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6088 {
6089   DM_Plex       *mesh = (DM_Plex*) dm->data;
6090   PetscInt       dim;
6091   PetscErrorCode ierr;
6092 
6093   PetscFunctionBegin;
6094   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6095   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6096   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
6097   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
6098   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
6099   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
6100   PetscFunctionReturn(0);
6101 }
6102 
6103 #undef __FUNCT__
6104 #define __FUNCT__ "DMPlexGetVTKCellHeight"
6105 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6106 {
6107   DM_Plex *mesh = (DM_Plex*) dm->data;
6108 
6109   PetscFunctionBegin;
6110   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6111   PetscValidPointer(cellHeight, 2);
6112   *cellHeight = mesh->vtkCellHeight;
6113   PetscFunctionReturn(0);
6114 }
6115 
6116 #undef __FUNCT__
6117 #define __FUNCT__ "DMPlexSetVTKCellHeight"
6118 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6119 {
6120   DM_Plex *mesh = (DM_Plex*) dm->data;
6121 
6122   PetscFunctionBegin;
6123   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6124   mesh->vtkCellHeight = cellHeight;
6125   PetscFunctionReturn(0);
6126 }
6127 
6128 #undef __FUNCT__
6129 #define __FUNCT__ "DMPlexCreateNumbering_Private"
6130 /* We can easily have a form that takes an IS instead */
6131 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
6132 {
6133   PetscSection   section, globalSection;
6134   PetscInt      *numbers, p;
6135   PetscErrorCode ierr;
6136 
6137   PetscFunctionBegin;
6138   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6139   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6140   for (p = pStart; p < pEnd; ++p) {
6141     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6142   }
6143   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6144   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6145   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
6146   for (p = pStart; p < pEnd; ++p) {
6147     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6148   }
6149   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6150   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6151   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6152   PetscFunctionReturn(0);
6153 }
6154 
6155 #undef __FUNCT__
6156 #define __FUNCT__ "DMPlexGetCellNumbering"
6157 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6158 {
6159   DM_Plex       *mesh = (DM_Plex*) dm->data;
6160   PetscInt       cellHeight, cStart, cEnd, cMax;
6161   PetscErrorCode ierr;
6162 
6163   PetscFunctionBegin;
6164   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6165   if (!mesh->globalCellNumbers) {
6166     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6167     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6168     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6169     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
6170     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
6171   }
6172   *globalCellNumbers = mesh->globalCellNumbers;
6173   PetscFunctionReturn(0);
6174 }
6175 
6176 #undef __FUNCT__
6177 #define __FUNCT__ "DMPlexGetVertexNumbering"
6178 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6179 {
6180   DM_Plex       *mesh = (DM_Plex*) dm->data;
6181   PetscInt       vStart, vEnd, vMax;
6182   PetscErrorCode ierr;
6183 
6184   PetscFunctionBegin;
6185   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6186   if (!mesh->globalVertexNumbers) {
6187     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6188     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6189     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
6190     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
6191   }
6192   *globalVertexNumbers = mesh->globalVertexNumbers;
6193   PetscFunctionReturn(0);
6194 }
6195 
6196 
6197 #undef __FUNCT__
6198 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
6199 /*@C
6200   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
6201   the local section and an SF describing the section point overlap.
6202 
6203   Input Parameters:
6204   + s - The PetscSection for the local field layout
6205   . sf - The SF describing parallel layout of the section points
6206   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
6207   . label - The label specifying the points
6208   - labelValue - The label stratum specifying the points
6209 
6210   Output Parameter:
6211   . gsection - The PetscSection for the global field layout
6212 
6213   Note: This gives negative sizes and offsets to points not owned by this process
6214 
6215   Level: developer
6216 
6217 .seealso: PetscSectionCreate()
6218 @*/
6219 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
6220 {
6221   PetscInt      *neg = NULL, *tmpOff = NULL;
6222   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
6223   PetscErrorCode ierr;
6224 
6225   PetscFunctionBegin;
6226   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
6227   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
6228   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
6229   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
6230   if (nroots >= 0) {
6231     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
6232     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
6233     if (nroots > pEnd-pStart) {
6234       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
6235     } else {
6236       tmpOff = &(*gsection)->atlasDof[-pStart];
6237     }
6238   }
6239   /* Mark ghost points with negative dof */
6240   for (p = pStart; p < pEnd; ++p) {
6241     PetscInt value;
6242 
6243     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6244     if (value != labelValue) continue;
6245     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6246     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6247     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6248     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6249     if (neg) neg[p] = -(dof+1);
6250   }
6251   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6252   if (nroots >= 0) {
6253     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6254     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6255     if (nroots > pEnd-pStart) {
6256       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6257     }
6258   }
6259   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6260   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6261     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6262     (*gsection)->atlasOff[p] = off;
6263     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6264   }
6265   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
6266   globalOff -= off;
6267   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6268     (*gsection)->atlasOff[p] += globalOff;
6269     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6270   }
6271   /* Put in negative offsets for ghost points */
6272   if (nroots >= 0) {
6273     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6274     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6275     if (nroots > pEnd-pStart) {
6276       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6277     }
6278   }
6279   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6280   ierr = PetscFree(neg);CHKERRQ(ierr);
6281   PetscFunctionReturn(0);
6282 }
6283 
6284 #undef __FUNCT__
6285 #define __FUNCT__ "DMPlexCheckSymmetry"
6286 /*@
6287   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6288 
6289   Input Parameters:
6290   + dm - The DMPlex object
6291 
6292   Note: This is a useful diagnostic when creating meshes programmatically.
6293 
6294   Level: developer
6295 
6296 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6297 @*/
6298 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6299 {
6300   PetscSection    coneSection, supportSection;
6301   const PetscInt *cone, *support;
6302   PetscInt        coneSize, c, supportSize, s;
6303   PetscInt        pStart, pEnd, p, csize, ssize;
6304   PetscErrorCode  ierr;
6305 
6306   PetscFunctionBegin;
6307   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6308   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6309   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6310   /* Check that point p is found in the support of its cone points, and vice versa */
6311   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6312   for (p = pStart; p < pEnd; ++p) {
6313     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6314     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6315     for (c = 0; c < coneSize; ++c) {
6316       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6317       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6318       for (s = 0; s < supportSize; ++s) {
6319         if (support[s] == p) break;
6320       }
6321       if (s >= supportSize) {
6322         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6323         for (s = 0; s < coneSize; ++s) {
6324           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6325         }
6326         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6327         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6328         for (s = 0; s < supportSize; ++s) {
6329           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6330         }
6331         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6332         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6333       }
6334     }
6335     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6336     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6337     for (s = 0; s < supportSize; ++s) {
6338       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6339       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6340       for (c = 0; c < coneSize; ++c) {
6341         if (cone[c] == p) break;
6342       }
6343       if (c >= coneSize) {
6344         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6345         for (c = 0; c < supportSize; ++c) {
6346           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6347         }
6348         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6349         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6350         for (c = 0; c < coneSize; ++c) {
6351           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6352         }
6353         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6354         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6355       }
6356     }
6357   }
6358   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6359   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6360   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6361   PetscFunctionReturn(0);
6362 }
6363 
6364 #undef __FUNCT__
6365 #define __FUNCT__ "DMPlexCheckSkeleton"
6366 /*@
6367   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6368 
6369   Input Parameters:
6370 + dm - The DMPlex object
6371 . isSimplex - Are the cells simplices or tensor products
6372 - cellHeight - Normally 0
6373 
6374   Note: This is a useful diagnostic when creating meshes programmatically.
6375 
6376   Level: developer
6377 
6378 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6379 @*/
6380 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6381 {
6382   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6383   PetscErrorCode ierr;
6384 
6385   PetscFunctionBegin;
6386   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6387   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6388   switch (dim) {
6389   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6390   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6391   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6392   default:
6393     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6394   }
6395   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6396   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6397   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6398   cMax = cMax >= 0 ? cMax : cEnd;
6399   for (c = cStart; c < cMax; ++c) {
6400     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6401 
6402     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6403     for (cl = 0; cl < closureSize*2; cl += 2) {
6404       const PetscInt p = closure[cl];
6405       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6406     }
6407     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6408     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6409   }
6410   for (c = cMax; c < cEnd; ++c) {
6411     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6412 
6413     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6414     for (cl = 0; cl < closureSize*2; cl += 2) {
6415       const PetscInt p = closure[cl];
6416       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6417     }
6418     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6419     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
6420   }
6421   PetscFunctionReturn(0);
6422 }
6423 
6424 #undef __FUNCT__
6425 #define __FUNCT__ "DMPlexCheckFaces"
6426 /*@
6427   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6428 
6429   Input Parameters:
6430 + dm - The DMPlex object
6431 . isSimplex - Are the cells simplices or tensor products
6432 - cellHeight - Normally 0
6433 
6434   Note: This is a useful diagnostic when creating meshes programmatically.
6435 
6436   Level: developer
6437 
6438 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6439 @*/
6440 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6441 {
6442   PetscInt       pMax[4];
6443   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6444   PetscErrorCode ierr;
6445 
6446   PetscFunctionBegin;
6447   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6448   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6449   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6450   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6451   for (h = cellHeight; h < dim; ++h) {
6452     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6453     for (c = cStart; c < cEnd; ++c) {
6454       const PetscInt *cone, *ornt, *faces;
6455       PetscInt        numFaces, faceSize, coneSize,f;
6456       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6457 
6458       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6459       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6460       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6461       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6462       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6463       for (cl = 0; cl < closureSize*2; cl += 2) {
6464         const PetscInt p = closure[cl];
6465         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6466       }
6467       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6468       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
6469       for (f = 0; f < numFaces; ++f) {
6470         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6471 
6472         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6473         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6474           const PetscInt p = fclosure[cl];
6475           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6476         }
6477         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);
6478         for (v = 0; v < fnumCorners; ++v) {
6479           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]);
6480         }
6481         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6482       }
6483       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6484       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6485     }
6486   }
6487   PetscFunctionReturn(0);
6488 }
6489 
6490 #undef __FUNCT__
6491 #define __FUNCT__ "DMCreateInterpolation_Plex"
6492 /* Pointwise interpolation
6493      Just code FEM for now
6494      u^f = I u^c
6495      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6496      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6497      I_{ij} = psi^f_i phi^c_j
6498 */
6499 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6500 {
6501   PetscSection   gsc, gsf;
6502   PetscInt       m, n;
6503   void          *ctx;
6504   PetscErrorCode ierr;
6505 
6506   PetscFunctionBegin;
6507   /*
6508   Loop over coarse cells
6509     Loop over coarse basis functions
6510       Loop over fine cells in coarse cell
6511         Loop over fine dual basis functions
6512           Evaluate coarse basis on fine dual basis quad points
6513           Sum
6514           Update local element matrix
6515     Accumulate to interpolation matrix
6516 
6517    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
6518   */
6519   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6520   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6521   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6522   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6523   /* FAS fails without a scaling vector */
6524   ierr = DMCreateGlobalVector(dmCoarse, scaling);CHKERRQ(ierr);
6525   ierr = VecSet(*scaling, 1.0);CHKERRQ(ierr);
6526   /* We need to preallocate properly */
6527   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6528   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6529   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6530   ierr = MatSetUp(*interpolation);CHKERRQ(ierr);
6531   ierr = MatSetFromOptions(*interpolation);CHKERRQ(ierr);
6532   ierr = MatSetOption(*interpolation, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
6533   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6534   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
6535   PetscFunctionReturn(0);
6536 }
6537 
6538 #undef __FUNCT__
6539 #define __FUNCT__ "DMCreateInjection_Plex"
6540 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
6541 {
6542   Vec             cv,  fv;
6543   IS              cis, fis, fpointIS;
6544   PetscSection    sc, gsc, gsf;
6545   const PetscInt *fpoints;
6546   PetscInt       *cindices, *findices;
6547   PetscInt        cpStart, cpEnd, m, off, cp;
6548   PetscErrorCode  ierr;
6549 
6550   PetscFunctionBegin;
6551   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6552   ierr = DMGetGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6553   ierr = DMGetDefaultSection(dmCoarse, &sc);CHKERRQ(ierr);
6554   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6555   ierr = DMGetGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6556   ierr = DMPlexCreateCoarsePointIS(dmCoarse, &fpointIS);CHKERRQ(ierr);
6557   ierr = PetscSectionGetConstrainedStorageSize(gsc, &m);CHKERRQ(ierr);
6558   ierr = PetscMalloc2(m,&cindices,m,&findices);CHKERRQ(ierr);
6559   ierr = PetscSectionGetChart(gsc, &cpStart, &cpEnd);CHKERRQ(ierr);
6560   ierr = ISGetIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6561   for (cp = cpStart, off = 0; cp < cpEnd; ++cp) {
6562     const PetscInt *cdofsC = NULL;
6563     PetscInt        fp     = fpoints[cp-cpStart], dofC, cdofC, dofF, offC, offF, d, e;
6564 
6565     ierr = PetscSectionGetDof(gsc, cp, &dofC);CHKERRQ(ierr);
6566     if (dofC <= 0) continue;
6567     ierr = PetscSectionGetConstraintDof(sc, cp, &cdofC);CHKERRQ(ierr);
6568     ierr = PetscSectionGetDof(gsf, fp, &dofF);CHKERRQ(ierr);
6569     ierr = PetscSectionGetOffset(gsc, cp, &offC);CHKERRQ(ierr);
6570     ierr = PetscSectionGetOffset(gsf, fp, &offF);CHKERRQ(ierr);
6571     if (cdofC) {ierr = PetscSectionGetConstraintIndices(sc, cp, &cdofsC);CHKERRQ(ierr);}
6572     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);
6573     if (offC < 0 || offF < 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Coarse point %d has invalid offset %d (%d)", cp, offC, offF);
6574     for (d = 0, e = 0; d < dofC; ++d) {
6575       if (cdofsC && cdofsC[e] == d) {++e; continue;}
6576       cindices[off+d-e] = offC+d; findices[off+d-e] = offF+d;
6577     }
6578     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);
6579     off += dofC-cdofC;
6580   }
6581   ierr = ISRestoreIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6582   if (off != m) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of coarse dofs %d != %d", off, m);
6583   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
6584   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
6585   ierr = VecScatterCreate(cv, cis, fv, fis, ctx);CHKERRQ(ierr);
6586   ierr = ISDestroy(&cis);CHKERRQ(ierr);
6587   ierr = ISDestroy(&fis);CHKERRQ(ierr);
6588   ierr = DMRestoreGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6589   ierr = DMRestoreGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6590   ierr = ISDestroy(&fpointIS);CHKERRQ(ierr);
6591   PetscFunctionReturn(0);
6592 }
6593 
6594 #undef __FUNCT__
6595 #define __FUNCT__ "DMCreateDefaultSection_Plex"
6596 /* Pointwise interpolation
6597      Just code FEM for now
6598      u^f = I u^c
6599      sum_k u^f_k phi^f_k = I sum_l u^c_l phi^c_l
6600      u^f_i = sum_l int psi^f_i I phi^c_l u^c_l
6601      I_{ij} = int psi^f_i phi^c_j
6602 */
6603 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6604 {
6605   PetscSection   section;
6606   IS            *bcPoints;
6607   PetscInt      *bcFields, *numComp, *numDof;
6608   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc, f;
6609   PetscErrorCode ierr;
6610 
6611   PetscFunctionBegin;
6612   /* Handle boundary conditions */
6613   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6614   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6615   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
6616   for (bd = 0; bd < numBd; ++bd) {
6617     PetscBool isEssential;
6618     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6619     if (isEssential) ++numBC;
6620   }
6621   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
6622   for (bd = 0, bc = 0; bd < numBd; ++bd) {
6623     const char     *bdLabel;
6624     DMLabel         label;
6625     const PetscInt *values;
6626     PetscInt        field, numValues;
6627     PetscBool       isEssential, has;
6628 
6629     ierr = DMPlexGetBoundary(dm, bd, &isEssential, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6630     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
6631     ierr = DMPlexHasLabel(dm, bdLabel, &has);CHKERRQ(ierr);
6632     if (!has) {
6633       ierr = DMPlexCreateLabel(dm, bdLabel);CHKERRQ(ierr);
6634       ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6635       ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
6636     }
6637     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6638     ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6639     if (isEssential) {
6640       bcFields[bc] = field;
6641       ierr = DMPlexGetStratumIS(dm, bdLabel, values[0], &bcPoints[bc++]);CHKERRQ(ierr);
6642     }
6643   }
6644   /* Handle discretization */
6645   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6646   ierr = PetscMalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6647   for (f = 0; f < numFields; ++f) {
6648     PetscFE         fe;
6649     const PetscInt *numFieldDof;
6650     PetscInt        d;
6651 
6652     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6653     ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6654     ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6655     for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6656   }
6657   for (f = 0; f < numFields; ++f) {
6658     PetscInt d;
6659     for (d = 1; d < dim; ++d) {
6660       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.");
6661     }
6662   }
6663   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, &section);CHKERRQ(ierr);
6664   for (f = 0; f < numFields; ++f) {
6665     PetscFE     fe;
6666     const char *name;
6667 
6668     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6669     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6670     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6671   }
6672   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6673   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6674   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
6675   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
6676   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6677   PetscFunctionReturn(0);
6678 }
6679 
6680 #undef __FUNCT__
6681 #define __FUNCT__ "DMPlexGetCoarseDM"
6682 /*@
6683   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
6684 
6685   Input Parameter:
6686 . dm - The DMPlex object
6687 
6688   Output Parameter:
6689 . cdm - The coarse DM
6690 
6691   Level: intermediate
6692 
6693 .seealso: DMPlexSetCoarseDM()
6694 @*/
6695 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
6696 {
6697   PetscFunctionBegin;
6698   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6699   PetscValidPointer(cdm, 2);
6700   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
6701   PetscFunctionReturn(0);
6702 }
6703 
6704 #undef __FUNCT__
6705 #define __FUNCT__ "DMPlexSetCoarseDM"
6706 /*@
6707   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
6708 
6709   Input Parameters:
6710 + dm - The DMPlex object
6711 - cdm - The coarse DM
6712 
6713   Level: intermediate
6714 
6715 .seealso: DMPlexGetCoarseDM()
6716 @*/
6717 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
6718 {
6719   DM_Plex       *mesh;
6720   PetscErrorCode ierr;
6721 
6722   PetscFunctionBegin;
6723   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6724   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
6725   mesh = (DM_Plex *) dm->data;
6726   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
6727   mesh->coarseMesh = cdm;
6728   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
6729   PetscFunctionReturn(0);
6730 }
6731