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