xref: /petsc/src/dm/impls/plex/plex.c (revision 563ffbab739d96c559dd28f4ad9be3f5bd74c24d)
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,        cellPart,        part;
2964   PetscSection           origCellPartSection, 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 cells in the original partition are not assigned to other procs */
3175       const PetscInt *origCells;
3176 
3177       ierr = ISGetIndices(origCellPart, &origCells);CHKERRQ(ierr);
3178       for (p = 0; p < numProcs; ++p) {
3179         PetscInt dof, off, d;
3180 
3181         ierr = PetscSectionGetDof(origCellPartSection, p, &dof);CHKERRQ(ierr);
3182         ierr = PetscSectionGetOffset(origCellPartSection, p, &off);CHKERRQ(ierr);
3183         for (d = off; d < off+dof; ++d) {
3184           rowners[origCells[d]].rank = p;
3185         }
3186       }
3187       ierr = ISRestoreIndices(origCellPart, &origCells);CHKERRQ(ierr);
3188     }
3189     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3190     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3191 
3192     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3193     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3194     for (p = 0; p < numLeaves; ++p) {
3195       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3196         lowners[p].rank  = rank;
3197         lowners[p].index = leaves ? leaves[p] : p;
3198       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3199         lowners[p].rank  = -2;
3200         lowners[p].index = -2;
3201       }
3202     }
3203     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3204       rowners[p].rank  = -3;
3205       rowners[p].index = -3;
3206     }
3207     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3208     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3209     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3210     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3211     for (p = 0; p < numLeaves; ++p) {
3212       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3213       if (lowners[p].rank != rank) ++numGhostPoints;
3214     }
3215     ierr = PetscMalloc(numGhostPoints * sizeof(PetscInt),    &ghostPoints);CHKERRQ(ierr);
3216     ierr = PetscMalloc(numGhostPoints * sizeof(PetscSFNode), &remotePoints);CHKERRQ(ierr);
3217     for (p = 0, gp = 0; p < numLeaves; ++p) {
3218       if (lowners[p].rank != rank) {
3219         ghostPoints[gp]        = leaves ? leaves[p] : p;
3220         remotePoints[gp].rank  = lowners[p].rank;
3221         remotePoints[gp].index = lowners[p].index;
3222         ++gp;
3223       }
3224     }
3225     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3226     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3227     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3228   }
3229   ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3230   /* Cleanup */
3231   if (sf) {*sf = pointSF;}
3232   else    {ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);}
3233   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3234   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3235   PetscFunctionReturn(0);
3236 }
3237 
3238 #undef __FUNCT__
3239 #define __FUNCT__ "DMPlexInvertCell"
3240 /*@C
3241   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3242 
3243   Input Parameters:
3244 + numCorners - The number of vertices in a cell
3245 - cone - The incoming cone
3246 
3247   Output Parameter:
3248 . cone - The inverted cone (in-place)
3249 
3250   Level: developer
3251 
3252 .seealso: DMPlexGenerate()
3253 @*/
3254 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3255 {
3256   int tmpc;
3257 
3258   PetscFunctionBegin;
3259   if (dim != 3) PetscFunctionReturn(0);
3260   switch (numCorners) {
3261   case 4:
3262     tmpc    = cone[0];
3263     cone[0] = cone[1];
3264     cone[1] = tmpc;
3265     break;
3266   case 8:
3267     tmpc    = cone[1];
3268     cone[1] = cone[3];
3269     cone[3] = tmpc;
3270     break;
3271   default: break;
3272   }
3273   PetscFunctionReturn(0);
3274 }
3275 
3276 #undef __FUNCT__
3277 #define __FUNCT__ "DMPlexInvertCells_Internal"
3278 /* This is to fix the tetrahedron orientation from TetGen */
3279 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3280 {
3281   PetscInt       bound = numCells*numCorners, coff;
3282   PetscErrorCode ierr;
3283 
3284   PetscFunctionBegin;
3285   for (coff = 0; coff < bound; coff += numCorners) {
3286     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3287   }
3288   PetscFunctionReturn(0);
3289 }
3290 
3291 #if defined(PETSC_HAVE_TRIANGLE)
3292 #include <triangle.h>
3293 
3294 #undef __FUNCT__
3295 #define __FUNCT__ "InitInput_Triangle"
3296 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3297 {
3298   PetscFunctionBegin;
3299   inputCtx->numberofpoints             = 0;
3300   inputCtx->numberofpointattributes    = 0;
3301   inputCtx->pointlist                  = NULL;
3302   inputCtx->pointattributelist         = NULL;
3303   inputCtx->pointmarkerlist            = NULL;
3304   inputCtx->numberofsegments           = 0;
3305   inputCtx->segmentlist                = NULL;
3306   inputCtx->segmentmarkerlist          = NULL;
3307   inputCtx->numberoftriangleattributes = 0;
3308   inputCtx->trianglelist               = NULL;
3309   inputCtx->numberofholes              = 0;
3310   inputCtx->holelist                   = NULL;
3311   inputCtx->numberofregions            = 0;
3312   inputCtx->regionlist                 = NULL;
3313   PetscFunctionReturn(0);
3314 }
3315 
3316 #undef __FUNCT__
3317 #define __FUNCT__ "InitOutput_Triangle"
3318 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3319 {
3320   PetscFunctionBegin;
3321   outputCtx->numberofpoints        = 0;
3322   outputCtx->pointlist             = NULL;
3323   outputCtx->pointattributelist    = NULL;
3324   outputCtx->pointmarkerlist       = NULL;
3325   outputCtx->numberoftriangles     = 0;
3326   outputCtx->trianglelist          = NULL;
3327   outputCtx->triangleattributelist = NULL;
3328   outputCtx->neighborlist          = NULL;
3329   outputCtx->segmentlist           = NULL;
3330   outputCtx->segmentmarkerlist     = NULL;
3331   outputCtx->numberofedges         = 0;
3332   outputCtx->edgelist              = NULL;
3333   outputCtx->edgemarkerlist        = NULL;
3334   PetscFunctionReturn(0);
3335 }
3336 
3337 #undef __FUNCT__
3338 #define __FUNCT__ "FiniOutput_Triangle"
3339 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3340 {
3341   PetscFunctionBegin;
3342   free(outputCtx->pointmarkerlist);
3343   free(outputCtx->edgelist);
3344   free(outputCtx->edgemarkerlist);
3345   free(outputCtx->trianglelist);
3346   free(outputCtx->neighborlist);
3347   PetscFunctionReturn(0);
3348 }
3349 
3350 #undef __FUNCT__
3351 #define __FUNCT__ "DMPlexGenerate_Triangle"
3352 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3353 {
3354   MPI_Comm             comm;
3355   PetscInt             dim              = 2;
3356   const PetscBool      createConvexHull = PETSC_FALSE;
3357   const PetscBool      constrained      = PETSC_FALSE;
3358   struct triangulateio in;
3359   struct triangulateio out;
3360   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3361   PetscMPIInt          rank;
3362   PetscErrorCode       ierr;
3363 
3364   PetscFunctionBegin;
3365   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3366   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3367   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3368   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3369   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3370 
3371   in.numberofpoints = vEnd - vStart;
3372   if (in.numberofpoints > 0) {
3373     PetscSection coordSection;
3374     Vec          coordinates;
3375     PetscScalar *array;
3376 
3377     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3378     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3379     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3380     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3381     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3382     for (v = vStart; v < vEnd; ++v) {
3383       const PetscInt idx = v - vStart;
3384       PetscInt       off, d;
3385 
3386       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3387       for (d = 0; d < dim; ++d) {
3388         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3389       }
3390       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3391     }
3392     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3393   }
3394   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3395   in.numberofsegments = eEnd - eStart;
3396   if (in.numberofsegments > 0) {
3397     ierr = PetscMalloc(in.numberofsegments*2 * sizeof(int), &in.segmentlist);CHKERRQ(ierr);
3398     ierr = PetscMalloc(in.numberofsegments   * sizeof(int), &in.segmentmarkerlist);CHKERRQ(ierr);
3399     for (e = eStart; e < eEnd; ++e) {
3400       const PetscInt  idx = e - eStart;
3401       const PetscInt *cone;
3402 
3403       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3404 
3405       in.segmentlist[idx*2+0] = cone[0] - vStart;
3406       in.segmentlist[idx*2+1] = cone[1] - vStart;
3407 
3408       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3409     }
3410   }
3411 #if 0 /* Do not currently support holes */
3412   PetscReal *holeCoords;
3413   PetscInt   h, d;
3414 
3415   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3416   if (in.numberofholes > 0) {
3417     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3418     for (h = 0; h < in.numberofholes; ++h) {
3419       for (d = 0; d < dim; ++d) {
3420         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3421       }
3422     }
3423   }
3424 #endif
3425   if (!rank) {
3426     char args[32];
3427 
3428     /* Take away 'Q' for verbose output */
3429     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3430     if (createConvexHull) {
3431       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3432     }
3433     if (constrained) {
3434       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3435     }
3436     triangulate(args, &in, &out, NULL);
3437   }
3438   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3439   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3440   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3441   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3442   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3443 
3444   {
3445     const PetscInt numCorners  = 3;
3446     const PetscInt numCells    = out.numberoftriangles;
3447     const PetscInt numVertices = out.numberofpoints;
3448     const int     *cells      = out.trianglelist;
3449     const double  *meshCoords = out.pointlist;
3450 
3451     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3452     /* Set labels */
3453     for (v = 0; v < numVertices; ++v) {
3454       if (out.pointmarkerlist[v]) {
3455         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3456       }
3457     }
3458     if (interpolate) {
3459       for (e = 0; e < out.numberofedges; e++) {
3460         if (out.edgemarkerlist[e]) {
3461           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3462           const PetscInt *edges;
3463           PetscInt        numEdges;
3464 
3465           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3466           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3467           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3468           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3469         }
3470       }
3471     }
3472     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3473   }
3474 #if 0 /* Do not currently support holes */
3475   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3476 #endif
3477   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3478   PetscFunctionReturn(0);
3479 }
3480 
3481 #undef __FUNCT__
3482 #define __FUNCT__ "DMPlexRefine_Triangle"
3483 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3484 {
3485   MPI_Comm             comm;
3486   PetscInt             dim  = 2;
3487   struct triangulateio in;
3488   struct triangulateio out;
3489   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3490   PetscMPIInt          rank;
3491   PetscErrorCode       ierr;
3492 
3493   PetscFunctionBegin;
3494   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3495   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3496   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3497   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3498   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3499   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3500   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3501 
3502   in.numberofpoints = vEnd - vStart;
3503   if (in.numberofpoints > 0) {
3504     PetscSection coordSection;
3505     Vec          coordinates;
3506     PetscScalar *array;
3507 
3508     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3509     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3510     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3511     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3512     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3513     for (v = vStart; v < vEnd; ++v) {
3514       const PetscInt idx = v - vStart;
3515       PetscInt       off, d;
3516 
3517       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3518       for (d = 0; d < dim; ++d) {
3519         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3520       }
3521       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3522     }
3523     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3524   }
3525   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3526 
3527   in.numberofcorners   = 3;
3528   in.numberoftriangles = cEnd - cStart;
3529 
3530   in.trianglearealist  = (double*) maxVolumes;
3531   if (in.numberoftriangles > 0) {
3532     ierr = PetscMalloc(in.numberoftriangles*in.numberofcorners * sizeof(int), &in.trianglelist);CHKERRQ(ierr);
3533     for (c = cStart; c < cEnd; ++c) {
3534       const PetscInt idx      = c - cStart;
3535       PetscInt      *closure = NULL;
3536       PetscInt       closureSize;
3537 
3538       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3539       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3540       for (v = 0; v < 3; ++v) {
3541         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3542       }
3543       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3544     }
3545   }
3546   /* TODO: Segment markers are missing on input */
3547 #if 0 /* Do not currently support holes */
3548   PetscReal *holeCoords;
3549   PetscInt   h, d;
3550 
3551   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3552   if (in.numberofholes > 0) {
3553     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3554     for (h = 0; h < in.numberofholes; ++h) {
3555       for (d = 0; d < dim; ++d) {
3556         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3557       }
3558     }
3559   }
3560 #endif
3561   if (!rank) {
3562     char args[32];
3563 
3564     /* Take away 'Q' for verbose output */
3565     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3566     triangulate(args, &in, &out, NULL);
3567   }
3568   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3569   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3570   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3571   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3572   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3573 
3574   {
3575     const PetscInt numCorners  = 3;
3576     const PetscInt numCells    = out.numberoftriangles;
3577     const PetscInt numVertices = out.numberofpoints;
3578     const int     *cells      = out.trianglelist;
3579     const double  *meshCoords = out.pointlist;
3580     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3581 
3582     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3583     /* Set labels */
3584     for (v = 0; v < numVertices; ++v) {
3585       if (out.pointmarkerlist[v]) {
3586         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3587       }
3588     }
3589     if (interpolate) {
3590       PetscInt e;
3591 
3592       for (e = 0; e < out.numberofedges; e++) {
3593         if (out.edgemarkerlist[e]) {
3594           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3595           const PetscInt *edges;
3596           PetscInt        numEdges;
3597 
3598           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3599           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3600           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3601           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3602         }
3603       }
3604     }
3605     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3606   }
3607 #if 0 /* Do not currently support holes */
3608   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3609 #endif
3610   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3611   PetscFunctionReturn(0);
3612 }
3613 #endif
3614 
3615 #if defined(PETSC_HAVE_TETGEN)
3616 #include <tetgen.h>
3617 #undef __FUNCT__
3618 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3619 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3620 {
3621   MPI_Comm       comm;
3622   const PetscInt dim  = 3;
3623   ::tetgenio     in;
3624   ::tetgenio     out;
3625   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3626   PetscMPIInt    rank;
3627   PetscErrorCode ierr;
3628 
3629   PetscFunctionBegin;
3630   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3631   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3632   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3633   in.numberofpoints = vEnd - vStart;
3634   if (in.numberofpoints > 0) {
3635     PetscSection coordSection;
3636     Vec          coordinates;
3637     PetscScalar *array;
3638 
3639     in.pointlist       = new double[in.numberofpoints*dim];
3640     in.pointmarkerlist = new int[in.numberofpoints];
3641 
3642     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3643     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3644     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3645     for (v = vStart; v < vEnd; ++v) {
3646       const PetscInt idx = v - vStart;
3647       PetscInt       off, d;
3648 
3649       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3650       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3651       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3652     }
3653     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3654   }
3655   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3656 
3657   in.numberoffacets = fEnd - fStart;
3658   if (in.numberoffacets > 0) {
3659     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3660     in.facetmarkerlist = new int[in.numberoffacets];
3661     for (f = fStart; f < fEnd; ++f) {
3662       const PetscInt idx     = f - fStart;
3663       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3664 
3665       in.facetlist[idx].numberofpolygons = 1;
3666       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3667       in.facetlist[idx].numberofholes    = 0;
3668       in.facetlist[idx].holelist         = NULL;
3669 
3670       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3671       for (p = 0; p < numPoints*2; p += 2) {
3672         const PetscInt point = points[p];
3673         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3674       }
3675 
3676       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3677       poly->numberofvertices = numVertices;
3678       poly->vertexlist       = new int[poly->numberofvertices];
3679       for (v = 0; v < numVertices; ++v) {
3680         const PetscInt vIdx = points[v] - vStart;
3681         poly->vertexlist[v] = vIdx;
3682       }
3683       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3684       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3685     }
3686   }
3687   if (!rank) {
3688     char args[32];
3689 
3690     /* Take away 'Q' for verbose output */
3691     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3692     ::tetrahedralize(args, &in, &out);
3693   }
3694   {
3695     const PetscInt numCorners  = 4;
3696     const PetscInt numCells    = out.numberoftetrahedra;
3697     const PetscInt numVertices = out.numberofpoints;
3698     const double   *meshCoords = out.pointlist;
3699     int            *cells      = out.tetrahedronlist;
3700 
3701     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3702     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3703     /* Set labels */
3704     for (v = 0; v < numVertices; ++v) {
3705       if (out.pointmarkerlist[v]) {
3706         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3707       }
3708     }
3709     if (interpolate) {
3710       PetscInt e;
3711 
3712       for (e = 0; e < out.numberofedges; e++) {
3713         if (out.edgemarkerlist[e]) {
3714           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3715           const PetscInt *edges;
3716           PetscInt        numEdges;
3717 
3718           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3719           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3720           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3721           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3722         }
3723       }
3724       for (f = 0; f < out.numberoftrifaces; f++) {
3725         if (out.trifacemarkerlist[f]) {
3726           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3727           const PetscInt *faces;
3728           PetscInt        numFaces;
3729 
3730           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3731           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3732           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3733           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3734         }
3735       }
3736     }
3737     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3738   }
3739   PetscFunctionReturn(0);
3740 }
3741 
3742 #undef __FUNCT__
3743 #define __FUNCT__ "DMPlexRefine_Tetgen"
3744 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3745 {
3746   MPI_Comm       comm;
3747   const PetscInt dim  = 3;
3748   ::tetgenio     in;
3749   ::tetgenio     out;
3750   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3751   PetscMPIInt    rank;
3752   PetscErrorCode ierr;
3753 
3754   PetscFunctionBegin;
3755   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3756   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3757   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3758   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3759   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3760 
3761   in.numberofpoints = vEnd - vStart;
3762   if (in.numberofpoints > 0) {
3763     PetscSection coordSection;
3764     Vec          coordinates;
3765     PetscScalar *array;
3766 
3767     in.pointlist       = new double[in.numberofpoints*dim];
3768     in.pointmarkerlist = new int[in.numberofpoints];
3769 
3770     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3771     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3772     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3773     for (v = vStart; v < vEnd; ++v) {
3774       const PetscInt idx = v - vStart;
3775       PetscInt       off, d;
3776 
3777       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3778       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3779       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3780     }
3781     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3782   }
3783   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3784 
3785   in.numberofcorners       = 4;
3786   in.numberoftetrahedra    = cEnd - cStart;
3787   in.tetrahedronvolumelist = (double*) maxVolumes;
3788   if (in.numberoftetrahedra > 0) {
3789     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3790     for (c = cStart; c < cEnd; ++c) {
3791       const PetscInt idx      = c - cStart;
3792       PetscInt      *closure = NULL;
3793       PetscInt       closureSize;
3794 
3795       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3796       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3797       for (v = 0; v < 4; ++v) {
3798         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3799       }
3800       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3801     }
3802   }
3803   /* TODO: Put in boundary faces with markers */
3804   if (!rank) {
3805     char args[32];
3806 
3807     /* Take away 'Q' for verbose output */
3808     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3809     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3810     ::tetrahedralize(args, &in, &out);
3811   }
3812   in.tetrahedronvolumelist = NULL;
3813 
3814   {
3815     const PetscInt numCorners  = 4;
3816     const PetscInt numCells    = out.numberoftetrahedra;
3817     const PetscInt numVertices = out.numberofpoints;
3818     const double   *meshCoords = out.pointlist;
3819     int            *cells      = out.tetrahedronlist;
3820 
3821     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3822 
3823     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3824     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3825     /* Set labels */
3826     for (v = 0; v < numVertices; ++v) {
3827       if (out.pointmarkerlist[v]) {
3828         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3829       }
3830     }
3831     if (interpolate) {
3832       PetscInt e, f;
3833 
3834       for (e = 0; e < out.numberofedges; e++) {
3835         if (out.edgemarkerlist[e]) {
3836           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3837           const PetscInt *edges;
3838           PetscInt        numEdges;
3839 
3840           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3841           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3842           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3843           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3844         }
3845       }
3846       for (f = 0; f < out.numberoftrifaces; f++) {
3847         if (out.trifacemarkerlist[f]) {
3848           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3849           const PetscInt *faces;
3850           PetscInt        numFaces;
3851 
3852           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3853           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3854           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3855           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3856         }
3857       }
3858     }
3859     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3860   }
3861   PetscFunctionReturn(0);
3862 }
3863 #endif
3864 
3865 #if defined(PETSC_HAVE_CTETGEN)
3866 #include "ctetgen.h"
3867 
3868 #undef __FUNCT__
3869 #define __FUNCT__ "DMPlexGenerate_CTetgen"
3870 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
3871 {
3872   MPI_Comm       comm;
3873   const PetscInt dim  = 3;
3874   PLC           *in, *out;
3875   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
3876   PetscMPIInt    rank;
3877   PetscErrorCode ierr;
3878 
3879   PetscFunctionBegin;
3880   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3881   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3882   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3883   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3884   ierr = PLCCreate(&in);CHKERRQ(ierr);
3885   ierr = PLCCreate(&out);CHKERRQ(ierr);
3886 
3887   in->numberofpoints = vEnd - vStart;
3888   if (in->numberofpoints > 0) {
3889     PetscSection coordSection;
3890     Vec          coordinates;
3891     PetscScalar *array;
3892 
3893     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
3894     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
3895     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3896     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3897     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3898     for (v = vStart; v < vEnd; ++v) {
3899       const PetscInt idx = v - vStart;
3900       PetscInt       off, d, m;
3901 
3902       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3903       for (d = 0; d < dim; ++d) {
3904         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3905       }
3906       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
3907 
3908       in->pointmarkerlist[idx] = (int) m;
3909     }
3910     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3911   }
3912   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3913 
3914   in->numberoffacets = fEnd - fStart;
3915   if (in->numberoffacets > 0) {
3916     ierr = PetscMalloc(in->numberoffacets * sizeof(facet), &in->facetlist);CHKERRQ(ierr);
3917     ierr = PetscMalloc(in->numberoffacets * sizeof(int),   &in->facetmarkerlist);CHKERRQ(ierr);
3918     for (f = fStart; f < fEnd; ++f) {
3919       const PetscInt idx     = f - fStart;
3920       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
3921       polygon       *poly;
3922 
3923       in->facetlist[idx].numberofpolygons = 1;
3924 
3925       ierr = PetscMalloc(in->facetlist[idx].numberofpolygons * sizeof(polygon), &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
3926 
3927       in->facetlist[idx].numberofholes    = 0;
3928       in->facetlist[idx].holelist         = NULL;
3929 
3930       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3931       for (p = 0; p < numPoints*2; p += 2) {
3932         const PetscInt point = points[p];
3933         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3934       }
3935 
3936       poly                   = in->facetlist[idx].polygonlist;
3937       poly->numberofvertices = numVertices;
3938       ierr                   = PetscMalloc(poly->numberofvertices * sizeof(int), &poly->vertexlist);CHKERRQ(ierr);
3939       for (v = 0; v < numVertices; ++v) {
3940         const PetscInt vIdx = points[v] - vStart;
3941         poly->vertexlist[v] = vIdx;
3942       }
3943       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
3944       in->facetmarkerlist[idx] = (int) m;
3945       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3946     }
3947   }
3948   if (!rank) {
3949     TetGenOpts t;
3950 
3951     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3952     t.in        = boundary; /* Should go away */
3953     t.plc       = 1;
3954     t.quality   = 1;
3955     t.edgesout  = 1;
3956     t.zeroindex = 1;
3957     t.quiet     = 1;
3958     t.verbose   = verbose;
3959     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
3960     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3961   }
3962   {
3963     const PetscInt numCorners  = 4;
3964     const PetscInt numCells    = out->numberoftetrahedra;
3965     const PetscInt numVertices = out->numberofpoints;
3966     const double   *meshCoords = out->pointlist;
3967     int            *cells      = out->tetrahedronlist;
3968 
3969     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3970     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3971     /* Set labels */
3972     for (v = 0; v < numVertices; ++v) {
3973       if (out->pointmarkerlist[v]) {
3974         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3975       }
3976     }
3977     if (interpolate) {
3978       PetscInt e;
3979 
3980       for (e = 0; e < out->numberofedges; e++) {
3981         if (out->edgemarkerlist[e]) {
3982           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3983           const PetscInt *edges;
3984           PetscInt        numEdges;
3985 
3986           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3987           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3988           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3989           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3990         }
3991       }
3992       for (f = 0; f < out->numberoftrifaces; f++) {
3993         if (out->trifacemarkerlist[f]) {
3994           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3995           const PetscInt *faces;
3996           PetscInt        numFaces;
3997 
3998           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3999           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4000           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4001           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4002         }
4003       }
4004     }
4005     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
4006   }
4007 
4008   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4009   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4010   PetscFunctionReturn(0);
4011 }
4012 
4013 #undef __FUNCT__
4014 #define __FUNCT__ "DMPlexRefine_CTetgen"
4015 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
4016 {
4017   MPI_Comm       comm;
4018   const PetscInt dim  = 3;
4019   PLC           *in, *out;
4020   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
4021   PetscMPIInt    rank;
4022   PetscErrorCode ierr;
4023 
4024   PetscFunctionBegin;
4025   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
4026   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4027   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4028   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4029   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
4030   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4031   ierr = PLCCreate(&in);CHKERRQ(ierr);
4032   ierr = PLCCreate(&out);CHKERRQ(ierr);
4033 
4034   in->numberofpoints = vEnd - vStart;
4035   if (in->numberofpoints > 0) {
4036     PetscSection coordSection;
4037     Vec          coordinates;
4038     PetscScalar *array;
4039 
4040     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
4041     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
4042     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4043     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4044     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4045     for (v = vStart; v < vEnd; ++v) {
4046       const PetscInt idx = v - vStart;
4047       PetscInt       off, d, m;
4048 
4049       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4050       for (d = 0; d < dim; ++d) {
4051         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4052       }
4053       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
4054 
4055       in->pointmarkerlist[idx] = (int) m;
4056     }
4057     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4058   }
4059   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4060 
4061   in->numberofcorners       = 4;
4062   in->numberoftetrahedra    = cEnd - cStart;
4063   in->tetrahedronvolumelist = maxVolumes;
4064   if (in->numberoftetrahedra > 0) {
4065     ierr = PetscMalloc(in->numberoftetrahedra*in->numberofcorners * sizeof(int), &in->tetrahedronlist);CHKERRQ(ierr);
4066     for (c = cStart; c < cEnd; ++c) {
4067       const PetscInt idx      = c - cStart;
4068       PetscInt      *closure = NULL;
4069       PetscInt       closureSize;
4070 
4071       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4072       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4073       for (v = 0; v < 4; ++v) {
4074         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4075       }
4076       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4077     }
4078   }
4079   if (!rank) {
4080     TetGenOpts t;
4081 
4082     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4083 
4084     t.in        = dm; /* Should go away */
4085     t.refine    = 1;
4086     t.varvolume = 1;
4087     t.quality   = 1;
4088     t.edgesout  = 1;
4089     t.zeroindex = 1;
4090     t.quiet     = 1;
4091     t.verbose   = verbose; /* Change this */
4092 
4093     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4094     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4095   }
4096   {
4097     const PetscInt numCorners  = 4;
4098     const PetscInt numCells    = out->numberoftetrahedra;
4099     const PetscInt numVertices = out->numberofpoints;
4100     const double   *meshCoords = out->pointlist;
4101     int            *cells      = out->tetrahedronlist;
4102     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4103 
4104     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4105     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4106     /* Set labels */
4107     for (v = 0; v < numVertices; ++v) {
4108       if (out->pointmarkerlist[v]) {
4109         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4110       }
4111     }
4112     if (interpolate) {
4113       PetscInt e, f;
4114 
4115       for (e = 0; e < out->numberofedges; e++) {
4116         if (out->edgemarkerlist[e]) {
4117           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4118           const PetscInt *edges;
4119           PetscInt        numEdges;
4120 
4121           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4122           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4123           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4124           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4125         }
4126       }
4127       for (f = 0; f < out->numberoftrifaces; f++) {
4128         if (out->trifacemarkerlist[f]) {
4129           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4130           const PetscInt *faces;
4131           PetscInt        numFaces;
4132 
4133           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4134           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4135           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4136           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4137         }
4138       }
4139     }
4140     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4141   }
4142   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4143   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4144   PetscFunctionReturn(0);
4145 }
4146 #endif
4147 
4148 #undef __FUNCT__
4149 #define __FUNCT__ "DMPlexGenerate"
4150 /*@C
4151   DMPlexGenerate - Generates a mesh.
4152 
4153   Not Collective
4154 
4155   Input Parameters:
4156 + boundary - The DMPlex boundary object
4157 . name - The mesh generation package name
4158 - interpolate - Flag to create intermediate mesh elements
4159 
4160   Output Parameter:
4161 . mesh - The DMPlex object
4162 
4163   Level: intermediate
4164 
4165 .keywords: mesh, elements
4166 .seealso: DMPlexCreate(), DMRefine()
4167 @*/
4168 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4169 {
4170   PetscInt       dim;
4171   char           genname[1024];
4172   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4173   PetscErrorCode ierr;
4174 
4175   PetscFunctionBegin;
4176   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4177   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4178   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4179   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4180   if (flg) name = genname;
4181   if (name) {
4182     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4183     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4184     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4185   }
4186   switch (dim) {
4187   case 1:
4188     if (!name || isTriangle) {
4189 #if defined(PETSC_HAVE_TRIANGLE)
4190       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4191 #else
4192       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4193 #endif
4194     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4195     break;
4196   case 2:
4197     if (!name || isCTetgen) {
4198 #if defined(PETSC_HAVE_CTETGEN)
4199       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4200 #else
4201       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4202 #endif
4203     } else if (isTetgen) {
4204 #if defined(PETSC_HAVE_TETGEN)
4205       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4206 #else
4207       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4208 #endif
4209     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4210     break;
4211   default:
4212     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4213   }
4214   PetscFunctionReturn(0);
4215 }
4216 
4217 #undef __FUNCT__
4218 #define __FUNCT__ "DMRefine_Plex"
4219 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
4220 {
4221   PetscReal      refinementLimit;
4222   PetscInt       dim, cStart, cEnd;
4223   char           genname[1024], *name = NULL;
4224   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4225   PetscErrorCode ierr;
4226 
4227   PetscFunctionBegin;
4228   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4229   if (isUniform) {
4230     CellRefiner cellRefiner;
4231 
4232     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
4233     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
4234     PetscFunctionReturn(0);
4235   }
4236   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
4237   if (refinementLimit == 0.0) PetscFunctionReturn(0);
4238   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
4239   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4240   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4241   if (flg) name = genname;
4242   if (name) {
4243     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4244     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4245     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4246   }
4247   switch (dim) {
4248   case 2:
4249     if (!name || isTriangle) {
4250 #if defined(PETSC_HAVE_TRIANGLE)
4251       double  *maxVolumes;
4252       PetscInt c;
4253 
4254       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
4255       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4256       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4257       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
4258 #else
4259       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
4260 #endif
4261     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4262     break;
4263   case 3:
4264     if (!name || isCTetgen) {
4265 #if defined(PETSC_HAVE_CTETGEN)
4266       PetscReal *maxVolumes;
4267       PetscInt   c;
4268 
4269       ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscReal), &maxVolumes);CHKERRQ(ierr);
4270       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4271       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4272 #else
4273       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4274 #endif
4275     } else if (isTetgen) {
4276 #if defined(PETSC_HAVE_TETGEN)
4277       double  *maxVolumes;
4278       PetscInt c;
4279 
4280       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
4281       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4282       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4283 #else
4284       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4285 #endif
4286     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4287     break;
4288   default:
4289     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
4290   }
4291   PetscFunctionReturn(0);
4292 }
4293 
4294 #undef __FUNCT__
4295 #define __FUNCT__ "DMPlexGetDepthLabel"
4296 /*@
4297   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
4298 
4299   Not Collective
4300 
4301   Input Parameter:
4302 . dm    - The DMPlex object
4303 
4304   Output Parameter:
4305 . depthLabel - The DMLabel recording point depth
4306 
4307   Level: developer
4308 
4309 .keywords: mesh, points
4310 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4311 @*/
4312 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
4313 {
4314   DM_Plex       *mesh = (DM_Plex*) dm->data;
4315   PetscErrorCode ierr;
4316 
4317   PetscFunctionBegin;
4318   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4319   PetscValidPointer(depthLabel, 2);
4320   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
4321   *depthLabel = mesh->depthLabel;
4322   PetscFunctionReturn(0);
4323 }
4324 
4325 #undef __FUNCT__
4326 #define __FUNCT__ "DMPlexGetDepth"
4327 /*@
4328   DMPlexGetDepth - Get the depth of the DAG representing this mesh
4329 
4330   Not Collective
4331 
4332   Input Parameter:
4333 . dm    - The DMPlex object
4334 
4335   Output Parameter:
4336 . depth - The number of strata (breadth first levels) in the DAG
4337 
4338   Level: developer
4339 
4340 .keywords: mesh, points
4341 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4342 @*/
4343 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
4344 {
4345   DMLabel        label;
4346   PetscInt       d = 0;
4347   PetscErrorCode ierr;
4348 
4349   PetscFunctionBegin;
4350   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4351   PetscValidPointer(depth, 2);
4352   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4353   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
4354   *depth = d-1;
4355   PetscFunctionReturn(0);
4356 }
4357 
4358 #undef __FUNCT__
4359 #define __FUNCT__ "DMPlexGetDepthStratum"
4360 /*@
4361   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
4362 
4363   Not Collective
4364 
4365   Input Parameters:
4366 + dm           - The DMPlex object
4367 - stratumValue - The requested depth
4368 
4369   Output Parameters:
4370 + start - The first point at this depth
4371 - end   - One beyond the last point at this depth
4372 
4373   Level: developer
4374 
4375 .keywords: mesh, points
4376 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
4377 @*/
4378 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4379 {
4380   DMLabel        label;
4381   PetscInt       pStart, pEnd;
4382   PetscErrorCode ierr;
4383 
4384   PetscFunctionBegin;
4385   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4386   if (start) {PetscValidPointer(start, 3); *start = 0;}
4387   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4388   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4389   if (pStart == pEnd) PetscFunctionReturn(0);
4390   if (stratumValue < 0) {
4391     if (start) *start = pStart;
4392     if (end)   *end   = pEnd;
4393     PetscFunctionReturn(0);
4394   }
4395   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4396   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
4397   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
4398   PetscFunctionReturn(0);
4399 }
4400 
4401 #undef __FUNCT__
4402 #define __FUNCT__ "DMPlexGetHeightStratum"
4403 /*@
4404   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4405 
4406   Not Collective
4407 
4408   Input Parameters:
4409 + dm           - The DMPlex object
4410 - stratumValue - The requested height
4411 
4412   Output Parameters:
4413 + start - The first point at this height
4414 - end   - One beyond the last point at this height
4415 
4416   Level: developer
4417 
4418 .keywords: mesh, points
4419 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4420 @*/
4421 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4422 {
4423   DMLabel        label;
4424   PetscInt       depth, pStart, pEnd;
4425   PetscErrorCode ierr;
4426 
4427   PetscFunctionBegin;
4428   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4429   if (start) {PetscValidPointer(start, 3); *start = 0;}
4430   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4431   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4432   if (pStart == pEnd) PetscFunctionReturn(0);
4433   if (stratumValue < 0) {
4434     if (start) *start = pStart;
4435     if (end)   *end   = pEnd;
4436     PetscFunctionReturn(0);
4437   }
4438   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4439   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4440   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4441   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4442   PetscFunctionReturn(0);
4443 }
4444 
4445 #undef __FUNCT__
4446 #define __FUNCT__ "DMPlexCreateSectionInitial"
4447 /* Set the number of dof on each point and separate by fields */
4448 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4449 {
4450   PetscInt      *numDofTot;
4451   PetscInt       pStart = 0, pEnd = 0;
4452   PetscInt       p, d, f;
4453   PetscErrorCode ierr;
4454 
4455   PetscFunctionBegin;
4456   ierr = PetscMalloc((dim+1) * sizeof(PetscInt), &numDofTot);CHKERRQ(ierr);
4457   for (d = 0; d <= dim; ++d) {
4458     numDofTot[d] = 0;
4459     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4460   }
4461   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4462   if (numFields > 0) {
4463     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4464     if (numComp) {
4465       for (f = 0; f < numFields; ++f) {
4466         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4467       }
4468     }
4469   }
4470   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4471   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4472   for (d = 0; d <= dim; ++d) {
4473     ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
4474     for (p = pStart; p < pEnd; ++p) {
4475       for (f = 0; f < numFields; ++f) {
4476         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4477       }
4478       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4479     }
4480   }
4481   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4482   PetscFunctionReturn(0);
4483 }
4484 
4485 #undef __FUNCT__
4486 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4487 /* Set the number of dof on each point and separate by fields
4488    If constDof is PETSC_DETERMINE, constrain every dof on the point
4489 */
4490 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4491 {
4492   PetscInt       numFields;
4493   PetscInt       bc;
4494   PetscErrorCode ierr;
4495 
4496   PetscFunctionBegin;
4497   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4498   for (bc = 0; bc < numBC; ++bc) {
4499     PetscInt        field = 0;
4500     const PetscInt *idx;
4501     PetscInt        n, i;
4502 
4503     if (numFields) field = bcField[bc];
4504     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4505     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4506     for (i = 0; i < n; ++i) {
4507       const PetscInt p        = idx[i];
4508       PetscInt       numConst = constDof;
4509 
4510       /* Constrain every dof on the point */
4511       if (numConst < 0) {
4512         if (numFields) {
4513           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4514         } else {
4515           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4516         }
4517       }
4518       if (numFields) {
4519         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4520       }
4521       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4522     }
4523     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4524   }
4525   PetscFunctionReturn(0);
4526 }
4527 
4528 #undef __FUNCT__
4529 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4530 /* Set the constrained indices on each point and separate by fields */
4531 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4532 {
4533   PetscInt      *maxConstraints;
4534   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4535   PetscErrorCode ierr;
4536 
4537   PetscFunctionBegin;
4538   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4539   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4540   ierr = PetscMalloc((numFields+1) * sizeof(PetscInt), &maxConstraints);CHKERRQ(ierr);
4541   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4542   for (p = pStart; p < pEnd; ++p) {
4543     PetscInt cdof;
4544 
4545     if (numFields) {
4546       for (f = 0; f < numFields; ++f) {
4547         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4548         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4549       }
4550     } else {
4551       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4552       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4553     }
4554   }
4555   for (f = 0; f < numFields; ++f) {
4556     maxConstraints[numFields] += maxConstraints[f];
4557   }
4558   if (maxConstraints[numFields]) {
4559     PetscInt *indices;
4560 
4561     ierr = PetscMalloc(maxConstraints[numFields] * sizeof(PetscInt), &indices);CHKERRQ(ierr);
4562     for (p = pStart; p < pEnd; ++p) {
4563       PetscInt cdof, d;
4564 
4565       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4566       if (cdof) {
4567         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4568         if (numFields) {
4569           PetscInt numConst = 0, foff = 0;
4570 
4571           for (f = 0; f < numFields; ++f) {
4572             PetscInt cfdof, fdof;
4573 
4574             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4575             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4576             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4577             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4578             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4579             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4580             numConst += cfdof;
4581             foff     += fdof;
4582           }
4583           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4584         } else {
4585           for (d = 0; d < cdof; ++d) indices[d] = d;
4586         }
4587         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4588       }
4589     }
4590     ierr = PetscFree(indices);CHKERRQ(ierr);
4591   }
4592   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4593   PetscFunctionReturn(0);
4594 }
4595 
4596 #undef __FUNCT__
4597 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4598 /* Set the constrained field indices on each point */
4599 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4600 {
4601   const PetscInt *points, *indices;
4602   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4603   PetscErrorCode  ierr;
4604 
4605   PetscFunctionBegin;
4606   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4607   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4608 
4609   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4610   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4611   if (!constraintIndices) {
4612     PetscInt *idx, i;
4613 
4614     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4615     ierr = PetscMalloc(maxDof * sizeof(PetscInt), &idx);CHKERRQ(ierr);
4616     for (i = 0; i < maxDof; ++i) idx[i] = i;
4617     for (p = 0; p < numPoints; ++p) {
4618       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4619     }
4620     ierr = PetscFree(idx);CHKERRQ(ierr);
4621   } else {
4622     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4623     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4624     for (p = 0; p < numPoints; ++p) {
4625       PetscInt fcdof;
4626 
4627       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4628       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);
4629       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4630     }
4631     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4632   }
4633   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4634   PetscFunctionReturn(0);
4635 }
4636 
4637 #undef __FUNCT__
4638 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4639 /* Set the constrained indices on each point and separate by fields */
4640 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4641 {
4642   PetscInt      *indices;
4643   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4644   PetscErrorCode ierr;
4645 
4646   PetscFunctionBegin;
4647   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4648   ierr = PetscMalloc(maxDof * sizeof(PetscInt), &indices);CHKERRQ(ierr);
4649   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4650   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4651   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4652   for (p = pStart; p < pEnd; ++p) {
4653     PetscInt cdof, d;
4654 
4655     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4656     if (cdof) {
4657       PetscInt numConst = 0, foff = 0;
4658 
4659       for (f = 0; f < numFields; ++f) {
4660         const PetscInt *fcind;
4661         PetscInt        fdof, fcdof;
4662 
4663         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4664         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4665         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4666         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4667         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4668         foff     += fdof;
4669         numConst += fcdof;
4670       }
4671       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4672       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4673     }
4674   }
4675   ierr = PetscFree(indices);CHKERRQ(ierr);
4676   PetscFunctionReturn(0);
4677 }
4678 
4679 #undef __FUNCT__
4680 #define __FUNCT__ "DMPlexCreateSection"
4681 /*@C
4682   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4683 
4684   Not Collective
4685 
4686   Input Parameters:
4687 + dm        - The DMPlex object
4688 . dim       - The spatial dimension of the problem
4689 . numFields - The number of fields in the problem
4690 . numComp   - An array of size numFields that holds the number of components for each field
4691 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4692 . numBC     - The number of boundary conditions
4693 . bcField   - An array of size numBC giving the field number for each boundry condition
4694 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4695 
4696   Output Parameter:
4697 . section - The PetscSection object
4698 
4699   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
4700   nubmer of dof for field 0 on each edge.
4701 
4702   Level: developer
4703 
4704   Fortran Notes:
4705   A Fortran 90 version is available as DMPlexCreateSectionF90()
4706 
4707 .keywords: mesh, elements
4708 .seealso: DMPlexCreate(), PetscSectionCreate()
4709 @*/
4710 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
4711 {
4712   PetscErrorCode ierr;
4713 
4714   PetscFunctionBegin;
4715   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4716   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4717   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4718   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4719   {
4720     PetscBool view = PETSC_FALSE;
4721 
4722     ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-section_view", &view);CHKERRQ(ierr);
4723     if (view) {ierr = PetscSectionView(*section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
4724   }
4725   PetscFunctionReturn(0);
4726 }
4727 
4728 #undef __FUNCT__
4729 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4730 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4731 {
4732   PetscSection   section;
4733   PetscErrorCode ierr;
4734 
4735   PetscFunctionBegin;
4736   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4737   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4738   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4739   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4740   PetscFunctionReturn(0);
4741 }
4742 
4743 #undef __FUNCT__
4744 #define __FUNCT__ "DMPlexGetCoordinateSection"
4745 /*@
4746   DMPlexGetCoordinateSection - Retrieve the layout of coordinate values over the mesh.
4747 
4748   Not Collective
4749 
4750   Input Parameter:
4751 . dm - The DMPlex object
4752 
4753   Output Parameter:
4754 . section - The PetscSection object
4755 
4756   Level: intermediate
4757 
4758 .keywords: mesh, coordinates
4759 .seealso: DMGetCoordinateDM(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
4760 @*/
4761 PetscErrorCode DMPlexGetCoordinateSection(DM dm, PetscSection *section)
4762 {
4763   DM             cdm;
4764   PetscErrorCode ierr;
4765 
4766   PetscFunctionBegin;
4767   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4768   PetscValidPointer(section, 2);
4769   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
4770   ierr = DMGetDefaultSection(cdm, section);CHKERRQ(ierr);
4771   PetscFunctionReturn(0);
4772 }
4773 
4774 #undef __FUNCT__
4775 #define __FUNCT__ "DMPlexSetCoordinateSection"
4776 /*@
4777   DMPlexSetCoordinateSection - Set the layout of coordinate values over the mesh.
4778 
4779   Not Collective
4780 
4781   Input Parameters:
4782 + dm      - The DMPlex object
4783 - section - The PetscSection object
4784 
4785   Level: intermediate
4786 
4787 .keywords: mesh, coordinates
4788 .seealso: DMPlexGetCoordinateSection(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
4789 @*/
4790 PetscErrorCode DMPlexSetCoordinateSection(DM dm, PetscSection section)
4791 {
4792   DM             cdm;
4793   PetscErrorCode ierr;
4794 
4795   PetscFunctionBegin;
4796   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4797   PetscValidHeaderSpecific(section,PETSC_SECTION_CLASSID,2);
4798   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
4799   ierr = DMSetDefaultSection(cdm, section);CHKERRQ(ierr);
4800   PetscFunctionReturn(0);
4801 }
4802 
4803 #undef __FUNCT__
4804 #define __FUNCT__ "DMPlexGetConeSection"
4805 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4806 {
4807   DM_Plex *mesh = (DM_Plex*) dm->data;
4808 
4809   PetscFunctionBegin;
4810   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4811   if (section) *section = mesh->coneSection;
4812   PetscFunctionReturn(0);
4813 }
4814 
4815 #undef __FUNCT__
4816 #define __FUNCT__ "DMPlexGetSupportSection"
4817 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4818 {
4819   DM_Plex *mesh = (DM_Plex*) dm->data;
4820 
4821   PetscFunctionBegin;
4822   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4823   if (section) *section = mesh->supportSection;
4824   PetscFunctionReturn(0);
4825 }
4826 
4827 #undef __FUNCT__
4828 #define __FUNCT__ "DMPlexGetCones"
4829 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4830 {
4831   DM_Plex *mesh = (DM_Plex*) dm->data;
4832 
4833   PetscFunctionBegin;
4834   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4835   if (cones) *cones = mesh->cones;
4836   PetscFunctionReturn(0);
4837 }
4838 
4839 #undef __FUNCT__
4840 #define __FUNCT__ "DMPlexGetConeOrientations"
4841 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4842 {
4843   DM_Plex *mesh = (DM_Plex*) dm->data;
4844 
4845   PetscFunctionBegin;
4846   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4847   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4848   PetscFunctionReturn(0);
4849 }
4850 
4851 /******************************** FEM Support **********************************/
4852 
4853 #undef __FUNCT__
4854 #define __FUNCT__ "DMPlexVecGetClosure"
4855 /*@C
4856   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4857 
4858   Not collective
4859 
4860   Input Parameters:
4861 + dm - The DM
4862 . section - The section describing the layout in v, or NULL to use the default section
4863 . v - The local vector
4864 - point - The sieve point in the DM
4865 
4866   Output Parameters:
4867 + csize - The number of values in the closure, or NULL
4868 - values - The array of values, which is a borrowed array and should not be freed
4869 
4870   Fortran Notes:
4871   Since it returns an array, this routine is only available in Fortran 90, and you must
4872   include petsc.h90 in your code.
4873 
4874   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4875 
4876   Level: intermediate
4877 
4878 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4879 @*/
4880 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4881 {
4882   PetscSection   clSection;
4883   IS             clIndices;
4884   PetscScalar   *array, *vArray;
4885   PetscInt      *points = NULL;
4886   PetscInt       offsets[32];
4887   PetscInt       depth, numFields, size = 0, numPoints, pStart, pEnd, p, q, f;
4888   PetscErrorCode ierr;
4889 
4890   PetscFunctionBegin;
4891   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4892   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4893   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4894   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clIndices);CHKERRQ(ierr);
4895   if (clSection) {
4896     const PetscInt *idx;
4897     PetscInt        dof, off;
4898 
4899     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4900     if (csize) *csize = dof;
4901     if (values) {
4902       if (!*values) {
4903         ierr = DMGetWorkArray(dm, dof, PETSC_SCALAR, &array);CHKERRQ(ierr);
4904         *values = array;
4905       } else {
4906         array = *values;
4907       }
4908       ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4909       ierr = ISGetIndices(clIndices, &idx);CHKERRQ(ierr);
4910       ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4911       for (p = 0; p < dof; ++p) array[p] = vArray[idx[off+p]];
4912       ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4913       ierr = ISRestoreIndices(clIndices, &idx);CHKERRQ(ierr);
4914     }
4915     PetscFunctionReturn(0);
4916   }
4917   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4918   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4919   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4920   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4921   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4922   if (depth == 1 && numFields < 2) {
4923     const PetscInt *cone, *coneO;
4924 
4925     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4926     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4927     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4928     if (!values || !*values) {
4929       if ((point >= pStart) && (point < pEnd)) {
4930         PetscInt dof;
4931         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4932         size += dof;
4933       }
4934       for (p = 0; p < numPoints; ++p) {
4935         const PetscInt cp = cone[p];
4936         PetscInt       dof;
4937 
4938         if ((cp < pStart) || (cp >= pEnd)) continue;
4939         ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4940         size += dof;
4941       }
4942       if (!values) {
4943         if (csize) *csize = size;
4944         PetscFunctionReturn(0);
4945       }
4946       ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
4947     } else {
4948       array = *values;
4949     }
4950     size = 0;
4951     ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4952     if ((point >= pStart) && (point < pEnd)) {
4953       PetscInt     dof, off, d;
4954       PetscScalar *varr;
4955       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4956       ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4957       varr = &vArray[off];
4958       for (d = 0; d < dof; ++d, ++offsets[0]) {
4959         array[offsets[0]] = varr[d];
4960       }
4961       size += dof;
4962     }
4963     for (p = 0; p < numPoints; ++p) {
4964       const PetscInt cp = cone[p];
4965       PetscInt       o  = coneO[p];
4966       PetscInt       dof, off, d;
4967       PetscScalar   *varr;
4968 
4969       if ((cp < pStart) || (cp >= pEnd)) continue;
4970       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4971       ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
4972       varr = &vArray[off];
4973       if (o >= 0) {
4974         for (d = 0; d < dof; ++d, ++offsets[0]) {
4975           array[offsets[0]] = varr[d];
4976         }
4977       } else {
4978         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
4979           array[offsets[0]] = varr[d];
4980         }
4981       }
4982       size += dof;
4983     }
4984     ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4985     if (!*values) {
4986       if (csize) *csize = size;
4987       *values = array;
4988     } else {
4989       if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
4990       *csize = size;
4991     }
4992     PetscFunctionReturn(0);
4993   }
4994   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4995   /* Compress out points not in the section */
4996   for (p = 0, q = 0; p < numPoints*2; p += 2) {
4997     if ((points[p] >= pStart) && (points[p] < pEnd)) {
4998       points[q*2]   = points[p];
4999       points[q*2+1] = points[p+1];
5000       ++q;
5001     }
5002   }
5003   numPoints = q;
5004   if (!values || !*values) {
5005     for (p = 0, size = 0; p < numPoints*2; p += 2) {
5006       PetscInt dof, fdof;
5007 
5008       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5009       for (f = 0; f < numFields; ++f) {
5010         ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5011         offsets[f+1] += fdof;
5012       }
5013       size += dof;
5014     }
5015     if (!values) {
5016       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5017       if (csize) *csize = size;
5018       PetscFunctionReturn(0);
5019     }
5020     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
5021   } else {
5022     array = *values;
5023   }
5024   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5025   if (numFields && offsets[numFields] != size) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], size);
5026   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5027   for (p = 0; p < numPoints*2; p += 2) {
5028     PetscInt     o = points[p+1];
5029     PetscInt     dof, off, d;
5030     PetscScalar *varr;
5031 
5032     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5033     ierr = PetscSectionGetOffset(section, points[p], &off);CHKERRQ(ierr);
5034     varr = &vArray[off];
5035     if (numFields) {
5036       PetscInt fdof, foff, fcomp, f, c;
5037 
5038       for (f = 0, foff = 0; f < numFields; ++f) {
5039         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5040         if (o >= 0) {
5041           for (d = 0; d < fdof; ++d, ++offsets[f]) {
5042             array[offsets[f]] = varr[foff+d];
5043           }
5044         } else {
5045           ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5046           for (d = fdof/fcomp-1; d >= 0; --d) {
5047             for (c = 0; c < fcomp; ++c, ++offsets[f]) {
5048               array[offsets[f]] = varr[foff+d*fcomp+c];
5049             }
5050           }
5051         }
5052         foff += fdof;
5053       }
5054     } else {
5055       if (o >= 0) {
5056         for (d = 0; d < dof; ++d, ++offsets[0]) {
5057           array[offsets[0]] = varr[d];
5058         }
5059       } else {
5060         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
5061           array[offsets[0]] = varr[d];
5062         }
5063       }
5064     }
5065   }
5066   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5067   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5068   if (!*values) {
5069     if (csize) *csize = size;
5070     *values = array;
5071   } else {
5072     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5073     *csize = size;
5074   }
5075   PetscFunctionReturn(0);
5076 }
5077 
5078 #undef __FUNCT__
5079 #define __FUNCT__ "DMPlexVecRestoreClosure"
5080 /*@C
5081   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
5082 
5083   Not collective
5084 
5085   Input Parameters:
5086 + dm - The DM
5087 . section - The section describing the layout in v, or NULL to use the default section
5088 . v - The local vector
5089 . point - The sieve point in the DM
5090 . csize - The number of values in the closure, or NULL
5091 - values - The array of values, which is a borrowed array and should not be freed
5092 
5093   Fortran Notes:
5094   Since it returns an array, this routine is only available in Fortran 90, and you must
5095   include petsc.h90 in your code.
5096 
5097   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5098 
5099   Level: intermediate
5100 
5101 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5102 @*/
5103 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5104 {
5105   PetscInt       size = 0;
5106   PetscErrorCode ierr;
5107 
5108   PetscFunctionBegin;
5109   /* Should work without recalculating size */
5110   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
5111   PetscFunctionReturn(0);
5112 }
5113 
5114 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
5115 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
5116 
5117 #undef __FUNCT__
5118 #define __FUNCT__ "updatePoint_private"
5119 PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5120 {
5121   PetscInt        cdof;   /* The number of constraints on this point */
5122   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5123   PetscScalar    *a;
5124   PetscInt        off, cind = 0, k;
5125   PetscErrorCode  ierr;
5126 
5127   PetscFunctionBegin;
5128   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5129   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5130   a    = &array[off];
5131   if (!cdof || setBC) {
5132     if (orientation >= 0) {
5133       for (k = 0; k < dof; ++k) {
5134         fuse(&a[k], values[k]);
5135       }
5136     } else {
5137       for (k = 0; k < dof; ++k) {
5138         fuse(&a[k], values[dof-k-1]);
5139       }
5140     }
5141   } else {
5142     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5143     if (orientation >= 0) {
5144       for (k = 0; k < dof; ++k) {
5145         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5146         fuse(&a[k], values[k]);
5147       }
5148     } else {
5149       for (k = 0; k < dof; ++k) {
5150         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5151         fuse(&a[k], values[dof-k-1]);
5152       }
5153     }
5154   }
5155   PetscFunctionReturn(0);
5156 }
5157 
5158 #undef __FUNCT__
5159 #define __FUNCT__ "updatePointBC_private"
5160 PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5161 {
5162   PetscInt        cdof;   /* The number of constraints on this point */
5163   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5164   PetscScalar    *a;
5165   PetscInt        off, cind = 0, k;
5166   PetscErrorCode  ierr;
5167 
5168   PetscFunctionBegin;
5169   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5170   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5171   a    = &array[off];
5172   if (cdof) {
5173     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5174     if (orientation >= 0) {
5175       for (k = 0; k < dof; ++k) {
5176         if ((cind < cdof) && (k == cdofs[cind])) {
5177           fuse(&a[k], values[k]);
5178           ++cind;
5179         }
5180       }
5181     } else {
5182       for (k = 0; k < dof; ++k) {
5183         if ((cind < cdof) && (k == cdofs[cind])) {
5184           fuse(&a[k], values[dof-k-1]);
5185           ++cind;
5186         }
5187       }
5188     }
5189   }
5190   PetscFunctionReturn(0);
5191 }
5192 
5193 #undef __FUNCT__
5194 #define __FUNCT__ "updatePointFields_private"
5195 PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5196 {
5197   PetscScalar   *a;
5198   PetscInt       numFields, off, foff, f;
5199   PetscErrorCode ierr;
5200 
5201   PetscFunctionBegin;
5202   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5203   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5204   a    = &array[off];
5205   for (f = 0, foff = 0; f < numFields; ++f) {
5206     PetscInt        fdof, fcomp, fcdof;
5207     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5208     PetscInt        cind = 0, k, c;
5209 
5210     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5211     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5212     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5213     if (!fcdof || setBC) {
5214       if (orientation >= 0) {
5215         for (k = 0; k < fdof; ++k) {
5216           fuse(&a[foff+k], values[foffs[f]+k]);
5217         }
5218       } else {
5219         for (k = fdof/fcomp-1; k >= 0; --k) {
5220           for (c = 0; c < fcomp; ++c) {
5221             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
5222           }
5223         }
5224       }
5225     } else {
5226       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5227       if (orientation >= 0) {
5228         for (k = 0; k < fdof; ++k) {
5229           if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
5230           fuse(&a[foff+k], values[foffs[f]+k]);
5231         }
5232       } else {
5233         for (k = fdof/fcomp-1; k >= 0; --k) {
5234           for (c = 0; c < fcomp; ++c) {
5235             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
5236             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
5237           }
5238         }
5239       }
5240     }
5241     foff     += fdof;
5242     foffs[f] += fdof;
5243   }
5244   PetscFunctionReturn(0);
5245 }
5246 
5247 #undef __FUNCT__
5248 #define __FUNCT__ "updatePointFieldsBC_private"
5249 PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5250 {
5251   PetscScalar   *a;
5252   PetscInt       numFields, off, foff, f;
5253   PetscErrorCode ierr;
5254 
5255   PetscFunctionBegin;
5256   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5257   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5258   a    = &array[off];
5259   for (f = 0, foff = 0; f < numFields; ++f) {
5260     PetscInt        fdof, fcomp, fcdof;
5261     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5262     PetscInt        cind = 0, k, c;
5263 
5264     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5265     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5266     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5267     if (fcdof) {
5268       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5269       if (orientation >= 0) {
5270         for (k = 0; k < fdof; ++k) {
5271           if ((cind < fcdof) && (k == fcdofs[cind])) {
5272             fuse(&a[foff+k], values[foffs[f]+k]);
5273             ++cind;
5274           }
5275         }
5276       } else {
5277         for (k = fdof/fcomp-1; k >= 0; --k) {
5278           for (c = 0; c < fcomp; ++c) {
5279             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
5280               fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
5281               ++cind;
5282             }
5283           }
5284         }
5285       }
5286     }
5287     foff     += fdof;
5288     foffs[f] += fdof;
5289   }
5290   PetscFunctionReturn(0);
5291 }
5292 
5293 #undef __FUNCT__
5294 #define __FUNCT__ "DMPlexVecSetClosure"
5295 /*@C
5296   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5297 
5298   Not collective
5299 
5300   Input Parameters:
5301 + dm - The DM
5302 . section - The section describing the layout in v, or NULL to use the default section
5303 . v - The local vector
5304 . point - The sieve point in the DM
5305 . values - The array of values
5306 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5307 
5308   Fortran Notes:
5309   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5310 
5311   Level: intermediate
5312 
5313 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5314 @*/
5315 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5316 {
5317   PetscScalar   *array;
5318   PetscInt      *points = NULL;
5319   PetscInt       offsets[32];
5320   PetscInt       depth, numFields, numPoints, off, dof, pStart, pEnd, p, q, f;
5321   PetscErrorCode ierr;
5322 
5323   PetscFunctionBegin;
5324   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5325   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5326   if (!section) {
5327     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
5328   }
5329   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5330   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5331   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5332   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5333   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5334   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5335     const PetscInt *cone, *coneO;
5336 
5337     ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5338     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5339     ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5340     ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5341     for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5342       const PetscInt cp = !p ? point : cone[p-1];
5343       const PetscInt o  = !p ? 0     : coneO[p-1];
5344 
5345       if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5346       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5347       /* ADD_VALUES */
5348       {
5349         const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5350         PetscScalar    *a;
5351         PetscInt        cdof, coff, cind = 0, k;
5352 
5353         ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5354         ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5355         a    = &array[coff];
5356         if (!cdof) {
5357           if (o >= 0) {
5358             for (k = 0; k < dof; ++k) {
5359               a[k] += values[off+k];
5360             }
5361           } else {
5362             for (k = 0; k < dof; ++k) {
5363               a[k] += values[off+dof-k-1];
5364             }
5365           }
5366         } else {
5367           ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5368           if (o >= 0) {
5369             for (k = 0; k < dof; ++k) {
5370               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5371               a[k] += values[off+k];
5372             }
5373           } else {
5374             for (k = 0; k < dof; ++k) {
5375               if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5376               a[k] += values[off+dof-k-1];
5377             }
5378           }
5379         }
5380       }
5381     }
5382     ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5383     PetscFunctionReturn(0);
5384   }
5385   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5386   /* Compress out points not in the section */
5387   for (p = 0, q = 0; p < numPoints*2; p += 2) {
5388     if ((points[p] >= pStart) && (points[p] < pEnd)) {
5389       points[q*2]   = points[p];
5390       points[q*2+1] = points[p+1];
5391       ++q;
5392     }
5393   }
5394   numPoints = q;
5395   for (p = 0; p < numPoints*2; p += 2) {
5396     PetscInt fdof;
5397 
5398     for (f = 0; f < numFields; ++f) {
5399       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5400       offsets[f+1] += fdof;
5401     }
5402   }
5403   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5404   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5405   if (numFields) {
5406     switch (mode) {
5407     case INSERT_VALUES:
5408       for (p = 0; p < numPoints*2; p += 2) {
5409         PetscInt o = points[p+1];
5410         updatePointFields_private(section, points[p], offsets, insert, PETSC_FALSE, o, values, array);
5411       } break;
5412     case INSERT_ALL_VALUES:
5413       for (p = 0; p < numPoints*2; p += 2) {
5414         PetscInt o = points[p+1];
5415         updatePointFields_private(section, points[p], offsets, insert, PETSC_TRUE,  o, values, array);
5416       } break;
5417     case INSERT_BC_VALUES:
5418       for (p = 0; p < numPoints*2; p += 2) {
5419         PetscInt o = points[p+1];
5420         updatePointFieldsBC_private(section, points[p], offsets, insert,  o, values, array);
5421       } break;
5422     case ADD_VALUES:
5423       for (p = 0; p < numPoints*2; p += 2) {
5424         PetscInt o = points[p+1];
5425         updatePointFields_private(section, points[p], offsets, add,    PETSC_FALSE, o, values, array);
5426       } break;
5427     case ADD_ALL_VALUES:
5428       for (p = 0; p < numPoints*2; p += 2) {
5429         PetscInt o = points[p+1];
5430         updatePointFields_private(section, points[p], offsets, add,    PETSC_TRUE,  o, values, array);
5431       } break;
5432     default:
5433       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5434     }
5435   } else {
5436     switch (mode) {
5437     case INSERT_VALUES:
5438       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5439         PetscInt o = points[p+1];
5440         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5441         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5442       } break;
5443     case INSERT_ALL_VALUES:
5444       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5445         PetscInt o = points[p+1];
5446         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5447         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5448       } break;
5449     case INSERT_BC_VALUES:
5450       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5451         PetscInt o = points[p+1];
5452         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5453         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5454       } break;
5455     case ADD_VALUES:
5456       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5457         PetscInt o = points[p+1];
5458         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5459         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5460       } break;
5461     case ADD_ALL_VALUES:
5462       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5463         PetscInt o = points[p+1];
5464         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5465         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5466       } break;
5467     default:
5468       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5469     }
5470   }
5471   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5472   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5473   PetscFunctionReturn(0);
5474 }
5475 
5476 #undef __FUNCT__
5477 #define __FUNCT__ "DMPlexCreateClosureIndex"
5478 /*@
5479   DMPlexCreateClosureIndex - Calculate an index for the given PetscSection for the closure operation on the DM
5480 
5481   Not collective
5482 
5483   Input Parameters:
5484 + dm - The DM
5485 - section - The section describing the layout in v, or NULL to use the default section
5486 
5487   Note:
5488   This should greatly improve the performance of the closure operations, at the cost of additional memory.
5489 
5490   Level: intermediate
5491 
5492 .seealso DMPlexVecGetClosure(), DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5493 @*/
5494 PetscErrorCode DMPlexCreateClosureIndex(DM dm, PetscSection section)
5495 {
5496   PetscSection   closureSection;
5497   IS             closureIS;
5498   PetscInt       offsets[32], *clIndices;
5499   PetscInt       depth, numFields, pStart, pEnd, point, clSize;
5500   PetscErrorCode ierr;
5501 
5502   PetscFunctionBegin;
5503   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5504   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5505   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5506   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5507   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5508   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5509   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) section), &closureSection);CHKERRQ(ierr);
5510   ierr = PetscSectionSetChart(closureSection, pStart, pEnd);CHKERRQ(ierr);
5511   for (point = pStart; point < pEnd; ++point) {
5512     PetscInt *points = NULL, numPoints, p, dof, cldof = 0;
5513 
5514     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5515     for (p = 0; p < numPoints*2; p += 2) {
5516       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5517         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5518         cldof += dof;
5519       }
5520     }
5521     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5522     ierr = PetscSectionSetDof(closureSection, point, cldof);CHKERRQ(ierr);
5523   }
5524   ierr = PetscSectionSetUp(closureSection);CHKERRQ(ierr);
5525   ierr = PetscSectionGetStorageSize(closureSection, &clSize);CHKERRQ(ierr);
5526   ierr = PetscMalloc(clSize * sizeof(PetscInt), &clIndices);CHKERRQ(ierr);
5527   for (point = pStart; point < pEnd; ++point) {
5528     PetscInt *points = NULL, numPoints, p, q, cldof, cloff, fdof, f;
5529 
5530     ierr = PetscSectionGetDof(closureSection, point, &cldof);CHKERRQ(ierr);
5531     ierr = PetscSectionGetOffset(closureSection, point, &cloff);CHKERRQ(ierr);
5532     ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5533     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5534     /* Compress out points not in the section, and create field offsets */
5535     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5536       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5537         points[q*2]   = points[p];
5538         points[q*2+1] = points[p+1];
5539         for (f = 0; f < numFields; ++f) {
5540           ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5541           offsets[f+1] += fdof;
5542         }
5543         ++q;
5544       }
5545     }
5546     numPoints = q;
5547     for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5548     if (numFields && offsets[numFields] != cldof) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], cldof);
5549     /* Create indices */
5550     for (p = 0; p < numPoints*2; p += 2) {
5551       PetscInt o = points[p+1], dof, off, d;
5552 
5553       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5554       ierr = PetscSectionGetOffset(section, points[p], &off);CHKERRQ(ierr);
5555       if (numFields) {
5556         PetscInt fdof, foff, fcomp, f, c;
5557 
5558         for (f = 0, foff = 0; f < numFields; ++f) {
5559           ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5560           if (o >= 0) {
5561             for (d = 0; d < fdof; ++d, ++offsets[f]) clIndices[cloff+offsets[f]] = off+foff+d;
5562           } else {
5563             ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5564             for (d = fdof/fcomp-1; d >= 0; --d) {
5565               for (c = 0; c < fcomp; ++c, ++offsets[f]) clIndices[cloff+offsets[f]] = off+foff+d*fcomp+c;
5566             }
5567           }
5568           foff += fdof;
5569         }
5570       } else {
5571         if (o >= 0) for (d = 0;     d < dof; ++d) clIndices[cloff+d] = off+d;
5572         else        for (d = dof-1; d >= 0;  --d) clIndices[cloff+d] = off+d;
5573       }
5574     }
5575     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5576   }
5577   ierr = ISCreateGeneral(PETSC_COMM_SELF, clSize, clIndices, PETSC_OWN_POINTER, &closureIS);CHKERRQ(ierr);
5578   ierr = PetscSectionSetClosureIndex(section, (PetscObject) dm, closureSection, closureIS);
5579   PetscFunctionReturn(0);
5580 }
5581 
5582 #undef __FUNCT__
5583 #define __FUNCT__ "DMPlexPrintMatSetValues"
5584 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numIndices, const PetscInt indices[], const PetscScalar values[])
5585 {
5586   PetscMPIInt    rank;
5587   PetscInt       i, j;
5588   PetscErrorCode ierr;
5589 
5590   PetscFunctionBegin;
5591   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5592   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5593   for (i = 0; i < numIndices; i++) {
5594     ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat indices[%D] = %D\n", rank, i, indices[i]);CHKERRQ(ierr);
5595   }
5596   for (i = 0; i < numIndices; i++) {
5597     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5598     for (j = 0; j < numIndices; j++) {
5599 #if defined(PETSC_USE_COMPLEX)
5600       ierr = PetscViewerASCIIPrintf(viewer, " (%G,%G)", PetscRealPart(values[i*numIndices+j]), PetscImaginaryPart(values[i*numIndices+j]));CHKERRQ(ierr);
5601 #else
5602       ierr = PetscViewerASCIIPrintf(viewer, " %G", values[i*numIndices+j]);CHKERRQ(ierr);
5603 #endif
5604     }
5605     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5606   }
5607   PetscFunctionReturn(0);
5608 }
5609 
5610 #undef __FUNCT__
5611 #define __FUNCT__ "indicesPoint_private"
5612 /* . off - The global offset of this point */
5613 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5614 {
5615   PetscInt        dof;    /* The number of unknowns on this point */
5616   PetscInt        cdof;   /* The number of constraints on this point */
5617   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5618   PetscInt        cind = 0, k;
5619   PetscErrorCode  ierr;
5620 
5621   PetscFunctionBegin;
5622   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5623   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5624   if (!cdof || setBC) {
5625     if (orientation >= 0) {
5626       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5627     } else {
5628       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5629     }
5630   } else {
5631     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5632     if (orientation >= 0) {
5633       for (k = 0; k < dof; ++k) {
5634         if ((cind < cdof) && (k == cdofs[cind])) {
5635           /* Insert check for returning constrained indices */
5636           indices[*loff+k] = -(off+k+1);
5637           ++cind;
5638         } else {
5639           indices[*loff+k] = off+k-cind;
5640         }
5641       }
5642     } else {
5643       for (k = 0; k < dof; ++k) {
5644         if ((cind < cdof) && (k == cdofs[cind])) {
5645           /* Insert check for returning constrained indices */
5646           indices[*loff+dof-k-1] = -(off+k+1);
5647           ++cind;
5648         } else {
5649           indices[*loff+dof-k-1] = off+k-cind;
5650         }
5651       }
5652     }
5653   }
5654   *loff += dof;
5655   PetscFunctionReturn(0);
5656 }
5657 
5658 #undef __FUNCT__
5659 #define __FUNCT__ "indicesPointFields_private"
5660 /* . off - The global offset of this point */
5661 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5662 {
5663   PetscInt       numFields, foff, f;
5664   PetscErrorCode ierr;
5665 
5666   PetscFunctionBegin;
5667   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5668   for (f = 0, foff = 0; f < numFields; ++f) {
5669     PetscInt        fdof, fcomp, cfdof;
5670     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5671     PetscInt        cind = 0, k, c;
5672 
5673     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5674     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5675     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5676     if (!cfdof || setBC) {
5677       if (orientation >= 0) {
5678         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5679       } else {
5680         for (k = fdof/fcomp-1; k >= 0; --k) {
5681           for (c = 0; c < fcomp; ++c) {
5682             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5683           }
5684         }
5685       }
5686     } else {
5687       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5688       if (orientation >= 0) {
5689         for (k = 0; k < fdof; ++k) {
5690           if ((cind < cfdof) && (k == fcdofs[cind])) {
5691             indices[foffs[f]+k] = -(off+foff+k+1);
5692             ++cind;
5693           } else {
5694             indices[foffs[f]+k] = off+foff+k-cind;
5695           }
5696         }
5697       } else {
5698         for (k = fdof/fcomp-1; k >= 0; --k) {
5699           for (c = 0; c < fcomp; ++c) {
5700             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5701               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5702               ++cind;
5703             } else {
5704               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5705             }
5706           }
5707         }
5708       }
5709     }
5710     foff     += fdof - cfdof;
5711     foffs[f] += fdof;
5712   }
5713   PetscFunctionReturn(0);
5714 }
5715 
5716 #undef __FUNCT__
5717 #define __FUNCT__ "DMPlexMatSetClosure"
5718 /*@C
5719   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5720 
5721   Not collective
5722 
5723   Input Parameters:
5724 + dm - The DM
5725 . section - The section describing the layout in v
5726 . globalSection - The section describing the layout in v
5727 . A - The matrix
5728 . point - The sieve point in the DM
5729 . values - The array of values
5730 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5731 
5732   Fortran Notes:
5733   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5734 
5735   Level: intermediate
5736 
5737 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5738 @*/
5739 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5740 {
5741   DM_Plex       *mesh   = (DM_Plex*) dm->data;
5742   PetscInt      *points = NULL;
5743   PetscInt      *indices;
5744   PetscInt       offsets[32];
5745   PetscInt       numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5746   PetscErrorCode ierr;
5747 
5748   PetscFunctionBegin;
5749   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5750   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5751   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5752   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5753   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5754   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5755   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5756   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5757   /* Compress out points not in the section */
5758   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5759   for (p = 0, q = 0; p < numPoints*2; p += 2) {
5760     if ((points[p] >= pStart) && (points[p] < pEnd)) {
5761       points[q*2]   = points[p];
5762       points[q*2+1] = points[p+1];
5763       ++q;
5764     }
5765   }
5766   numPoints = q;
5767   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5768     PetscInt fdof;
5769 
5770     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5771     for (f = 0; f < numFields; ++f) {
5772       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5773       offsets[f+1] += fdof;
5774     }
5775     numIndices += dof;
5776   }
5777   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5778 
5779   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5780   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5781   if (numFields) {
5782     for (p = 0; p < numPoints*2; p += 2) {
5783       PetscInt o = points[p+1];
5784       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5785       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5786     }
5787   } else {
5788     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5789       PetscInt o = points[p+1];
5790       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5791       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5792     }
5793   }
5794   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr);}
5795   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5796   if (ierr) {
5797     PetscMPIInt    rank;
5798     PetscErrorCode ierr2;
5799 
5800     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5801     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5802     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr2);
5803     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5804     CHKERRQ(ierr);
5805   }
5806   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5807   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5808   PetscFunctionReturn(0);
5809 }
5810 
5811 #undef __FUNCT__
5812 #define __FUNCT__ "DMPlexGetHybridBounds"
5813 /*@
5814   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5815 
5816   Input Parameter:
5817 . dm - The DMPlex object
5818 
5819   Output Parameters:
5820 + cMax - The first hybrid cell
5821 . cMax - The first hybrid face
5822 . cMax - The first hybrid edge
5823 - cMax - The first hybrid vertex
5824 
5825   Level: developer
5826 
5827 .seealso DMPlexCreateHybridMesh()
5828 @*/
5829 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5830 {
5831   DM_Plex       *mesh = (DM_Plex*) dm->data;
5832   PetscInt       dim;
5833   PetscErrorCode ierr;
5834 
5835   PetscFunctionBegin;
5836   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5837   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5838   if (cMax) *cMax = mesh->hybridPointMax[dim];
5839   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5840   if (eMax) *eMax = mesh->hybridPointMax[1];
5841   if (vMax) *vMax = mesh->hybridPointMax[0];
5842   PetscFunctionReturn(0);
5843 }
5844 
5845 #undef __FUNCT__
5846 #define __FUNCT__ "DMPlexSetHybridBounds"
5847 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5848 {
5849   DM_Plex       *mesh = (DM_Plex*) dm->data;
5850   PetscInt       dim;
5851   PetscErrorCode ierr;
5852 
5853   PetscFunctionBegin;
5854   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5855   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5856   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5857   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5858   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5859   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5860   PetscFunctionReturn(0);
5861 }
5862 
5863 #undef __FUNCT__
5864 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5865 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5866 {
5867   DM_Plex *mesh = (DM_Plex*) dm->data;
5868 
5869   PetscFunctionBegin;
5870   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5871   PetscValidPointer(cellHeight, 2);
5872   *cellHeight = mesh->vtkCellHeight;
5873   PetscFunctionReturn(0);
5874 }
5875 
5876 #undef __FUNCT__
5877 #define __FUNCT__ "DMPlexSetVTKCellHeight"
5878 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5879 {
5880   DM_Plex *mesh = (DM_Plex*) dm->data;
5881 
5882   PetscFunctionBegin;
5883   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5884   mesh->vtkCellHeight = cellHeight;
5885   PetscFunctionReturn(0);
5886 }
5887 
5888 #undef __FUNCT__
5889 #define __FUNCT__ "DMPlexCreateNumbering_Private"
5890 /* We can easily have a form that takes an IS instead */
5891 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
5892 {
5893   PetscSection   section, globalSection;
5894   PetscInt      *numbers, p;
5895   PetscErrorCode ierr;
5896 
5897   PetscFunctionBegin;
5898   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
5899   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
5900   for (p = pStart; p < pEnd; ++p) {
5901     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
5902   }
5903   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
5904   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
5905   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &numbers);CHKERRQ(ierr);
5906   for (p = pStart; p < pEnd; ++p) {
5907     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
5908   }
5909   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
5910   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5911   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
5912   PetscFunctionReturn(0);
5913 }
5914 
5915 #undef __FUNCT__
5916 #define __FUNCT__ "DMPlexGetCellNumbering"
5917 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
5918 {
5919   DM_Plex       *mesh = (DM_Plex*) dm->data;
5920   PetscInt       cellHeight, cStart, cEnd, cMax;
5921   PetscErrorCode ierr;
5922 
5923   PetscFunctionBegin;
5924   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5925   if (!mesh->globalCellNumbers) {
5926     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
5927     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5928     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5929     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
5930     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
5931   }
5932   *globalCellNumbers = mesh->globalCellNumbers;
5933   PetscFunctionReturn(0);
5934 }
5935 
5936 #undef __FUNCT__
5937 #define __FUNCT__ "DMPlexGetVertexNumbering"
5938 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
5939 {
5940   DM_Plex       *mesh = (DM_Plex*) dm->data;
5941   PetscInt       vStart, vEnd, vMax;
5942   PetscErrorCode ierr;
5943 
5944   PetscFunctionBegin;
5945   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5946   if (!mesh->globalVertexNumbers) {
5947     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5948     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
5949     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
5950     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
5951   }
5952   *globalVertexNumbers = mesh->globalVertexNumbers;
5953   PetscFunctionReturn(0);
5954 }
5955 
5956 
5957 #undef __FUNCT__
5958 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
5959 /*@C
5960   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
5961   the local section and an SF describing the section point overlap.
5962 
5963   Input Parameters:
5964   + s - The PetscSection for the local field layout
5965   . sf - The SF describing parallel layout of the section points
5966   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
5967   . label - The label specifying the points
5968   - labelValue - The label stratum specifying the points
5969 
5970   Output Parameter:
5971   . gsection - The PetscSection for the global field layout
5972 
5973   Note: This gives negative sizes and offsets to points not owned by this process
5974 
5975   Level: developer
5976 
5977 .seealso: PetscSectionCreate()
5978 @*/
5979 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
5980 {
5981   PetscInt      *neg = NULL, *tmpOff = NULL;
5982   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
5983   PetscErrorCode ierr;
5984 
5985   PetscFunctionBegin;
5986   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
5987   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
5988   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
5989   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
5990   if (nroots >= 0) {
5991     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
5992     ierr = PetscMalloc(nroots * sizeof(PetscInt), &neg);CHKERRQ(ierr);
5993     ierr = PetscMemzero(neg, nroots * sizeof(PetscInt));CHKERRQ(ierr);
5994     if (nroots > pEnd-pStart) {
5995       ierr = PetscMalloc(nroots * sizeof(PetscInt), &tmpOff);CHKERRQ(ierr);
5996       ierr = PetscMemzero(tmpOff, nroots * sizeof(PetscInt));CHKERRQ(ierr);
5997     } else {
5998       tmpOff = &(*gsection)->atlasDof[-pStart];
5999     }
6000   }
6001   /* Mark ghost points with negative dof */
6002   for (p = pStart; p < pEnd; ++p) {
6003     PetscInt value;
6004 
6005     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6006     if (value != labelValue) continue;
6007     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6008     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6009     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6010     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6011     if (neg) neg[p] = -(dof+1);
6012   }
6013   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6014   if (nroots >= 0) {
6015     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6016     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6017     if (nroots > pEnd-pStart) {
6018       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6019     }
6020   }
6021   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6022   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6023     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6024     (*gsection)->atlasOff[p] = off;
6025     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6026   }
6027   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
6028   globalOff -= off;
6029   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6030     (*gsection)->atlasOff[p] += globalOff;
6031     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6032   }
6033   /* Put in negative offsets for ghost points */
6034   if (nroots >= 0) {
6035     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6036     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6037     if (nroots > pEnd-pStart) {
6038       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6039     }
6040   }
6041   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6042   ierr = PetscFree(neg);CHKERRQ(ierr);
6043   PetscFunctionReturn(0);
6044 }
6045 
6046 #undef __FUNCT__
6047 #define __FUNCT__ "DMPlexCheckSymmetry"
6048 /*@
6049   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6050 
6051   Input Parameters:
6052   + dm - The DMPlex object
6053 
6054   Note: This is a useful diagnostic when creating meshes programmatically.
6055 
6056   Level: developer
6057 
6058 .seealso: DMCreate()
6059 @*/
6060 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6061 {
6062   PetscSection    coneSection, supportSection;
6063   const PetscInt *cone, *support;
6064   PetscInt        coneSize, c, supportSize, s;
6065   PetscInt        pStart, pEnd, p, csize, ssize;
6066   PetscErrorCode  ierr;
6067 
6068   PetscFunctionBegin;
6069   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6070   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6071   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6072   /* Check that point p is found in the support of its cone points, and vice versa */
6073   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6074   for (p = pStart; p < pEnd; ++p) {
6075     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6076     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6077     for (c = 0; c < coneSize; ++c) {
6078       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6079       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6080       for (s = 0; s < supportSize; ++s) {
6081         if (support[s] == p) break;
6082       }
6083       if (s >= supportSize) {
6084         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6085         for (s = 0; s < coneSize; ++s) {
6086           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6087         }
6088         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6089         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6090         for (s = 0; s < supportSize; ++s) {
6091           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6092         }
6093         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6094         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6095       }
6096     }
6097     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6098     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6099     for (s = 0; s < supportSize; ++s) {
6100       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6101       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6102       for (c = 0; c < coneSize; ++c) {
6103         if (cone[c] == p) break;
6104       }
6105       if (c >= coneSize) {
6106         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6107         for (c = 0; c < supportSize; ++c) {
6108           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6109         }
6110         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6111         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6112         for (c = 0; c < coneSize; ++c) {
6113           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6114         }
6115         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6116         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6117       }
6118     }
6119   }
6120   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6121   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6122   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6123   PetscFunctionReturn(0);
6124 }
6125 
6126 #undef __FUNCT__
6127 #define __FUNCT__ "DMPlexCheckSkeleton"
6128 /*@
6129   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6130 
6131   Input Parameters:
6132   + dm - The DMPlex object
6133 
6134   Note: This is a useful diagnostic when creating meshes programmatically.
6135 
6136   Level: developer
6137 
6138 .seealso: DMCreate()
6139 @*/
6140 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex)
6141 {
6142   DM             udm;
6143   PetscInt       dim, numCorners, coneSize, cStart, cEnd, cMax, c;
6144   PetscErrorCode ierr;
6145 
6146   PetscFunctionBegin;
6147   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6148   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6149   switch (dim) {
6150   case 2: numCorners = isSimplex ? 3 : 4; break;
6151   case 3: numCorners = isSimplex ? 4 : 8; break;
6152   default:
6153     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6154   }
6155   ierr = DMPlexUninterpolate(dm, &udm);CHKERRQ(ierr);
6156   ierr = PetscObjectSetOptionsPrefix((PetscObject) udm, "un_");CHKERRQ(ierr);
6157   ierr = DMSetFromOptions(udm);CHKERRQ(ierr);
6158   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6159   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6160   cMax = cMax >= 0 ? cMax : cEnd;
6161   for (c = cStart; c < cMax; ++c) {
6162     ierr = DMPlexGetConeSize(udm, c, &coneSize);CHKERRQ(ierr);
6163     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6164   }
6165   ierr = DMDestroy(&udm);CHKERRQ(ierr);
6166   PetscFunctionReturn(0);
6167 }
6168