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