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