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