xref: /petsc/src/dm/impls/plex/plex.c (revision 549a8adaff6731ed6395c8e2cb9f577347aa25e9)
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->pointmarkerlist);
3505   free(outputCtx->edgelist);
3506   free(outputCtx->edgemarkerlist);
3507   free(outputCtx->trianglelist);
3508   free(outputCtx->neighborlist);
3509   PetscFunctionReturn(0);
3510 }
3511 
3512 #undef __FUNCT__
3513 #define __FUNCT__ "DMPlexGenerate_Triangle"
3514 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3515 {
3516   MPI_Comm             comm;
3517   PetscInt             dim              = 2;
3518   const PetscBool      createConvexHull = PETSC_FALSE;
3519   const PetscBool      constrained      = PETSC_FALSE;
3520   struct triangulateio in;
3521   struct triangulateio out;
3522   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3523   PetscMPIInt          rank;
3524   PetscErrorCode       ierr;
3525 
3526   PetscFunctionBegin;
3527   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3528   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3529   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3530   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3531   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3532 
3533   in.numberofpoints = vEnd - vStart;
3534   if (in.numberofpoints > 0) {
3535     PetscSection coordSection;
3536     Vec          coordinates;
3537     PetscScalar *array;
3538 
3539     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3540     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3541     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3542     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3543     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3544     for (v = vStart; v < vEnd; ++v) {
3545       const PetscInt idx = v - vStart;
3546       PetscInt       off, d;
3547 
3548       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3549       for (d = 0; d < dim; ++d) {
3550         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3551       }
3552       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3553     }
3554     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3555   }
3556   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3557   in.numberofsegments = eEnd - eStart;
3558   if (in.numberofsegments > 0) {
3559     ierr = PetscMalloc1(in.numberofsegments*2, &in.segmentlist);CHKERRQ(ierr);
3560     ierr = PetscMalloc1(in.numberofsegments, &in.segmentmarkerlist);CHKERRQ(ierr);
3561     for (e = eStart; e < eEnd; ++e) {
3562       const PetscInt  idx = e - eStart;
3563       const PetscInt *cone;
3564 
3565       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3566 
3567       in.segmentlist[idx*2+0] = cone[0] - vStart;
3568       in.segmentlist[idx*2+1] = cone[1] - vStart;
3569 
3570       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3571     }
3572   }
3573 #if 0 /* Do not currently support holes */
3574   PetscReal *holeCoords;
3575   PetscInt   h, d;
3576 
3577   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3578   if (in.numberofholes > 0) {
3579     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3580     for (h = 0; h < in.numberofholes; ++h) {
3581       for (d = 0; d < dim; ++d) {
3582         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3583       }
3584     }
3585   }
3586 #endif
3587   if (!rank) {
3588     char args[32];
3589 
3590     /* Take away 'Q' for verbose output */
3591     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3592     if (createConvexHull) {
3593       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3594     }
3595     if (constrained) {
3596       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3597     }
3598     triangulate(args, &in, &out, NULL);
3599   }
3600   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3601   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3602   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3603   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3604   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3605 
3606   {
3607     const PetscInt numCorners  = 3;
3608     const PetscInt numCells    = out.numberoftriangles;
3609     const PetscInt numVertices = out.numberofpoints;
3610     const int     *cells      = out.trianglelist;
3611     const double  *meshCoords = out.pointlist;
3612 
3613     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3614     /* Set labels */
3615     for (v = 0; v < numVertices; ++v) {
3616       if (out.pointmarkerlist[v]) {
3617         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3618       }
3619     }
3620     if (interpolate) {
3621       for (e = 0; e < out.numberofedges; e++) {
3622         if (out.edgemarkerlist[e]) {
3623           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3624           const PetscInt *edges;
3625           PetscInt        numEdges;
3626 
3627           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3628           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3629           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3630           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3631         }
3632       }
3633     }
3634     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3635   }
3636 #if 0 /* Do not currently support holes */
3637   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3638 #endif
3639   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3640   PetscFunctionReturn(0);
3641 }
3642 
3643 #undef __FUNCT__
3644 #define __FUNCT__ "DMPlexRefine_Triangle"
3645 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3646 {
3647   MPI_Comm             comm;
3648   PetscInt             dim  = 2;
3649   struct triangulateio in;
3650   struct triangulateio out;
3651   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3652   PetscMPIInt          rank;
3653   PetscErrorCode       ierr;
3654 
3655   PetscFunctionBegin;
3656   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3657   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3658   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3659   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3660   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3661   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3662   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3663 
3664   in.numberofpoints = vEnd - vStart;
3665   if (in.numberofpoints > 0) {
3666     PetscSection coordSection;
3667     Vec          coordinates;
3668     PetscScalar *array;
3669 
3670     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3671     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3672     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3673     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3674     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3675     for (v = vStart; v < vEnd; ++v) {
3676       const PetscInt idx = v - vStart;
3677       PetscInt       off, d;
3678 
3679       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3680       for (d = 0; d < dim; ++d) {
3681         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3682       }
3683       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3684     }
3685     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3686   }
3687   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3688 
3689   in.numberofcorners   = 3;
3690   in.numberoftriangles = cEnd - cStart;
3691 
3692   in.trianglearealist  = (double*) maxVolumes;
3693   if (in.numberoftriangles > 0) {
3694     ierr = PetscMalloc1(in.numberoftriangles*in.numberofcorners, &in.trianglelist);CHKERRQ(ierr);
3695     for (c = cStart; c < cEnd; ++c) {
3696       const PetscInt idx      = c - cStart;
3697       PetscInt      *closure = NULL;
3698       PetscInt       closureSize;
3699 
3700       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3701       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3702       for (v = 0; v < 3; ++v) {
3703         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3704       }
3705       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3706     }
3707   }
3708   /* TODO: Segment markers are missing on input */
3709 #if 0 /* Do not currently support holes */
3710   PetscReal *holeCoords;
3711   PetscInt   h, d;
3712 
3713   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3714   if (in.numberofholes > 0) {
3715     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3716     for (h = 0; h < in.numberofholes; ++h) {
3717       for (d = 0; d < dim; ++d) {
3718         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3719       }
3720     }
3721   }
3722 #endif
3723   if (!rank) {
3724     char args[32];
3725 
3726     /* Take away 'Q' for verbose output */
3727     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3728     triangulate(args, &in, &out, NULL);
3729   }
3730   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3731   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3732   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3733   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3734   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3735 
3736   {
3737     const PetscInt numCorners  = 3;
3738     const PetscInt numCells    = out.numberoftriangles;
3739     const PetscInt numVertices = out.numberofpoints;
3740     const int     *cells      = out.trianglelist;
3741     const double  *meshCoords = out.pointlist;
3742     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3743 
3744     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3745     /* Set labels */
3746     for (v = 0; v < numVertices; ++v) {
3747       if (out.pointmarkerlist[v]) {
3748         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3749       }
3750     }
3751     if (interpolate) {
3752       PetscInt e;
3753 
3754       for (e = 0; e < out.numberofedges; e++) {
3755         if (out.edgemarkerlist[e]) {
3756           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3757           const PetscInt *edges;
3758           PetscInt        numEdges;
3759 
3760           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3761           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3762           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3763           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3764         }
3765       }
3766     }
3767     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3768   }
3769 #if 0 /* Do not currently support holes */
3770   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3771 #endif
3772   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3773   PetscFunctionReturn(0);
3774 }
3775 #endif
3776 
3777 #if defined(PETSC_HAVE_TETGEN)
3778 #include <tetgen.h>
3779 #undef __FUNCT__
3780 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3781 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3782 {
3783   MPI_Comm       comm;
3784   const PetscInt dim  = 3;
3785   ::tetgenio     in;
3786   ::tetgenio     out;
3787   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3788   PetscMPIInt    rank;
3789   PetscErrorCode ierr;
3790 
3791   PetscFunctionBegin;
3792   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3793   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3794   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3795   in.numberofpoints = vEnd - vStart;
3796   if (in.numberofpoints > 0) {
3797     PetscSection coordSection;
3798     Vec          coordinates;
3799     PetscScalar *array;
3800 
3801     in.pointlist       = new double[in.numberofpoints*dim];
3802     in.pointmarkerlist = new int[in.numberofpoints];
3803 
3804     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3805     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3806     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3807     for (v = vStart; v < vEnd; ++v) {
3808       const PetscInt idx = v - vStart;
3809       PetscInt       off, d;
3810 
3811       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3812       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3813       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3814     }
3815     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3816   }
3817   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3818 
3819   in.numberoffacets = fEnd - fStart;
3820   if (in.numberoffacets > 0) {
3821     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3822     in.facetmarkerlist = new int[in.numberoffacets];
3823     for (f = fStart; f < fEnd; ++f) {
3824       const PetscInt idx     = f - fStart;
3825       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3826 
3827       in.facetlist[idx].numberofpolygons = 1;
3828       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3829       in.facetlist[idx].numberofholes    = 0;
3830       in.facetlist[idx].holelist         = NULL;
3831 
3832       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3833       for (p = 0; p < numPoints*2; p += 2) {
3834         const PetscInt point = points[p];
3835         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3836       }
3837 
3838       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3839       poly->numberofvertices = numVertices;
3840       poly->vertexlist       = new int[poly->numberofvertices];
3841       for (v = 0; v < numVertices; ++v) {
3842         const PetscInt vIdx = points[v] - vStart;
3843         poly->vertexlist[v] = vIdx;
3844       }
3845       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3846       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3847     }
3848   }
3849   if (!rank) {
3850     char args[32];
3851 
3852     /* Take away 'Q' for verbose output */
3853     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3854     ::tetrahedralize(args, &in, &out);
3855   }
3856   {
3857     const PetscInt numCorners  = 4;
3858     const PetscInt numCells    = out.numberoftetrahedra;
3859     const PetscInt numVertices = out.numberofpoints;
3860     const double   *meshCoords = out.pointlist;
3861     int            *cells      = out.tetrahedronlist;
3862 
3863     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3864     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3865     /* Set labels */
3866     for (v = 0; v < numVertices; ++v) {
3867       if (out.pointmarkerlist[v]) {
3868         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3869       }
3870     }
3871     if (interpolate) {
3872       PetscInt e;
3873 
3874       for (e = 0; e < out.numberofedges; e++) {
3875         if (out.edgemarkerlist[e]) {
3876           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3877           const PetscInt *edges;
3878           PetscInt        numEdges;
3879 
3880           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3881           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3882           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3883           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3884         }
3885       }
3886       for (f = 0; f < out.numberoftrifaces; f++) {
3887         if (out.trifacemarkerlist[f]) {
3888           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3889           const PetscInt *faces;
3890           PetscInt        numFaces;
3891 
3892           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3893           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3894           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3895           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3896         }
3897       }
3898     }
3899     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3900   }
3901   PetscFunctionReturn(0);
3902 }
3903 
3904 #undef __FUNCT__
3905 #define __FUNCT__ "DMPlexRefine_Tetgen"
3906 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3907 {
3908   MPI_Comm       comm;
3909   const PetscInt dim  = 3;
3910   ::tetgenio     in;
3911   ::tetgenio     out;
3912   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3913   PetscMPIInt    rank;
3914   PetscErrorCode ierr;
3915 
3916   PetscFunctionBegin;
3917   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3918   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3919   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3920   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3921   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3922 
3923   in.numberofpoints = vEnd - vStart;
3924   if (in.numberofpoints > 0) {
3925     PetscSection coordSection;
3926     Vec          coordinates;
3927     PetscScalar *array;
3928 
3929     in.pointlist       = new double[in.numberofpoints*dim];
3930     in.pointmarkerlist = new int[in.numberofpoints];
3931 
3932     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3933     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3934     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3935     for (v = vStart; v < vEnd; ++v) {
3936       const PetscInt idx = v - vStart;
3937       PetscInt       off, d;
3938 
3939       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3940       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3941       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3942     }
3943     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3944   }
3945   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3946 
3947   in.numberofcorners       = 4;
3948   in.numberoftetrahedra    = cEnd - cStart;
3949   in.tetrahedronvolumelist = (double*) maxVolumes;
3950   if (in.numberoftetrahedra > 0) {
3951     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3952     for (c = cStart; c < cEnd; ++c) {
3953       const PetscInt idx      = c - cStart;
3954       PetscInt      *closure = NULL;
3955       PetscInt       closureSize;
3956 
3957       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3958       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3959       for (v = 0; v < 4; ++v) {
3960         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3961       }
3962       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3963     }
3964   }
3965   /* TODO: Put in boundary faces with markers */
3966   if (!rank) {
3967     char args[32];
3968 
3969     /* Take away 'Q' for verbose output */
3970     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3971     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3972     ::tetrahedralize(args, &in, &out);
3973   }
3974   in.tetrahedronvolumelist = NULL;
3975 
3976   {
3977     const PetscInt numCorners  = 4;
3978     const PetscInt numCells    = out.numberoftetrahedra;
3979     const PetscInt numVertices = out.numberofpoints;
3980     const double   *meshCoords = out.pointlist;
3981     int            *cells      = out.tetrahedronlist;
3982 
3983     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3984 
3985     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3986     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3987     /* Set labels */
3988     for (v = 0; v < numVertices; ++v) {
3989       if (out.pointmarkerlist[v]) {
3990         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3991       }
3992     }
3993     if (interpolate) {
3994       PetscInt e, f;
3995 
3996       for (e = 0; e < out.numberofedges; e++) {
3997         if (out.edgemarkerlist[e]) {
3998           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3999           const PetscInt *edges;
4000           PetscInt        numEdges;
4001 
4002           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4003           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4004           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
4005           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4006         }
4007       }
4008       for (f = 0; f < out.numberoftrifaces; f++) {
4009         if (out.trifacemarkerlist[f]) {
4010           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
4011           const PetscInt *faces;
4012           PetscInt        numFaces;
4013 
4014           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4015           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4016           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
4017           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4018         }
4019       }
4020     }
4021     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4022   }
4023   PetscFunctionReturn(0);
4024 }
4025 #endif
4026 
4027 #if defined(PETSC_HAVE_CTETGEN)
4028 #include <ctetgen.h>
4029 
4030 #undef __FUNCT__
4031 #define __FUNCT__ "DMPlexGenerate_CTetgen"
4032 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
4033 {
4034   MPI_Comm       comm;
4035   const PetscInt dim  = 3;
4036   PLC           *in, *out;
4037   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
4038   PetscMPIInt    rank;
4039   PetscErrorCode ierr;
4040 
4041   PetscFunctionBegin;
4042   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
4043   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4044   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4045   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
4046   ierr = PLCCreate(&in);CHKERRQ(ierr);
4047   ierr = PLCCreate(&out);CHKERRQ(ierr);
4048 
4049   in->numberofpoints = vEnd - vStart;
4050   if (in->numberofpoints > 0) {
4051     PetscSection coordSection;
4052     Vec          coordinates;
4053     PetscScalar *array;
4054 
4055     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4056     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4057     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
4058     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
4059     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4060     for (v = vStart; v < vEnd; ++v) {
4061       const PetscInt idx = v - vStart;
4062       PetscInt       off, d, m;
4063 
4064       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4065       for (d = 0; d < dim; ++d) {
4066         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4067       }
4068       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
4069 
4070       in->pointmarkerlist[idx] = (int) m;
4071     }
4072     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4073   }
4074   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
4075 
4076   in->numberoffacets = fEnd - fStart;
4077   if (in->numberoffacets > 0) {
4078     ierr = PetscMalloc1(in->numberoffacets, &in->facetlist);CHKERRQ(ierr);
4079     ierr = PetscMalloc1(in->numberoffacets,   &in->facetmarkerlist);CHKERRQ(ierr);
4080     for (f = fStart; f < fEnd; ++f) {
4081       const PetscInt idx     = f - fStart;
4082       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
4083       polygon       *poly;
4084 
4085       in->facetlist[idx].numberofpolygons = 1;
4086 
4087       ierr = PetscMalloc1(in->facetlist[idx].numberofpolygons, &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
4088 
4089       in->facetlist[idx].numberofholes    = 0;
4090       in->facetlist[idx].holelist         = NULL;
4091 
4092       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4093       for (p = 0; p < numPoints*2; p += 2) {
4094         const PetscInt point = points[p];
4095         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
4096       }
4097 
4098       poly                   = in->facetlist[idx].polygonlist;
4099       poly->numberofvertices = numVertices;
4100       ierr                   = PetscMalloc1(poly->numberofvertices, &poly->vertexlist);CHKERRQ(ierr);
4101       for (v = 0; v < numVertices; ++v) {
4102         const PetscInt vIdx = points[v] - vStart;
4103         poly->vertexlist[v] = vIdx;
4104       }
4105       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
4106       in->facetmarkerlist[idx] = (int) m;
4107       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4108     }
4109   }
4110   if (!rank) {
4111     TetGenOpts t;
4112 
4113     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4114     t.in        = boundary; /* Should go away */
4115     t.plc       = 1;
4116     t.quality   = 1;
4117     t.edgesout  = 1;
4118     t.zeroindex = 1;
4119     t.quiet     = 1;
4120     t.verbose   = verbose;
4121     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
4122     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4123   }
4124   {
4125     const PetscInt numCorners  = 4;
4126     const PetscInt numCells    = out->numberoftetrahedra;
4127     const PetscInt numVertices = out->numberofpoints;
4128     const double   *meshCoords = out->pointlist;
4129     int            *cells      = out->tetrahedronlist;
4130 
4131     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4132     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
4133     /* Set labels */
4134     for (v = 0; v < numVertices; ++v) {
4135       if (out->pointmarkerlist[v]) {
4136         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4137       }
4138     }
4139     if (interpolate) {
4140       PetscInt e;
4141 
4142       for (e = 0; e < out->numberofedges; e++) {
4143         if (out->edgemarkerlist[e]) {
4144           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4145           const PetscInt *edges;
4146           PetscInt        numEdges;
4147 
4148           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4149           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4150           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4151           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4152         }
4153       }
4154       for (f = 0; f < out->numberoftrifaces; f++) {
4155         if (out->trifacemarkerlist[f]) {
4156           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4157           const PetscInt *faces;
4158           PetscInt        numFaces;
4159 
4160           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4161           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4162           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4163           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4164         }
4165       }
4166     }
4167     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
4168   }
4169 
4170   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4171   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4172   PetscFunctionReturn(0);
4173 }
4174 
4175 #undef __FUNCT__
4176 #define __FUNCT__ "DMPlexRefine_CTetgen"
4177 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
4178 {
4179   MPI_Comm       comm;
4180   const PetscInt dim  = 3;
4181   PLC           *in, *out;
4182   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
4183   PetscMPIInt    rank;
4184   PetscErrorCode ierr;
4185 
4186   PetscFunctionBegin;
4187   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
4188   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4189   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4190   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4191   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
4192   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4193   ierr = PLCCreate(&in);CHKERRQ(ierr);
4194   ierr = PLCCreate(&out);CHKERRQ(ierr);
4195 
4196   in->numberofpoints = vEnd - vStart;
4197   if (in->numberofpoints > 0) {
4198     PetscSection coordSection;
4199     Vec          coordinates;
4200     PetscScalar *array;
4201 
4202     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4203     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4204     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4205     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4206     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4207     for (v = vStart; v < vEnd; ++v) {
4208       const PetscInt idx = v - vStart;
4209       PetscInt       off, d, m;
4210 
4211       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4212       for (d = 0; d < dim; ++d) {
4213         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4214       }
4215       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
4216 
4217       in->pointmarkerlist[idx] = (int) m;
4218     }
4219     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4220   }
4221   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4222 
4223   in->numberofcorners       = 4;
4224   in->numberoftetrahedra    = cEnd - cStart;
4225   in->tetrahedronvolumelist = maxVolumes;
4226   if (in->numberoftetrahedra > 0) {
4227     ierr = PetscMalloc1(in->numberoftetrahedra*in->numberofcorners, &in->tetrahedronlist);CHKERRQ(ierr);
4228     for (c = cStart; c < cEnd; ++c) {
4229       const PetscInt idx      = c - cStart;
4230       PetscInt      *closure = NULL;
4231       PetscInt       closureSize;
4232 
4233       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4234       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4235       for (v = 0; v < 4; ++v) {
4236         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4237       }
4238       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4239     }
4240   }
4241   if (!rank) {
4242     TetGenOpts t;
4243 
4244     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4245 
4246     t.in        = dm; /* Should go away */
4247     t.refine    = 1;
4248     t.varvolume = 1;
4249     t.quality   = 1;
4250     t.edgesout  = 1;
4251     t.zeroindex = 1;
4252     t.quiet     = 1;
4253     t.verbose   = verbose; /* Change this */
4254 
4255     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4256     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4257   }
4258   {
4259     const PetscInt numCorners  = 4;
4260     const PetscInt numCells    = out->numberoftetrahedra;
4261     const PetscInt numVertices = out->numberofpoints;
4262     const double   *meshCoords = out->pointlist;
4263     int            *cells      = out->tetrahedronlist;
4264     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4265 
4266     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4267     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4268     /* Set labels */
4269     for (v = 0; v < numVertices; ++v) {
4270       if (out->pointmarkerlist[v]) {
4271         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4272       }
4273     }
4274     if (interpolate) {
4275       PetscInt e, f;
4276 
4277       for (e = 0; e < out->numberofedges; e++) {
4278         if (out->edgemarkerlist[e]) {
4279           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4280           const PetscInt *edges;
4281           PetscInt        numEdges;
4282 
4283           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4284           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4285           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4286           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4287         }
4288       }
4289       for (f = 0; f < out->numberoftrifaces; f++) {
4290         if (out->trifacemarkerlist[f]) {
4291           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4292           const PetscInt *faces;
4293           PetscInt        numFaces;
4294 
4295           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4296           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4297           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4298           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4299         }
4300       }
4301     }
4302     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4303   }
4304   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4305   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4306   PetscFunctionReturn(0);
4307 }
4308 #endif
4309 
4310 #undef __FUNCT__
4311 #define __FUNCT__ "DMPlexGenerate"
4312 /*@C
4313   DMPlexGenerate - Generates a mesh.
4314 
4315   Not Collective
4316 
4317   Input Parameters:
4318 + boundary - The DMPlex boundary object
4319 . name - The mesh generation package name
4320 - interpolate - Flag to create intermediate mesh elements
4321 
4322   Output Parameter:
4323 . mesh - The DMPlex object
4324 
4325   Level: intermediate
4326 
4327 .keywords: mesh, elements
4328 .seealso: DMPlexCreate(), DMRefine()
4329 @*/
4330 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4331 {
4332   PetscInt       dim;
4333   char           genname[1024];
4334   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4335   PetscErrorCode ierr;
4336 
4337   PetscFunctionBegin;
4338   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4339   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4340   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4341   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4342   if (flg) name = genname;
4343   if (name) {
4344     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4345     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4346     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4347   }
4348   switch (dim) {
4349   case 1:
4350     if (!name || isTriangle) {
4351 #if defined(PETSC_HAVE_TRIANGLE)
4352       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4353 #else
4354       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4355 #endif
4356     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4357     break;
4358   case 2:
4359     if (!name || isCTetgen) {
4360 #if defined(PETSC_HAVE_CTETGEN)
4361       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4362 #else
4363       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4364 #endif
4365     } else if (isTetgen) {
4366 #if defined(PETSC_HAVE_TETGEN)
4367       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4368 #else
4369       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4370 #endif
4371     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4372     break;
4373   default:
4374     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4375   }
4376   PetscFunctionReturn(0);
4377 }
4378 
4379 #undef __FUNCT__
4380 #define __FUNCT__ "DMRefine_Plex"
4381 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
4382 {
4383   PetscReal      refinementLimit;
4384   PetscInt       dim, cStart, cEnd;
4385   char           genname[1024], *name = NULL;
4386   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4387   PetscErrorCode ierr;
4388 
4389   PetscFunctionBegin;
4390   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4391   if (isUniform) {
4392     CellRefiner cellRefiner;
4393 
4394     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
4395     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
4396     PetscFunctionReturn(0);
4397   }
4398   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
4399   if (refinementLimit == 0.0) PetscFunctionReturn(0);
4400   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
4401   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4402   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4403   if (flg) name = genname;
4404   if (name) {
4405     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4406     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4407     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4408   }
4409   switch (dim) {
4410   case 2:
4411     if (!name || isTriangle) {
4412 #if defined(PETSC_HAVE_TRIANGLE)
4413       double  *maxVolumes;
4414       PetscInt c;
4415 
4416       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4417       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4418       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4419       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
4420 #else
4421       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
4422 #endif
4423     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4424     break;
4425   case 3:
4426     if (!name || isCTetgen) {
4427 #if defined(PETSC_HAVE_CTETGEN)
4428       PetscReal *maxVolumes;
4429       PetscInt   c;
4430 
4431       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4432       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4433       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4434 #else
4435       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4436 #endif
4437     } else if (isTetgen) {
4438 #if defined(PETSC_HAVE_TETGEN)
4439       double  *maxVolumes;
4440       PetscInt c;
4441 
4442       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4443       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4444       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4445 #else
4446       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4447 #endif
4448     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4449     break;
4450   default:
4451     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
4452   }
4453   PetscFunctionReturn(0);
4454 }
4455 
4456 #undef __FUNCT__
4457 #define __FUNCT__ "DMRefineHierarchy_Plex"
4458 PetscErrorCode DMRefineHierarchy_Plex(DM dm, PetscInt nlevels, DM dmRefined[])
4459 {
4460   DM             cdm = dm;
4461   PetscInt       r;
4462   PetscBool      isUniform;
4463   PetscErrorCode ierr;
4464 
4465   PetscFunctionBegin;
4466   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4467   if (!isUniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Non-uniform refinement is incompatible with the hierarchy");
4468   for (r = 0; r < nlevels; ++r) {
4469     CellRefiner cellRefiner;
4470 
4471     ierr = DMPlexGetCellRefiner_Internal(cdm, &cellRefiner);CHKERRQ(ierr);
4472     ierr = DMPlexRefineUniform_Internal(cdm, cellRefiner, &dmRefined[r]);CHKERRQ(ierr);
4473     ierr = DMPlexSetCoarseDM(dmRefined[r], cdm);CHKERRQ(ierr);
4474     cdm  = dmRefined[r];
4475   }
4476   PetscFunctionReturn(0);
4477 }
4478 
4479 #undef __FUNCT__
4480 #define __FUNCT__ "DMCoarsen_Plex"
4481 PetscErrorCode DMCoarsen_Plex(DM dm, MPI_Comm comm, DM *dmCoarsened)
4482 {
4483   DM_Plex       *mesh = (DM_Plex*) dm->data;
4484   PetscErrorCode ierr;
4485 
4486   PetscFunctionBegin;
4487   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
4488   *dmCoarsened = mesh->coarseMesh;
4489   PetscFunctionReturn(0);
4490 }
4491 
4492 #undef __FUNCT__
4493 #define __FUNCT__ "DMPlexGetDepthLabel"
4494 /*@
4495   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
4496 
4497   Not Collective
4498 
4499   Input Parameter:
4500 . dm    - The DMPlex object
4501 
4502   Output Parameter:
4503 . depthLabel - The DMLabel recording point depth
4504 
4505   Level: developer
4506 
4507 .keywords: mesh, points
4508 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4509 @*/
4510 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
4511 {
4512   DM_Plex       *mesh = (DM_Plex*) dm->data;
4513   PetscErrorCode ierr;
4514 
4515   PetscFunctionBegin;
4516   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4517   PetscValidPointer(depthLabel, 2);
4518   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
4519   *depthLabel = mesh->depthLabel;
4520   PetscFunctionReturn(0);
4521 }
4522 
4523 #undef __FUNCT__
4524 #define __FUNCT__ "DMPlexGetDepth"
4525 /*@
4526   DMPlexGetDepth - Get the depth of the DAG representing this mesh
4527 
4528   Not Collective
4529 
4530   Input Parameter:
4531 . dm    - The DMPlex object
4532 
4533   Output Parameter:
4534 . depth - The number of strata (breadth first levels) in the DAG
4535 
4536   Level: developer
4537 
4538 .keywords: mesh, points
4539 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4540 @*/
4541 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
4542 {
4543   DMLabel        label;
4544   PetscInt       d = 0;
4545   PetscErrorCode ierr;
4546 
4547   PetscFunctionBegin;
4548   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4549   PetscValidPointer(depth, 2);
4550   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4551   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
4552   *depth = d-1;
4553   PetscFunctionReturn(0);
4554 }
4555 
4556 #undef __FUNCT__
4557 #define __FUNCT__ "DMPlexGetDepthStratum"
4558 /*@
4559   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
4560 
4561   Not Collective
4562 
4563   Input Parameters:
4564 + dm           - The DMPlex object
4565 - stratumValue - The requested depth
4566 
4567   Output Parameters:
4568 + start - The first point at this depth
4569 - end   - One beyond the last point at this depth
4570 
4571   Level: developer
4572 
4573 .keywords: mesh, points
4574 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
4575 @*/
4576 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4577 {
4578   DMLabel        label;
4579   PetscInt       pStart, pEnd;
4580   PetscErrorCode ierr;
4581 
4582   PetscFunctionBegin;
4583   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4584   if (start) {PetscValidPointer(start, 3); *start = 0;}
4585   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4586   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4587   if (pStart == pEnd) PetscFunctionReturn(0);
4588   if (stratumValue < 0) {
4589     if (start) *start = pStart;
4590     if (end)   *end   = pEnd;
4591     PetscFunctionReturn(0);
4592   }
4593   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4594   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
4595   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
4596   PetscFunctionReturn(0);
4597 }
4598 
4599 #undef __FUNCT__
4600 #define __FUNCT__ "DMPlexGetHeightStratum"
4601 /*@
4602   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4603 
4604   Not Collective
4605 
4606   Input Parameters:
4607 + dm           - The DMPlex object
4608 - stratumValue - The requested height
4609 
4610   Output Parameters:
4611 + start - The first point at this height
4612 - end   - One beyond the last point at this height
4613 
4614   Level: developer
4615 
4616 .keywords: mesh, points
4617 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4618 @*/
4619 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4620 {
4621   DMLabel        label;
4622   PetscInt       depth, pStart, pEnd;
4623   PetscErrorCode ierr;
4624 
4625   PetscFunctionBegin;
4626   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4627   if (start) {PetscValidPointer(start, 3); *start = 0;}
4628   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4629   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4630   if (pStart == pEnd) PetscFunctionReturn(0);
4631   if (stratumValue < 0) {
4632     if (start) *start = pStart;
4633     if (end)   *end   = pEnd;
4634     PetscFunctionReturn(0);
4635   }
4636   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4637   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4638   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4639   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4640   PetscFunctionReturn(0);
4641 }
4642 
4643 #undef __FUNCT__
4644 #define __FUNCT__ "DMPlexCreateSectionInitial"
4645 /* Set the number of dof on each point and separate by fields */
4646 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4647 {
4648   PetscInt      *numDofTot;
4649   PetscInt       depth, pStart = 0, pEnd = 0;
4650   PetscInt       p, d, dep, f;
4651   PetscErrorCode ierr;
4652 
4653   PetscFunctionBegin;
4654   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
4655   for (d = 0; d <= dim; ++d) {
4656     numDofTot[d] = 0;
4657     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4658   }
4659   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4660   if (numFields > 0) {
4661     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4662     if (numComp) {
4663       for (f = 0; f < numFields; ++f) {
4664         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4665       }
4666     }
4667   }
4668   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4669   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4670   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4671   for (dep = 0; dep <= depth; ++dep) {
4672     d    = dim == depth ? dep : (!dep ? 0 : dim);
4673     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
4674     for (p = pStart; p < pEnd; ++p) {
4675       for (f = 0; f < numFields; ++f) {
4676         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4677       }
4678       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4679     }
4680   }
4681   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4682   PetscFunctionReturn(0);
4683 }
4684 
4685 #undef __FUNCT__
4686 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4687 /* Set the number of dof on each point and separate by fields
4688    If constDof is PETSC_DETERMINE, constrain every dof on the point
4689 */
4690 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4691 {
4692   PetscInt       numFields;
4693   PetscInt       bc;
4694   PetscErrorCode ierr;
4695 
4696   PetscFunctionBegin;
4697   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4698   for (bc = 0; bc < numBC; ++bc) {
4699     PetscInt        field = 0;
4700     const PetscInt *idx;
4701     PetscInt        n, i;
4702 
4703     if (numFields) field = bcField[bc];
4704     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4705     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4706     for (i = 0; i < n; ++i) {
4707       const PetscInt p        = idx[i];
4708       PetscInt       numConst = constDof;
4709 
4710       /* Constrain every dof on the point */
4711       if (numConst < 0) {
4712         if (numFields) {
4713           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4714         } else {
4715           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4716         }
4717       }
4718       if (numFields) {
4719         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4720       }
4721       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4722     }
4723     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4724   }
4725   PetscFunctionReturn(0);
4726 }
4727 
4728 #undef __FUNCT__
4729 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4730 /* Set the constrained indices on each point and separate by fields */
4731 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4732 {
4733   PetscInt      *maxConstraints;
4734   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4735   PetscErrorCode ierr;
4736 
4737   PetscFunctionBegin;
4738   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4739   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4740   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
4741   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4742   for (p = pStart; p < pEnd; ++p) {
4743     PetscInt cdof;
4744 
4745     if (numFields) {
4746       for (f = 0; f < numFields; ++f) {
4747         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4748         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4749       }
4750     } else {
4751       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4752       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4753     }
4754   }
4755   for (f = 0; f < numFields; ++f) {
4756     maxConstraints[numFields] += maxConstraints[f];
4757   }
4758   if (maxConstraints[numFields]) {
4759     PetscInt *indices;
4760 
4761     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
4762     for (p = pStart; p < pEnd; ++p) {
4763       PetscInt cdof, d;
4764 
4765       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4766       if (cdof) {
4767         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4768         if (numFields) {
4769           PetscInt numConst = 0, foff = 0;
4770 
4771           for (f = 0; f < numFields; ++f) {
4772             PetscInt cfdof, fdof;
4773 
4774             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4775             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4776             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4777             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4778             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4779             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4780             numConst += cfdof;
4781             foff     += fdof;
4782           }
4783           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4784         } else {
4785           for (d = 0; d < cdof; ++d) indices[d] = d;
4786         }
4787         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4788       }
4789     }
4790     ierr = PetscFree(indices);CHKERRQ(ierr);
4791   }
4792   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4793   PetscFunctionReturn(0);
4794 }
4795 
4796 #undef __FUNCT__
4797 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4798 /* Set the constrained field indices on each point */
4799 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4800 {
4801   const PetscInt *points, *indices;
4802   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4803   PetscErrorCode  ierr;
4804 
4805   PetscFunctionBegin;
4806   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4807   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4808 
4809   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4810   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4811   if (!constraintIndices) {
4812     PetscInt *idx, i;
4813 
4814     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4815     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
4816     for (i = 0; i < maxDof; ++i) idx[i] = i;
4817     for (p = 0; p < numPoints; ++p) {
4818       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4819     }
4820     ierr = PetscFree(idx);CHKERRQ(ierr);
4821   } else {
4822     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4823     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4824     for (p = 0; p < numPoints; ++p) {
4825       PetscInt fcdof;
4826 
4827       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4828       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);
4829       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4830     }
4831     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4832   }
4833   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4834   PetscFunctionReturn(0);
4835 }
4836 
4837 #undef __FUNCT__
4838 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4839 /* Set the constrained indices on each point and separate by fields */
4840 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4841 {
4842   PetscInt      *indices;
4843   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4844   PetscErrorCode ierr;
4845 
4846   PetscFunctionBegin;
4847   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4848   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
4849   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4850   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4851   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4852   for (p = pStart; p < pEnd; ++p) {
4853     PetscInt cdof, d;
4854 
4855     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4856     if (cdof) {
4857       PetscInt numConst = 0, foff = 0;
4858 
4859       for (f = 0; f < numFields; ++f) {
4860         const PetscInt *fcind;
4861         PetscInt        fdof, fcdof;
4862 
4863         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4864         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4865         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4866         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4867         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4868         foff     += fdof;
4869         numConst += fcdof;
4870       }
4871       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4872       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4873     }
4874   }
4875   ierr = PetscFree(indices);CHKERRQ(ierr);
4876   PetscFunctionReturn(0);
4877 }
4878 
4879 #undef __FUNCT__
4880 #define __FUNCT__ "DMPlexCreateSection"
4881 /*@C
4882   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4883 
4884   Not Collective
4885 
4886   Input Parameters:
4887 + dm        - The DMPlex object
4888 . dim       - The spatial dimension of the problem
4889 . numFields - The number of fields in the problem
4890 . numComp   - An array of size numFields that holds the number of components for each field
4891 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4892 . numBC     - The number of boundary conditions
4893 . bcField   - An array of size numBC giving the field number for each boundry condition
4894 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4895 
4896   Output Parameter:
4897 . section - The PetscSection object
4898 
4899   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
4900   nubmer of dof for field 0 on each edge.
4901 
4902   Level: developer
4903 
4904   Fortran Notes:
4905   A Fortran 90 version is available as DMPlexCreateSectionF90()
4906 
4907 .keywords: mesh, elements
4908 .seealso: DMPlexCreate(), PetscSectionCreate()
4909 @*/
4910 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
4911 {
4912   PetscErrorCode ierr;
4913 
4914   PetscFunctionBegin;
4915   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4916   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4917   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4918   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4919   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
4920   PetscFunctionReturn(0);
4921 }
4922 
4923 #undef __FUNCT__
4924 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4925 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4926 {
4927   PetscSection   section;
4928   PetscErrorCode ierr;
4929 
4930   PetscFunctionBegin;
4931   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4932   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4933   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4934   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4935   PetscFunctionReturn(0);
4936 }
4937 
4938 #undef __FUNCT__
4939 #define __FUNCT__ "DMPlexGetConeSection"
4940 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4941 {
4942   DM_Plex *mesh = (DM_Plex*) dm->data;
4943 
4944   PetscFunctionBegin;
4945   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4946   if (section) *section = mesh->coneSection;
4947   PetscFunctionReturn(0);
4948 }
4949 
4950 #undef __FUNCT__
4951 #define __FUNCT__ "DMPlexGetSupportSection"
4952 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4953 {
4954   DM_Plex *mesh = (DM_Plex*) dm->data;
4955 
4956   PetscFunctionBegin;
4957   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4958   if (section) *section = mesh->supportSection;
4959   PetscFunctionReturn(0);
4960 }
4961 
4962 #undef __FUNCT__
4963 #define __FUNCT__ "DMPlexGetCones"
4964 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4965 {
4966   DM_Plex *mesh = (DM_Plex*) dm->data;
4967 
4968   PetscFunctionBegin;
4969   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4970   if (cones) *cones = mesh->cones;
4971   PetscFunctionReturn(0);
4972 }
4973 
4974 #undef __FUNCT__
4975 #define __FUNCT__ "DMPlexGetConeOrientations"
4976 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4977 {
4978   DM_Plex *mesh = (DM_Plex*) dm->data;
4979 
4980   PetscFunctionBegin;
4981   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4982   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4983   PetscFunctionReturn(0);
4984 }
4985 
4986 /******************************** FEM Support **********************************/
4987 
4988 #undef __FUNCT__
4989 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
4990 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4991 {
4992   PetscScalar    *array, *vArray;
4993   const PetscInt *cone, *coneO;
4994   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4995   PetscErrorCode  ierr;
4996 
4997   PetscFunctionBeginHot;
4998   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4999   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5000   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5001   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5002   if (!values || !*values) {
5003     if ((point >= pStart) && (point < pEnd)) {
5004       PetscInt dof;
5005 
5006       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5007       size += dof;
5008     }
5009     for (p = 0; p < numPoints; ++p) {
5010       const PetscInt cp = cone[p];
5011       PetscInt       dof;
5012 
5013       if ((cp < pStart) || (cp >= pEnd)) continue;
5014       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5015       size += dof;
5016     }
5017     if (!values) {
5018       if (csize) *csize = size;
5019       PetscFunctionReturn(0);
5020     }
5021     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
5022   } else {
5023     array = *values;
5024   }
5025   size = 0;
5026   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5027   if ((point >= pStart) && (point < pEnd)) {
5028     PetscInt     dof, off, d;
5029     PetscScalar *varr;
5030 
5031     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5032     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5033     varr = &vArray[off];
5034     for (d = 0; d < dof; ++d, ++offset) {
5035       array[offset] = varr[d];
5036     }
5037     size += dof;
5038   }
5039   for (p = 0; p < numPoints; ++p) {
5040     const PetscInt cp = cone[p];
5041     PetscInt       o  = coneO[p];
5042     PetscInt       dof, off, d;
5043     PetscScalar   *varr;
5044 
5045     if ((cp < pStart) || (cp >= pEnd)) continue;
5046     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5047     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
5048     varr = &vArray[off];
5049     if (o >= 0) {
5050       for (d = 0; d < dof; ++d, ++offset) {
5051         array[offset] = varr[d];
5052       }
5053     } else {
5054       for (d = dof-1; d >= 0; --d, ++offset) {
5055         array[offset] = varr[d];
5056       }
5057     }
5058     size += dof;
5059   }
5060   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5061   if (!*values) {
5062     if (csize) *csize = size;
5063     *values = array;
5064   } else {
5065     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5066     *csize = size;
5067   }
5068   PetscFunctionReturn(0);
5069 }
5070 
5071 #undef __FUNCT__
5072 #define __FUNCT__ "DMPlexVecGetClosure_Static"
5073 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5074 {
5075   PetscInt       offset = 0, p;
5076   PetscErrorCode ierr;
5077 
5078   PetscFunctionBeginHot;
5079   *size = 0;
5080   for (p = 0; p < numPoints*2; p += 2) {
5081     const PetscInt point = points[p];
5082     const PetscInt o     = points[p+1];
5083     PetscInt       dof, off, d;
5084     const PetscScalar *varr;
5085 
5086     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5087     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5088     varr = &vArray[off];
5089     if (o >= 0) {
5090       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
5091     } else {
5092       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
5093     }
5094   }
5095   *size = offset;
5096   PetscFunctionReturn(0);
5097 }
5098 
5099 #undef __FUNCT__
5100 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
5101 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5102 {
5103   PetscInt       offset = 0, f;
5104   PetscErrorCode ierr;
5105 
5106   PetscFunctionBeginHot;
5107   *size = 0;
5108   for (f = 0; f < numFields; ++f) {
5109     PetscInt fcomp, p;
5110 
5111     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5112     for (p = 0; p < numPoints*2; p += 2) {
5113       const PetscInt point = points[p];
5114       const PetscInt o     = points[p+1];
5115       PetscInt       fdof, foff, d, c;
5116       const PetscScalar *varr;
5117 
5118       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5119       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5120       varr = &vArray[foff];
5121       if (o >= 0) {
5122         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
5123       } else {
5124         for (d = fdof/fcomp-1; d >= 0; --d) {
5125           for (c = 0; c < fcomp; ++c, ++offset) {
5126             array[offset] = varr[d*fcomp+c];
5127           }
5128         }
5129       }
5130     }
5131   }
5132   *size = offset;
5133   PetscFunctionReturn(0);
5134 }
5135 
5136 #undef __FUNCT__
5137 #define __FUNCT__ "DMPlexVecGetClosure"
5138 /*@C
5139   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
5140 
5141   Not collective
5142 
5143   Input Parameters:
5144 + dm - The DM
5145 . section - The section describing the layout in v, or NULL to use the default section
5146 . v - The local vector
5147 - point - The sieve point in the DM
5148 
5149   Output Parameters:
5150 + csize - The number of values in the closure, or NULL
5151 - values - The array of values, which is a borrowed array and should not be freed
5152 
5153   Fortran Notes:
5154   Since it returns an array, this routine is only available in Fortran 90, and you must
5155   include petsc.h90 in your code.
5156 
5157   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5158 
5159   Level: intermediate
5160 
5161 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5162 @*/
5163 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5164 {
5165   PetscSection    clSection;
5166   IS              clPoints;
5167   PetscScalar    *array, *vArray;
5168   PetscInt       *points = NULL;
5169   const PetscInt *clp;
5170   PetscInt        depth, numFields, numPoints, size;
5171   PetscErrorCode  ierr;
5172 
5173   PetscFunctionBeginHot;
5174   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5175   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5176   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5177   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5178   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5179   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5180   if (depth == 1 && numFields < 2) {
5181     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
5182     PetscFunctionReturn(0);
5183   }
5184   /* Get points */
5185   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5186   if (!clPoints) {
5187     PetscInt pStart, pEnd, p, q;
5188 
5189     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5190     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5191     /* Compress out points not in the section */
5192     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5193       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5194         points[q*2]   = points[p];
5195         points[q*2+1] = points[p+1];
5196         ++q;
5197       }
5198     }
5199     numPoints = q;
5200   } else {
5201     PetscInt dof, off;
5202 
5203     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5204     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5205     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5206     numPoints = dof/2;
5207     points    = (PetscInt *) &clp[off];
5208   }
5209   /* Get array */
5210   if (!values || !*values) {
5211     PetscInt asize = 0, dof, p;
5212 
5213     for (p = 0; p < numPoints*2; p += 2) {
5214       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5215       asize += dof;
5216     }
5217     if (!values) {
5218       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5219       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5220       if (csize) *csize = asize;
5221       PetscFunctionReturn(0);
5222     }
5223     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
5224   } else {
5225     array = *values;
5226   }
5227   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5228   /* Get values */
5229   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
5230   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
5231   /* Cleanup points */
5232   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5233   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5234   /* Cleanup array */
5235   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5236   if (!*values) {
5237     if (csize) *csize = size;
5238     *values = array;
5239   } else {
5240     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5241     *csize = size;
5242   }
5243   PetscFunctionReturn(0);
5244 }
5245 
5246 #undef __FUNCT__
5247 #define __FUNCT__ "DMPlexVecRestoreClosure"
5248 /*@C
5249   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
5250 
5251   Not collective
5252 
5253   Input Parameters:
5254 + dm - The DM
5255 . section - The section describing the layout in v, or NULL to use the default section
5256 . v - The local vector
5257 . point - The sieve point in the DM
5258 . csize - The number of values in the closure, or NULL
5259 - values - The array of values, which is a borrowed array and should not be freed
5260 
5261   Fortran Notes:
5262   Since it returns an array, this routine is only available in Fortran 90, and you must
5263   include petsc.h90 in your code.
5264 
5265   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5266 
5267   Level: intermediate
5268 
5269 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5270 @*/
5271 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5272 {
5273   PetscInt       size = 0;
5274   PetscErrorCode ierr;
5275 
5276   PetscFunctionBegin;
5277   /* Should work without recalculating size */
5278   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
5279   PetscFunctionReturn(0);
5280 }
5281 
5282 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
5283 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
5284 
5285 #undef __FUNCT__
5286 #define __FUNCT__ "updatePoint_private"
5287 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[])
5288 {
5289   PetscInt        cdof;   /* The number of constraints on this point */
5290   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5291   PetscScalar    *a;
5292   PetscInt        off, cind = 0, k;
5293   PetscErrorCode  ierr;
5294 
5295   PetscFunctionBegin;
5296   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5297   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5298   a    = &array[off];
5299   if (!cdof || setBC) {
5300     if (orientation >= 0) {
5301       for (k = 0; k < dof; ++k) {
5302         fuse(&a[k], values[k]);
5303       }
5304     } else {
5305       for (k = 0; k < dof; ++k) {
5306         fuse(&a[k], values[dof-k-1]);
5307       }
5308     }
5309   } else {
5310     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5311     if (orientation >= 0) {
5312       for (k = 0; k < dof; ++k) {
5313         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5314         fuse(&a[k], values[k]);
5315       }
5316     } else {
5317       for (k = 0; k < dof; ++k) {
5318         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5319         fuse(&a[k], values[dof-k-1]);
5320       }
5321     }
5322   }
5323   PetscFunctionReturn(0);
5324 }
5325 
5326 #undef __FUNCT__
5327 #define __FUNCT__ "updatePointBC_private"
5328 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5329 {
5330   PetscInt        cdof;   /* The number of constraints on this point */
5331   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5332   PetscScalar    *a;
5333   PetscInt        off, cind = 0, k;
5334   PetscErrorCode  ierr;
5335 
5336   PetscFunctionBegin;
5337   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5338   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5339   a    = &array[off];
5340   if (cdof) {
5341     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5342     if (orientation >= 0) {
5343       for (k = 0; k < dof; ++k) {
5344         if ((cind < cdof) && (k == cdofs[cind])) {
5345           fuse(&a[k], values[k]);
5346           ++cind;
5347         }
5348       }
5349     } else {
5350       for (k = 0; k < dof; ++k) {
5351         if ((cind < cdof) && (k == cdofs[cind])) {
5352           fuse(&a[k], values[dof-k-1]);
5353           ++cind;
5354         }
5355       }
5356     }
5357   }
5358   PetscFunctionReturn(0);
5359 }
5360 
5361 #undef __FUNCT__
5362 #define __FUNCT__ "updatePointFields_private"
5363 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[])
5364 {
5365   PetscScalar    *a;
5366   PetscInt        fdof, foff, fcdof, foffset = *offset;
5367   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5368   PetscInt        cind = 0, k, c;
5369   PetscErrorCode  ierr;
5370 
5371   PetscFunctionBegin;
5372   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5373   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5374   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5375   a    = &array[foff];
5376   if (!fcdof || setBC) {
5377     if (o >= 0) {
5378       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
5379     } else {
5380       for (k = fdof/fcomp-1; k >= 0; --k) {
5381         for (c = 0; c < fcomp; ++c) {
5382           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5383         }
5384       }
5385     }
5386   } else {
5387     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5388     if (o >= 0) {
5389       for (k = 0; k < fdof; ++k) {
5390         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
5391         fuse(&a[k], values[foffset+k]);
5392       }
5393     } else {
5394       for (k = fdof/fcomp-1; k >= 0; --k) {
5395         for (c = 0; c < fcomp; ++c) {
5396           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
5397           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5398         }
5399       }
5400     }
5401   }
5402   *offset += fdof;
5403   PetscFunctionReturn(0);
5404 }
5405 
5406 #undef __FUNCT__
5407 #define __FUNCT__ "updatePointFieldsBC_private"
5408 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[])
5409 {
5410   PetscScalar    *a;
5411   PetscInt        fdof, foff, fcdof, foffset = *offset;
5412   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5413   PetscInt        cind = 0, k, c;
5414   PetscErrorCode  ierr;
5415 
5416   PetscFunctionBegin;
5417   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5418   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5419   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5420   a    = &array[foff];
5421   if (fcdof) {
5422     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5423     if (o >= 0) {
5424       for (k = 0; k < fdof; ++k) {
5425         if ((cind < fcdof) && (k == fcdofs[cind])) {
5426           fuse(&a[k], values[foffset+k]);
5427           ++cind;
5428         }
5429       }
5430     } else {
5431       for (k = fdof/fcomp-1; k >= 0; --k) {
5432         for (c = 0; c < fcomp; ++c) {
5433           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
5434             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5435             ++cind;
5436           }
5437         }
5438       }
5439     }
5440   }
5441   *offset += fdof;
5442   PetscFunctionReturn(0);
5443 }
5444 
5445 #undef __FUNCT__
5446 #define __FUNCT__ "DMPlexVecSetClosure_Static"
5447 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5448 {
5449   PetscScalar    *array;
5450   const PetscInt *cone, *coneO;
5451   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5452   PetscErrorCode  ierr;
5453 
5454   PetscFunctionBeginHot;
5455   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5456   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5457   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5458   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5459   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5460   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5461     const PetscInt cp = !p ? point : cone[p-1];
5462     const PetscInt o  = !p ? 0     : coneO[p-1];
5463 
5464     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5465     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5466     /* ADD_VALUES */
5467     {
5468       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5469       PetscScalar    *a;
5470       PetscInt        cdof, coff, cind = 0, k;
5471 
5472       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5473       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5474       a    = &array[coff];
5475       if (!cdof) {
5476         if (o >= 0) {
5477           for (k = 0; k < dof; ++k) {
5478             a[k] += values[off+k];
5479           }
5480         } else {
5481           for (k = 0; k < dof; ++k) {
5482             a[k] += values[off+dof-k-1];
5483           }
5484         }
5485       } else {
5486         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5487         if (o >= 0) {
5488           for (k = 0; k < dof; ++k) {
5489             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5490             a[k] += values[off+k];
5491           }
5492         } else {
5493           for (k = 0; k < dof; ++k) {
5494             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5495             a[k] += values[off+dof-k-1];
5496           }
5497         }
5498       }
5499     }
5500   }
5501   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5502   PetscFunctionReturn(0);
5503 }
5504 
5505 #undef __FUNCT__
5506 #define __FUNCT__ "DMPlexVecSetClosure"
5507 /*@C
5508   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5509 
5510   Not collective
5511 
5512   Input Parameters:
5513 + dm - The DM
5514 . section - The section describing the layout in v, or NULL to use the default section
5515 . v - The local vector
5516 . point - The sieve point in the DM
5517 . values - The array of values
5518 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5519 
5520   Fortran Notes:
5521   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5522 
5523   Level: intermediate
5524 
5525 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5526 @*/
5527 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5528 {
5529   PetscSection    clSection;
5530   IS              clPoints;
5531   PetscScalar    *array;
5532   PetscInt       *points = NULL;
5533   const PetscInt *clp;
5534   PetscInt        depth, numFields, numPoints, p;
5535   PetscErrorCode  ierr;
5536 
5537   PetscFunctionBeginHot;
5538   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5539   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5540   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5541   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5542   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5543   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5544   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5545     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5546     PetscFunctionReturn(0);
5547   }
5548   /* Get points */
5549   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5550   if (!clPoints) {
5551     PetscInt pStart, pEnd, q;
5552 
5553     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5554     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5555     /* Compress out points not in the section */
5556     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5557       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5558         points[q*2]   = points[p];
5559         points[q*2+1] = points[p+1];
5560         ++q;
5561       }
5562     }
5563     numPoints = q;
5564   } else {
5565     PetscInt dof, off;
5566 
5567     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5568     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5569     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5570     numPoints = dof/2;
5571     points    = (PetscInt *) &clp[off];
5572   }
5573   /* Get array */
5574   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5575   /* Get values */
5576   if (numFields > 0) {
5577     PetscInt offset = 0, fcomp, f;
5578     for (f = 0; f < numFields; ++f) {
5579       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5580       switch (mode) {
5581       case INSERT_VALUES:
5582         for (p = 0; p < numPoints*2; p += 2) {
5583           const PetscInt point = points[p];
5584           const PetscInt o     = points[p+1];
5585           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
5586         } break;
5587       case INSERT_ALL_VALUES:
5588         for (p = 0; p < numPoints*2; p += 2) {
5589           const PetscInt point = points[p];
5590           const PetscInt o     = points[p+1];
5591           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
5592         } break;
5593       case INSERT_BC_VALUES:
5594         for (p = 0; p < numPoints*2; p += 2) {
5595           const PetscInt point = points[p];
5596           const PetscInt o     = points[p+1];
5597           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
5598         } break;
5599       case ADD_VALUES:
5600         for (p = 0; p < numPoints*2; p += 2) {
5601           const PetscInt point = points[p];
5602           const PetscInt o     = points[p+1];
5603           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
5604         } break;
5605       case ADD_ALL_VALUES:
5606         for (p = 0; p < numPoints*2; p += 2) {
5607           const PetscInt point = points[p];
5608           const PetscInt o     = points[p+1];
5609           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
5610         } break;
5611       default:
5612         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5613       }
5614     }
5615   } else {
5616     PetscInt dof, off;
5617 
5618     switch (mode) {
5619     case INSERT_VALUES:
5620       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5621         PetscInt o = points[p+1];
5622         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5623         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5624       } break;
5625     case INSERT_ALL_VALUES:
5626       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5627         PetscInt o = points[p+1];
5628         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5629         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5630       } break;
5631     case INSERT_BC_VALUES:
5632       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5633         PetscInt o = points[p+1];
5634         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5635         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5636       } break;
5637     case ADD_VALUES:
5638       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5639         PetscInt o = points[p+1];
5640         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5641         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5642       } break;
5643     case ADD_ALL_VALUES:
5644       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5645         PetscInt o = points[p+1];
5646         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5647         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5648       } break;
5649     default:
5650       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5651     }
5652   }
5653   /* Cleanup points */
5654   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5655   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5656   /* Cleanup array */
5657   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5658   PetscFunctionReturn(0);
5659 }
5660 
5661 #undef __FUNCT__
5662 #define __FUNCT__ "DMPlexPrintMatSetValues"
5663 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5664 {
5665   PetscMPIInt    rank;
5666   PetscInt       i, j;
5667   PetscErrorCode ierr;
5668 
5669   PetscFunctionBegin;
5670   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5671   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5672   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5673   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5674   numCIndices = numCIndices ? numCIndices : numRIndices;
5675   for (i = 0; i < numRIndices; i++) {
5676     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5677     for (j = 0; j < numCIndices; j++) {
5678 #if defined(PETSC_USE_COMPLEX)
5679       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5680 #else
5681       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5682 #endif
5683     }
5684     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5685   }
5686   PetscFunctionReturn(0);
5687 }
5688 
5689 #undef __FUNCT__
5690 #define __FUNCT__ "indicesPoint_private"
5691 /* . off - The global offset of this point */
5692 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5693 {
5694   PetscInt        dof;    /* The number of unknowns on this point */
5695   PetscInt        cdof;   /* The number of constraints on this point */
5696   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5697   PetscInt        cind = 0, k;
5698   PetscErrorCode  ierr;
5699 
5700   PetscFunctionBegin;
5701   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5702   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5703   if (!cdof || setBC) {
5704     if (orientation >= 0) {
5705       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5706     } else {
5707       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5708     }
5709   } else {
5710     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5711     if (orientation >= 0) {
5712       for (k = 0; k < dof; ++k) {
5713         if ((cind < cdof) && (k == cdofs[cind])) {
5714           /* Insert check for returning constrained indices */
5715           indices[*loff+k] = -(off+k+1);
5716           ++cind;
5717         } else {
5718           indices[*loff+k] = off+k-cind;
5719         }
5720       }
5721     } else {
5722       for (k = 0; k < dof; ++k) {
5723         if ((cind < cdof) && (k == cdofs[cind])) {
5724           /* Insert check for returning constrained indices */
5725           indices[*loff+dof-k-1] = -(off+k+1);
5726           ++cind;
5727         } else {
5728           indices[*loff+dof-k-1] = off+k-cind;
5729         }
5730       }
5731     }
5732   }
5733   *loff += dof;
5734   PetscFunctionReturn(0);
5735 }
5736 
5737 #undef __FUNCT__
5738 #define __FUNCT__ "indicesPointFields_private"
5739 /* . off - The global offset of this point */
5740 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5741 {
5742   PetscInt       numFields, foff, f;
5743   PetscErrorCode ierr;
5744 
5745   PetscFunctionBegin;
5746   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5747   for (f = 0, foff = 0; f < numFields; ++f) {
5748     PetscInt        fdof, fcomp, cfdof;
5749     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5750     PetscInt        cind = 0, k, c;
5751 
5752     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5753     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5754     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5755     if (!cfdof || setBC) {
5756       if (orientation >= 0) {
5757         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5758       } else {
5759         for (k = fdof/fcomp-1; k >= 0; --k) {
5760           for (c = 0; c < fcomp; ++c) {
5761             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5762           }
5763         }
5764       }
5765     } else {
5766       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5767       if (orientation >= 0) {
5768         for (k = 0; k < fdof; ++k) {
5769           if ((cind < cfdof) && (k == fcdofs[cind])) {
5770             indices[foffs[f]+k] = -(off+foff+k+1);
5771             ++cind;
5772           } else {
5773             indices[foffs[f]+k] = off+foff+k-cind;
5774           }
5775         }
5776       } else {
5777         for (k = fdof/fcomp-1; k >= 0; --k) {
5778           for (c = 0; c < fcomp; ++c) {
5779             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5780               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5781               ++cind;
5782             } else {
5783               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5784             }
5785           }
5786         }
5787       }
5788     }
5789     foff     += fdof - cfdof;
5790     foffs[f] += fdof;
5791   }
5792   PetscFunctionReturn(0);
5793 }
5794 
5795 #undef __FUNCT__
5796 #define __FUNCT__ "DMPlexMatSetClosure"
5797 /*@C
5798   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5799 
5800   Not collective
5801 
5802   Input Parameters:
5803 + dm - The DM
5804 . section - The section describing the layout in v, or NULL to use the default section
5805 . globalSection - The section describing the layout in v, or NULL to use the default global section
5806 . A - The matrix
5807 . point - The sieve point in the DM
5808 . values - The array of values
5809 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5810 
5811   Fortran Notes:
5812   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5813 
5814   Level: intermediate
5815 
5816 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5817 @*/
5818 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5819 {
5820   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5821   PetscSection    clSection;
5822   IS              clPoints;
5823   PetscInt       *points = NULL;
5824   const PetscInt *clp;
5825   PetscInt       *indices;
5826   PetscInt        offsets[32];
5827   PetscInt        numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5828   PetscErrorCode  ierr;
5829 
5830   PetscFunctionBegin;
5831   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5832   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5833   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5834   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5835   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5836   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5837   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5838   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5839   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5840   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5841   if (!clPoints) {
5842     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5843     /* Compress out points not in the section */
5844     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5845     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5846       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5847         points[q*2]   = points[p];
5848         points[q*2+1] = points[p+1];
5849         ++q;
5850       }
5851     }
5852     numPoints = q;
5853   } else {
5854     PetscInt dof, off;
5855 
5856     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5857     numPoints = dof/2;
5858     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5859     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5860     points = (PetscInt *) &clp[off];
5861   }
5862   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5863     PetscInt fdof;
5864 
5865     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5866     for (f = 0; f < numFields; ++f) {
5867       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5868       offsets[f+1] += fdof;
5869     }
5870     numIndices += dof;
5871   }
5872   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5873 
5874   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5875   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5876   if (numFields) {
5877     for (p = 0; p < numPoints*2; p += 2) {
5878       PetscInt o = points[p+1];
5879       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5880       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5881     }
5882   } else {
5883     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5884       PetscInt o = points[p+1];
5885       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5886       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5887     }
5888   }
5889   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5890   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5891   if (ierr) {
5892     PetscMPIInt    rank;
5893     PetscErrorCode ierr2;
5894 
5895     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5896     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5897     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5898     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5899     CHKERRQ(ierr);
5900   }
5901   if (!clPoints) {
5902     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5903   } else {
5904     ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5905   }
5906   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5907   PetscFunctionReturn(0);
5908 }
5909 
5910 #undef __FUNCT__
5911 #define __FUNCT__ "DMPlexMatSetClosureRefined"
5912 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5913 {
5914   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5915   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5916   PetscInt       *cpoints = NULL;
5917   PetscInt       *findices, *cindices;
5918   PetscInt        foffsets[32], coffsets[32];
5919   CellRefiner     cellRefiner;
5920   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5921   PetscErrorCode  ierr;
5922 
5923   PetscFunctionBegin;
5924   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5925   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5926   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5927   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5928   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5929   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5930   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5931   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5932   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5933   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5934   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5935   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5936   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5937   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5938   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5939   /* Column indices */
5940   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5941   maxFPoints = numCPoints;
5942   /* Compress out points not in the section */
5943   /*   TODO: Squeeze out points with 0 dof as well */
5944   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5945   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5946     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5947       cpoints[q*2]   = cpoints[p];
5948       cpoints[q*2+1] = cpoints[p+1];
5949       ++q;
5950     }
5951   }
5952   numCPoints = q;
5953   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5954     PetscInt fdof;
5955 
5956     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5957     if (!dof) continue;
5958     for (f = 0; f < numFields; ++f) {
5959       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5960       coffsets[f+1] += fdof;
5961     }
5962     numCIndices += dof;
5963   }
5964   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5965   /* Row indices */
5966   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5967   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5968   ierr = DMGetWorkArray(dmf, maxFPoints*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5969   for (r = 0, q = 0; r < numSubcells; ++r) {
5970     /* TODO Map from coarse to fine cells */
5971     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5972     /* Compress out points not in the section */
5973     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5974     for (p = 0; p < numFPoints*2; p += 2) {
5975       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5976         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5977         if (!dof) continue;
5978         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5979         if (s < q) continue;
5980         ftotpoints[q*2]   = fpoints[p];
5981         ftotpoints[q*2+1] = fpoints[p+1];
5982         ++q;
5983       }
5984     }
5985     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5986   }
5987   numFPoints = q;
5988   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5989     PetscInt fdof;
5990 
5991     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5992     if (!dof) continue;
5993     for (f = 0; f < numFields; ++f) {
5994       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5995       foffsets[f+1] += fdof;
5996     }
5997     numFIndices += dof;
5998   }
5999   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6000 
6001   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
6002   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
6003   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
6004   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
6005   if (numFields) {
6006     for (p = 0; p < numFPoints*2; p += 2) {
6007       PetscInt o = ftotpoints[p+1];
6008       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6009       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
6010     }
6011     for (p = 0; p < numCPoints*2; p += 2) {
6012       PetscInt o = cpoints[p+1];
6013       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6014       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
6015     }
6016   } else {
6017     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
6018       PetscInt o = ftotpoints[p+1];
6019       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6020       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
6021     }
6022     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
6023       PetscInt o = cpoints[p+1];
6024       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6025       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
6026     }
6027   }
6028   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6029   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6030   if (ierr) {
6031     PetscMPIInt    rank;
6032     PetscErrorCode ierr2;
6033 
6034     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6035     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6036     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6037     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
6038     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
6039     CHKERRQ(ierr);
6040   }
6041   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
6042   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6043   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
6044   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
6045   PetscFunctionReturn(0);
6046 }
6047 
6048 #undef __FUNCT__
6049 #define __FUNCT__ "DMPlexGetHybridBounds"
6050 /*@
6051   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
6052 
6053   Input Parameter:
6054 . dm - The DMPlex object
6055 
6056   Output Parameters:
6057 + cMax - The first hybrid cell
6058 . cMax - The first hybrid face
6059 . cMax - The first hybrid edge
6060 - cMax - The first hybrid vertex
6061 
6062   Level: developer
6063 
6064 .seealso DMPlexCreateHybridMesh()
6065 @*/
6066 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
6067 {
6068   DM_Plex       *mesh = (DM_Plex*) dm->data;
6069   PetscInt       dim;
6070   PetscErrorCode ierr;
6071 
6072   PetscFunctionBegin;
6073   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6074   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6075   if (cMax) *cMax = mesh->hybridPointMax[dim];
6076   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
6077   if (eMax) *eMax = mesh->hybridPointMax[1];
6078   if (vMax) *vMax = mesh->hybridPointMax[0];
6079   PetscFunctionReturn(0);
6080 }
6081 
6082 #undef __FUNCT__
6083 #define __FUNCT__ "DMPlexSetHybridBounds"
6084 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6085 {
6086   DM_Plex       *mesh = (DM_Plex*) dm->data;
6087   PetscInt       dim;
6088   PetscErrorCode ierr;
6089 
6090   PetscFunctionBegin;
6091   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6092   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6093   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
6094   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
6095   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
6096   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
6097   PetscFunctionReturn(0);
6098 }
6099 
6100 #undef __FUNCT__
6101 #define __FUNCT__ "DMPlexGetVTKCellHeight"
6102 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6103 {
6104   DM_Plex *mesh = (DM_Plex*) dm->data;
6105 
6106   PetscFunctionBegin;
6107   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6108   PetscValidPointer(cellHeight, 2);
6109   *cellHeight = mesh->vtkCellHeight;
6110   PetscFunctionReturn(0);
6111 }
6112 
6113 #undef __FUNCT__
6114 #define __FUNCT__ "DMPlexSetVTKCellHeight"
6115 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6116 {
6117   DM_Plex *mesh = (DM_Plex*) dm->data;
6118 
6119   PetscFunctionBegin;
6120   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6121   mesh->vtkCellHeight = cellHeight;
6122   PetscFunctionReturn(0);
6123 }
6124 
6125 #undef __FUNCT__
6126 #define __FUNCT__ "DMPlexCreateNumbering_Private"
6127 /* We can easily have a form that takes an IS instead */
6128 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
6129 {
6130   PetscSection   section, globalSection;
6131   PetscInt      *numbers, p;
6132   PetscErrorCode ierr;
6133 
6134   PetscFunctionBegin;
6135   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6136   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6137   for (p = pStart; p < pEnd; ++p) {
6138     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6139   }
6140   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6141   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6142   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
6143   for (p = pStart; p < pEnd; ++p) {
6144     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6145   }
6146   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6147   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6148   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6149   PetscFunctionReturn(0);
6150 }
6151 
6152 #undef __FUNCT__
6153 #define __FUNCT__ "DMPlexGetCellNumbering"
6154 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6155 {
6156   DM_Plex       *mesh = (DM_Plex*) dm->data;
6157   PetscInt       cellHeight, cStart, cEnd, cMax;
6158   PetscErrorCode ierr;
6159 
6160   PetscFunctionBegin;
6161   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6162   if (!mesh->globalCellNumbers) {
6163     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6164     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6165     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6166     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
6167     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
6168   }
6169   *globalCellNumbers = mesh->globalCellNumbers;
6170   PetscFunctionReturn(0);
6171 }
6172 
6173 #undef __FUNCT__
6174 #define __FUNCT__ "DMPlexGetVertexNumbering"
6175 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6176 {
6177   DM_Plex       *mesh = (DM_Plex*) dm->data;
6178   PetscInt       vStart, vEnd, vMax;
6179   PetscErrorCode ierr;
6180 
6181   PetscFunctionBegin;
6182   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6183   if (!mesh->globalVertexNumbers) {
6184     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6185     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6186     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
6187     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
6188   }
6189   *globalVertexNumbers = mesh->globalVertexNumbers;
6190   PetscFunctionReturn(0);
6191 }
6192 
6193 
6194 #undef __FUNCT__
6195 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
6196 /*@C
6197   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
6198   the local section and an SF describing the section point overlap.
6199 
6200   Input Parameters:
6201   + s - The PetscSection for the local field layout
6202   . sf - The SF describing parallel layout of the section points
6203   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
6204   . label - The label specifying the points
6205   - labelValue - The label stratum specifying the points
6206 
6207   Output Parameter:
6208   . gsection - The PetscSection for the global field layout
6209 
6210   Note: This gives negative sizes and offsets to points not owned by this process
6211 
6212   Level: developer
6213 
6214 .seealso: PetscSectionCreate()
6215 @*/
6216 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
6217 {
6218   PetscInt      *neg = NULL, *tmpOff = NULL;
6219   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
6220   PetscErrorCode ierr;
6221 
6222   PetscFunctionBegin;
6223   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
6224   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
6225   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
6226   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
6227   if (nroots >= 0) {
6228     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
6229     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
6230     if (nroots > pEnd-pStart) {
6231       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
6232     } else {
6233       tmpOff = &(*gsection)->atlasDof[-pStart];
6234     }
6235   }
6236   /* Mark ghost points with negative dof */
6237   for (p = pStart; p < pEnd; ++p) {
6238     PetscInt value;
6239 
6240     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6241     if (value != labelValue) continue;
6242     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6243     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6244     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6245     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6246     if (neg) neg[p] = -(dof+1);
6247   }
6248   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6249   if (nroots >= 0) {
6250     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6251     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6252     if (nroots > pEnd-pStart) {
6253       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6254     }
6255   }
6256   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6257   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6258     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6259     (*gsection)->atlasOff[p] = off;
6260     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6261   }
6262   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
6263   globalOff -= off;
6264   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6265     (*gsection)->atlasOff[p] += globalOff;
6266     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6267   }
6268   /* Put in negative offsets for ghost points */
6269   if (nroots >= 0) {
6270     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6271     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6272     if (nroots > pEnd-pStart) {
6273       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6274     }
6275   }
6276   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6277   ierr = PetscFree(neg);CHKERRQ(ierr);
6278   PetscFunctionReturn(0);
6279 }
6280 
6281 #undef __FUNCT__
6282 #define __FUNCT__ "DMPlexCheckSymmetry"
6283 /*@
6284   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6285 
6286   Input Parameters:
6287   + dm - The DMPlex object
6288 
6289   Note: This is a useful diagnostic when creating meshes programmatically.
6290 
6291   Level: developer
6292 
6293 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6294 @*/
6295 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6296 {
6297   PetscSection    coneSection, supportSection;
6298   const PetscInt *cone, *support;
6299   PetscInt        coneSize, c, supportSize, s;
6300   PetscInt        pStart, pEnd, p, csize, ssize;
6301   PetscErrorCode  ierr;
6302 
6303   PetscFunctionBegin;
6304   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6305   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6306   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6307   /* Check that point p is found in the support of its cone points, and vice versa */
6308   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6309   for (p = pStart; p < pEnd; ++p) {
6310     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6311     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6312     for (c = 0; c < coneSize; ++c) {
6313       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6314       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6315       for (s = 0; s < supportSize; ++s) {
6316         if (support[s] == p) break;
6317       }
6318       if (s >= supportSize) {
6319         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6320         for (s = 0; s < coneSize; ++s) {
6321           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6322         }
6323         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6324         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6325         for (s = 0; s < supportSize; ++s) {
6326           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6327         }
6328         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6329         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6330       }
6331     }
6332     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6333     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6334     for (s = 0; s < supportSize; ++s) {
6335       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6336       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6337       for (c = 0; c < coneSize; ++c) {
6338         if (cone[c] == p) break;
6339       }
6340       if (c >= coneSize) {
6341         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6342         for (c = 0; c < supportSize; ++c) {
6343           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6344         }
6345         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6346         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6347         for (c = 0; c < coneSize; ++c) {
6348           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6349         }
6350         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6351         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6352       }
6353     }
6354   }
6355   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6356   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6357   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6358   PetscFunctionReturn(0);
6359 }
6360 
6361 #undef __FUNCT__
6362 #define __FUNCT__ "DMPlexCheckSkeleton"
6363 /*@
6364   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6365 
6366   Input Parameters:
6367 + dm - The DMPlex object
6368 . isSimplex - Are the cells simplices or tensor products
6369 - cellHeight - Normally 0
6370 
6371   Note: This is a useful diagnostic when creating meshes programmatically.
6372 
6373   Level: developer
6374 
6375 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6376 @*/
6377 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6378 {
6379   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6380   PetscErrorCode ierr;
6381 
6382   PetscFunctionBegin;
6383   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6384   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6385   switch (dim) {
6386   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6387   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6388   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6389   default:
6390     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6391   }
6392   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6393   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6394   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6395   cMax = cMax >= 0 ? cMax : cEnd;
6396   for (c = cStart; c < cMax; ++c) {
6397     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6398 
6399     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6400     for (cl = 0; cl < closureSize*2; cl += 2) {
6401       const PetscInt p = closure[cl];
6402       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6403     }
6404     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6405     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6406   }
6407   for (c = cMax; c < cEnd; ++c) {
6408     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6409 
6410     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6411     for (cl = 0; cl < closureSize*2; cl += 2) {
6412       const PetscInt p = closure[cl];
6413       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6414     }
6415     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6416     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
6417   }
6418   PetscFunctionReturn(0);
6419 }
6420 
6421 #undef __FUNCT__
6422 #define __FUNCT__ "DMPlexCheckFaces"
6423 /*@
6424   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6425 
6426   Input Parameters:
6427 + dm - The DMPlex object
6428 . isSimplex - Are the cells simplices or tensor products
6429 - cellHeight - Normally 0
6430 
6431   Note: This is a useful diagnostic when creating meshes programmatically.
6432 
6433   Level: developer
6434 
6435 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6436 @*/
6437 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6438 {
6439   PetscInt       pMax[4];
6440   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6441   PetscErrorCode ierr;
6442 
6443   PetscFunctionBegin;
6444   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6445   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6446   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6447   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6448   for (h = cellHeight; h < dim; ++h) {
6449     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6450     for (c = cStart; c < cEnd; ++c) {
6451       const PetscInt *cone, *ornt, *faces;
6452       PetscInt        numFaces, faceSize, coneSize,f;
6453       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6454 
6455       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6456       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6457       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6458       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6459       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6460       for (cl = 0; cl < closureSize*2; cl += 2) {
6461         const PetscInt p = closure[cl];
6462         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6463       }
6464       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6465       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
6466       for (f = 0; f < numFaces; ++f) {
6467         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6468 
6469         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6470         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6471           const PetscInt p = fclosure[cl];
6472           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6473         }
6474         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);
6475         for (v = 0; v < fnumCorners; ++v) {
6476           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]);
6477         }
6478         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6479       }
6480       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6481       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6482     }
6483   }
6484   PetscFunctionReturn(0);
6485 }
6486 
6487 #undef __FUNCT__
6488 #define __FUNCT__ "DMCreateInterpolation_Plex"
6489 /* Pointwise interpolation
6490      Just code FEM for now
6491      u^f = I u^c
6492      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6493      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6494      I_{ij} = psi^f_i phi^c_j
6495 */
6496 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6497 {
6498   PetscSection   gsc, gsf;
6499   PetscInt       m, n;
6500   void          *ctx;
6501   PetscErrorCode ierr;
6502 
6503   PetscFunctionBegin;
6504   /*
6505   Loop over coarse cells
6506     Loop over coarse basis functions
6507       Loop over fine cells in coarse cell
6508         Loop over fine dual basis functions
6509           Evaluate coarse basis on fine dual basis quad points
6510           Sum
6511           Update local element matrix
6512     Accumulate to interpolation matrix
6513 
6514    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
6515   */
6516   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6517   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6518   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6519   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6520   /* FAS fails without a scaling vector */
6521   ierr = DMCreateGlobalVector(dmCoarse, scaling);CHKERRQ(ierr);
6522   ierr = VecSet(*scaling, 1.0);CHKERRQ(ierr);
6523   /* We need to preallocate properly */
6524   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6525   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6526   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6527   ierr = MatSetUp(*interpolation);CHKERRQ(ierr);
6528   ierr = MatSetFromOptions(*interpolation);CHKERRQ(ierr);
6529   ierr = MatSetOption(*interpolation, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
6530   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6531   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
6532   PetscFunctionReturn(0);
6533 }
6534 
6535 #undef __FUNCT__
6536 #define __FUNCT__ "DMCreateInjection_Plex"
6537 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
6538 {
6539   Vec             cv,  fv;
6540   IS              cis, fis, fpointIS;
6541   PetscSection    sc, gsc, gsf;
6542   const PetscInt *fpoints;
6543   PetscInt       *cindices, *findices;
6544   PetscInt        cpStart, cpEnd, m, off, cp;
6545   PetscErrorCode  ierr;
6546 
6547   PetscFunctionBegin;
6548   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6549   ierr = DMGetGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6550   ierr = DMGetDefaultSection(dmCoarse, &sc);CHKERRQ(ierr);
6551   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6552   ierr = DMGetGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6553   ierr = DMPlexCreateCoarsePointIS(dmCoarse, &fpointIS);CHKERRQ(ierr);
6554   ierr = PetscSectionGetConstrainedStorageSize(gsc, &m);CHKERRQ(ierr);
6555   ierr = PetscMalloc2(m,&cindices,m,&findices);CHKERRQ(ierr);
6556   ierr = PetscSectionGetChart(gsc, &cpStart, &cpEnd);CHKERRQ(ierr);
6557   ierr = ISGetIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6558   for (cp = cpStart, off = 0; cp < cpEnd; ++cp) {
6559     const PetscInt *cdofsC = NULL;
6560     PetscInt        fp     = fpoints[cp-cpStart], dofC, cdofC, dofF, offC, offF, d, e;
6561 
6562     ierr = PetscSectionGetDof(gsc, cp, &dofC);CHKERRQ(ierr);
6563     if (dofC <= 0) continue;
6564     ierr = PetscSectionGetConstraintDof(sc, cp, &cdofC);CHKERRQ(ierr);
6565     ierr = PetscSectionGetDof(gsf, fp, &dofF);CHKERRQ(ierr);
6566     ierr = PetscSectionGetOffset(gsc, cp, &offC);CHKERRQ(ierr);
6567     ierr = PetscSectionGetOffset(gsf, fp, &offF);CHKERRQ(ierr);
6568     if (cdofC) {ierr = PetscSectionGetConstraintIndices(sc, cp, &cdofsC);CHKERRQ(ierr);}
6569     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);
6570     if (offC < 0 || offF < 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Coarse point %d has invalid offset %d (%d)", cp, offC, offF);
6571     for (d = 0, e = 0; d < dofC; ++d) {
6572       if (cdofsC && cdofsC[e] == d) {++e; continue;}
6573       cindices[off+d-e] = offC+d; findices[off+d-e] = offF+d;
6574     }
6575     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);
6576     off += dofC-cdofC;
6577   }
6578   ierr = ISRestoreIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6579   if (off != m) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of coarse dofs %d != %d", off, m);
6580   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
6581   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
6582   ierr = VecScatterCreate(cv, cis, fv, fis, ctx);CHKERRQ(ierr);
6583   ierr = ISDestroy(&cis);CHKERRQ(ierr);
6584   ierr = ISDestroy(&fis);CHKERRQ(ierr);
6585   ierr = DMRestoreGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6586   ierr = DMRestoreGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6587   ierr = ISDestroy(&fpointIS);CHKERRQ(ierr);
6588   PetscFunctionReturn(0);
6589 }
6590 
6591 #undef __FUNCT__
6592 #define __FUNCT__ "DMCreateDefaultSection_Plex"
6593 /* Pointwise interpolation
6594      Just code FEM for now
6595      u^f = I u^c
6596      sum_k u^f_k phi^f_k = I sum_l u^c_l phi^c_l
6597      u^f_i = sum_l int psi^f_i I phi^c_l u^c_l
6598      I_{ij} = int psi^f_i phi^c_j
6599 */
6600 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6601 {
6602   PetscSection   section;
6603   IS            *bcPoints;
6604   PetscInt      *bcFields, *numComp, *numDof;
6605   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc, f;
6606   PetscErrorCode ierr;
6607 
6608   PetscFunctionBegin;
6609   /* Handle boundary conditions */
6610   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6611   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6612   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
6613   for (bd = 0; bd < numBd; ++bd) {
6614     PetscBool isEssential;
6615     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6616     if (isEssential) ++numBC;
6617   }
6618   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
6619   for (bd = 0, bc = 0; bd < numBd; ++bd) {
6620     const char     *bdLabel;
6621     DMLabel         label;
6622     const PetscInt *values;
6623     PetscInt        field, numValues;
6624     PetscBool       isEssential, has;
6625 
6626     ierr = DMPlexGetBoundary(dm, bd, &isEssential, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6627     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
6628     ierr = DMPlexHasLabel(dm, bdLabel, &has);CHKERRQ(ierr);
6629     if (!has) {
6630       ierr = DMPlexCreateLabel(dm, bdLabel);CHKERRQ(ierr);
6631       ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6632       ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
6633     }
6634     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6635     ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6636     if (isEssential) {
6637       bcFields[bc] = field;
6638       ierr = DMPlexGetStratumIS(dm, bdLabel, values[0], &bcPoints[bc++]);CHKERRQ(ierr);
6639     }
6640   }
6641   /* Handle discretization */
6642   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6643   ierr = PetscMalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6644   for (f = 0; f < numFields; ++f) {
6645     PetscFE         fe;
6646     const PetscInt *numFieldDof;
6647     PetscInt        d;
6648 
6649     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6650     ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6651     ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6652     for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6653   }
6654   for (f = 0; f < numFields; ++f) {
6655     PetscInt d;
6656     for (d = 1; d < dim; ++d) {
6657       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.");
6658     }
6659   }
6660   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, &section);CHKERRQ(ierr);
6661   for (f = 0; f < numFields; ++f) {
6662     PetscFE     fe;
6663     const char *name;
6664 
6665     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6666     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6667     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6668   }
6669   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6670   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6671   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
6672   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
6673   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6674   PetscFunctionReturn(0);
6675 }
6676 
6677 #undef __FUNCT__
6678 #define __FUNCT__ "DMPlexGetCoarseDM"
6679 /*@
6680   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
6681 
6682   Input Parameter:
6683 . dm - The DMPlex object
6684 
6685   Output Parameter:
6686 . cdm - The coarse DM
6687 
6688   Level: intermediate
6689 
6690 .seealso: DMPlexSetCoarseDM()
6691 @*/
6692 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
6693 {
6694   PetscFunctionBegin;
6695   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6696   PetscValidPointer(cdm, 2);
6697   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
6698   PetscFunctionReturn(0);
6699 }
6700 
6701 #undef __FUNCT__
6702 #define __FUNCT__ "DMPlexSetCoarseDM"
6703 /*@
6704   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
6705 
6706   Input Parameters:
6707 + dm - The DMPlex object
6708 - cdm - The coarse DM
6709 
6710   Level: intermediate
6711 
6712 .seealso: DMPlexGetCoarseDM()
6713 @*/
6714 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
6715 {
6716   DM_Plex       *mesh;
6717   PetscErrorCode ierr;
6718 
6719   PetscFunctionBegin;
6720   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6721   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
6722   mesh = (DM_Plex *) dm->data;
6723   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
6724   mesh->coarseMesh = cdm;
6725   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
6726   PetscFunctionReturn(0);
6727 }
6728