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