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