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