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