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