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