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