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