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