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