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