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