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