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