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