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