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