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