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