xref: /petsc/src/dm/impls/plex/plex.c (revision fedde076d547bf9f49b9b1f8c999d455eba09502)
1 #include <petsc-private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <../src/sys/utils/hash.h>
3 #include <petsc-private/isimpl.h>
4 #include <petscsf.h>
5 
6 /* Logging support */
7 PetscLogEvent DMPLEX_Interpolate, DMPLEX_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeField, DMPLEX_DistributeData, DMPLEX_Stratify, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM;
8 
9 PETSC_EXTERN PetscErrorCode VecView_Seq(Vec, PetscViewer);
10 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
11 
12 #undef __FUNCT__
13 #define __FUNCT__ "VecView_Plex_Local"
14 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
15 {
16   DM             dm;
17   PetscBool      isvtk;
18   PetscErrorCode ierr;
19 
20   PetscFunctionBegin;
21   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
22   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
23   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK, &isvtk);CHKERRQ(ierr);
24   if (isvtk) {
25     PetscViewerVTKFieldType ft = PETSC_VTK_POINT_FIELD;
26     PetscSection            section;
27     PetscInt                dim, pStart, pEnd, cStart, fStart, vStart, cdof = 0, fdof = 0, vdof = 0;
28 
29     ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
30     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
31     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
32     ierr = DMPlexGetHeightStratum(dm, 1, &fStart, NULL);CHKERRQ(ierr);
33     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, NULL);CHKERRQ(ierr);
34     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
35     /* Assumes that numer of dofs per point of each stratum is constant, natural for VTK */
36     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &cdof);CHKERRQ(ierr);}
37     if ((fStart >= pStart) && (fStart < pEnd)) {ierr = PetscSectionGetDof(section, fStart, &fdof);CHKERRQ(ierr);}
38     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vdof);CHKERRQ(ierr);}
39     if (cdof && fdof && vdof) { /* Actually Q2 or some such, but visualize as Q1 */
40       ft = (cdof == dim) ? PETSC_VTK_POINT_VECTOR_FIELD : PETSC_VTK_POINT_FIELD;
41     } else if (cdof && vdof) {
42       SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"No support for viewing mixed space with dofs at both vertices and cells");
43     } else if (cdof) {
44       /* TODO: This assumption should be removed when there is a way of identifying whether a space is conceptually a
45        * vector or just happens to have the same number of dofs as the dimension. */
46       if (cdof == dim) {
47         ft = PETSC_VTK_CELL_VECTOR_FIELD;
48       } else {
49         ft = PETSC_VTK_CELL_FIELD;
50       }
51     } else if (vdof) {
52       if (vdof == dim) {
53         ft = PETSC_VTK_POINT_VECTOR_FIELD;
54       } else {
55         ft = PETSC_VTK_POINT_FIELD;
56       }
57     } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Could not classify input Vec for VTK");
58 
59     ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr); /* viewer drops reference */
60     ierr = PetscObjectReference((PetscObject) v);CHKERRQ(ierr);  /* viewer drops reference */
61     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, ft, (PetscObject) v);CHKERRQ(ierr);
62   } else {
63     PetscBool isseq;
64 
65     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
66     if (isseq) {
67       ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);
68     } else {
69       ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);
70     }
71   }
72   PetscFunctionReturn(0);
73 }
74 
75 #undef __FUNCT__
76 #define __FUNCT__ "VecView_Plex"
77 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
78 {
79   DM             dm;
80   PetscBool      isvtk;
81   PetscErrorCode ierr;
82 
83   PetscFunctionBegin;
84   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
85   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
86   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK, &isvtk);CHKERRQ(ierr);
87   if (isvtk) {
88     Vec         locv;
89     const char *name;
90 
91     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
92     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
93     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
94     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
95     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
96     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
97     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
98   } else {
99     PetscBool isseq;
100 
101     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
102     if (isseq) {
103       ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);
104     } else {
105       ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);
106     }
107   }
108   PetscFunctionReturn(0);
109 }
110 
111 #undef __FUNCT__
112 #define __FUNCT__ "DMPlexView_Ascii"
113 PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
114 {
115   DM_Plex          *mesh = (DM_Plex*) dm->data;
116   DM                cdm;
117   DMLabel           markers;
118   PetscSection      coordSection;
119   Vec               coordinates;
120   PetscViewerFormat format;
121   PetscErrorCode    ierr;
122 
123   PetscFunctionBegin;
124   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
125   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
126   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
127   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
128   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
129     const char *name;
130     PetscInt    maxConeSize, maxSupportSize;
131     PetscInt    pStart, pEnd, p;
132     PetscMPIInt rank, size;
133 
134     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
135     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
136     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
137     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
138     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
139     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
140     ierr = PetscViewerASCIIPrintf(viewer, "Mesh '%s':\n", name);CHKERRQ(ierr);
141     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "Max sizes cone: %D support: %D\n", maxConeSize, maxSupportSize);CHKERRQ(ierr);
142     ierr = PetscViewerASCIIPrintf(viewer, "orientation is missing\n", name);CHKERRQ(ierr);
143     ierr = PetscViewerASCIIPrintf(viewer, "cap --> base:\n", name);CHKERRQ(ierr);
144     for (p = pStart; p < pEnd; ++p) {
145       PetscInt dof, off, s;
146 
147       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
148       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
149       for (s = off; s < off+dof; ++s) {
150         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%D]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
151       }
152     }
153     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
154     ierr = PetscViewerASCIIPrintf(viewer, "base <-- cap:\n", name);CHKERRQ(ierr);
155     for (p = pStart; p < pEnd; ++p) {
156       PetscInt dof, off, c;
157 
158       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
159       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
160       for (c = off; c < off+dof; ++c) {
161         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%D]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
162       }
163     }
164     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
165     ierr = PetscSectionGetChart(coordSection, &pStart, NULL);CHKERRQ(ierr);
166     if (pStart >= 0) {ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);}
167     ierr = DMPlexGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
168     ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);
169     if (size > 1) {
170       PetscSF sf;
171 
172       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
173       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
174     }
175     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
176   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
177     const char  *name;
178     const char  *colors[3] = {"red", "blue", "green"};
179     const int    numColors  = 3;
180     PetscReal    scale      = 2.0;
181     PetscScalar *coords;
182     PetscInt     depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
183     PetscMPIInt  rank, size;
184 
185     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
186     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
187     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
188     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
189     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
190     ierr = PetscViewerASCIIPrintf(viewer, "\
191 \\documentclass[crop,multi=false]{standalone}\n\n\
192 \\usepackage{tikz}\n\
193 \\usepackage{pgflibraryshapes}\n\
194 \\usetikzlibrary{backgrounds}\n\
195 \\usetikzlibrary{arrows}\n\
196 \\begin{document}\n\
197 \\section{%s}\n\
198 \\begin{center}\n", name, 8.0/scale);CHKERRQ(ierr);
199     ierr = PetscViewerASCIIPrintf(viewer, "Mesh for process ");CHKERRQ(ierr);
200     for (p = 0; p < size; ++p) {
201       if (p > 0 && p == size-1) {
202         ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
203       } else if (p > 0) {
204         ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
205       }
206       ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
207     }
208     ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n\
209 \\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n");CHKERRQ(ierr);
210     /* Plot vertices */
211     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
212     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
213     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
214     for (v = vStart; v < vEnd; ++v) {
215       PetscInt off, dof, d;
216 
217       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
218       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
219       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
220       for (d = 0; d < dof; ++d) {
221         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
222         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*PetscRealPart(coords[off+d])));CHKERRQ(ierr);
223       }
224       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", v, rank, colors[rank%numColors], v);CHKERRQ(ierr);
225     }
226     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
227     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
228     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
229     /* Plot edges */
230     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
231     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
232     if (depth > 1) {ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);}
233     for (e = eStart; e < eEnd; ++e) {
234       const PetscInt *cone;
235       PetscInt        coneSize, offA, offB, dof, d;
236 
237       ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
238       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %d cone should have two vertices, not %d", e, coneSize);
239       ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
240       ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
241       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
242       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
243       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
244       for (d = 0; d < dof; ++d) {
245         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
246         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*0.5*PetscRealPart(coords[offA+d]+coords[offB+d])));CHKERRQ(ierr);
247       }
248       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", e, rank, colors[rank%numColors], e);CHKERRQ(ierr);
249     }
250     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
251     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
252     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
253     /* Plot cells */
254     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
255     for (c = cStart; c < cEnd; ++c) {
256       PetscInt *closure = NULL;
257       PetscInt  closureSize, firstPoint = -1;
258 
259       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
260       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
261       for (p = 0; p < closureSize*2; p += 2) {
262         const PetscInt point = closure[p];
263 
264         if ((point < vStart) || (point >= vEnd)) continue;
265         if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
266         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%D)", point, rank);CHKERRQ(ierr);
267         if (firstPoint < 0) firstPoint = point;
268       }
269       /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
270       ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%D);\n", firstPoint, rank);CHKERRQ(ierr);
271       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
272     }
273     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
274     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n\\end{center}\n");CHKERRQ(ierr);
275     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
276   } else {
277     MPI_Comm    comm;
278     PetscInt   *sizes, *hybsizes;
279     PetscInt    locDepth, depth, dim, d, pMax[4];
280     PetscInt    pStart, pEnd, p;
281     PetscInt    numLabels, l;
282     const char *name;
283     PetscMPIInt size;
284 
285     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
286     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
287     ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
288     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
289     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimensions:\n", name, dim);CHKERRQ(ierr);}
290     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimensions:\n", dim);CHKERRQ(ierr);}
291     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
292     ierr = MPI_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
293     ierr = DMPlexGetHybridBounds(dm, &pMax[depth], &pMax[depth-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
294     ierr = PetscMalloc2(size,&sizes,size,&hybsizes);CHKERRQ(ierr);
295     if (depth == 1) {
296       ierr = DMPlexGetDepthStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
297       pEnd = pEnd - pStart;
298       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
299       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", 0);CHKERRQ(ierr);
300       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
301       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
302       ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
303       pEnd = pEnd - pStart;
304       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
305       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", dim);CHKERRQ(ierr);
306       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
307       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
308     } else {
309       for (d = 0; d <= dim; d++) {
310         ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
311         pEnd    -= pStart;
312         pMax[d] -= pStart;
313         ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
314         ierr = MPI_Gather(&pMax[d], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
315         ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", d);CHKERRQ(ierr);
316         for (p = 0; p < size; ++p) {
317           if (hybsizes[p] >= 0) {ierr = PetscViewerASCIIPrintf(viewer, " %D (%D)", sizes[p], sizes[p] - hybsizes[p]);CHKERRQ(ierr);}
318           else                  {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
319         }
320         ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
321       }
322     }
323     ierr = PetscFree2(sizes,hybsizes);CHKERRQ(ierr);
324     ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
325     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
326     for (l = 0; l < numLabels; ++l) {
327       DMLabel         label;
328       const char     *name;
329       IS              valueIS;
330       const PetscInt *values;
331       PetscInt        numValues, v;
332 
333       ierr = DMPlexGetLabelName(dm, l, &name);CHKERRQ(ierr);
334       ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
335       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
336       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %d strata of sizes (", name, numValues);CHKERRQ(ierr);
337       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
338       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
339       for (v = 0; v < numValues; ++v) {
340         PetscInt size;
341 
342         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
343         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
344         ierr = PetscViewerASCIIPrintf(viewer, "%d", size);CHKERRQ(ierr);
345       }
346       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
347       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
348       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
349     }
350   }
351   PetscFunctionReturn(0);
352 }
353 
354 #undef __FUNCT__
355 #define __FUNCT__ "DMView_Plex"
356 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
357 {
358   PetscBool      iascii, isbinary;
359   PetscErrorCode ierr;
360 
361   PetscFunctionBegin;
362   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
363   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
364   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
365   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
366   if (iascii) {
367     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
368 #if 0
369   } else if (isbinary) {
370     ierr = DMPlexView_Binary(dm, viewer);CHKERRQ(ierr);
371 #endif
372   }
373   PetscFunctionReturn(0);
374 }
375 
376 #undef __FUNCT__
377 #define __FUNCT__ "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   /* Now all subdomains are oriented, but we need a consistent parallel orientation */
2285   {
2286     /* Find a representative face (edge) separating pairs of procs */
2287     PetscSF            sf;
2288     const PetscInt    *lpoints;
2289     const PetscSFNode *rpoints;
2290     PetscInt          *neighbors;
2291     PetscInt           numLeaves, numRoots, numNeighbors = 0, l, n;
2292     PetscBool          match;
2293 
2294     ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
2295     ierr = PetscSFGetGraph(sf, &numRoots, &numLeaves, &lpoints, &rpoints);CHKERRQ(ierr);
2296     if (numLeaves >= 0) {
2297       ierr = PetscMalloc1(numLeaves,&neighbors);CHKERRQ(ierr);
2298       /* I know this is p^2 time in general, but for bounded degree its alright */
2299       for (l = 0; l < numLeaves; ++l) {
2300         const PetscInt face = lpoints[l];
2301         if ((face >= fStart) && (face < fEnd)) {
2302           const PetscInt rank = rpoints[l].rank;
2303           for (n = 0; n < numNeighbors; ++n) if (rank == rpoints[neighbors[n]].rank) break;
2304           if (n >= numNeighbors) {
2305             PetscInt supportSize;
2306             ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2307             if (supportSize != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Boundary faces should see one cell, not %d", supportSize);
2308             neighbors[numNeighbors++] = l;
2309           }
2310         }
2311       }
2312       const PetscInt *cone, *ornt, *support;
2313       PetscInt        coneSize, supportSize;
2314       int            *rornt, *lornt; /* PetscSF cannot handle smaller than int */
2315 
2316       ierr = PetscCalloc2(numRoots,&rornt,numRoots,&lornt);CHKERRQ(ierr);
2317       for (face = fStart; face < fEnd; ++face) {
2318         ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
2319         if (supportSize != 1) continue;
2320         ierr = DMPlexGetSupport(dm, face, &support);CHKERRQ(ierr);
2321 
2322         ierr = DMPlexGetCone(dm, support[0], &cone);CHKERRQ(ierr);
2323         ierr = DMPlexGetConeOrientation(dm, support[0], &ornt);CHKERRQ(ierr);
2324         for (c = 0; c < coneSize; ++c) if (cone[c] == face) break;
2325         if (PetscBTLookup(flippedCells, support[0]-cStart)) rornt[face] = ornt[c] < 0 ? -1 :  1;
2326         else                                                rornt[face] = ornt[c] < 0 ?  1 : -1;
2327       }
2328       /* Mark each edge with match or nomatch */
2329       ierr = PetscSFBcastBegin(sf, MPI_INT, rornt, lornt);CHKERRQ(ierr);
2330       ierr = PetscSFBcastEnd(sf, MPI_INT, rornt, lornt);CHKERRQ(ierr);
2331       for (n = 0; n < numNeighbors; ++n) {
2332         const PetscInt face = lpoints[neighbors[n]];
2333 
2334         if (rornt[face]*lornt[face] < 0) match = PETSC_TRUE;
2335         else                             match = PETSC_FALSE;
2336       }
2337       ierr = PetscFree2(rornt,lornt);CHKERRQ(ierr);
2338       ierr = PetscFree(neighbors);CHKERRQ(ierr);
2339     }
2340     /*
2341        - Vertex can be flipped, which negates all edges
2342        - How do we solve this graph problem? I think we can do the same algorithm, BFS using a FIFO
2343     */
2344     if (!match) {for (c = cStart; c < cEnd; ++c) {ierr = PetscBTNegate(flippedCells, c-cStart);CHKERRQ(ierr);}}
2345   }
2346   /* Reverse flipped cells in the mesh */
2347   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2348   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2349   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2350   for (c = cStart; c < cEnd; ++c) {
2351     const PetscInt *cone, *coneO, *support;
2352     PetscInt        coneSize, supportSize, faceSize, cp, sp;
2353 
2354     if (!PetscBTLookup(flippedCells, c-cStart)) continue;
2355     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
2356     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
2357     ierr = DMPlexGetConeOrientation(dm, c, &coneO);CHKERRQ(ierr);
2358     for (cp = 0; cp < coneSize; ++cp) {
2359       const PetscInt rcp = coneSize-cp-1;
2360 
2361       ierr = DMPlexGetConeSize(dm, cone[rcp], &faceSize);CHKERRQ(ierr);
2362       revcone[cp]  = cone[rcp];
2363       revconeO[cp] = coneO[rcp] >= 0 ? -(faceSize-coneO[rcp]) : faceSize+coneO[rcp];
2364     }
2365     ierr = DMPlexSetCone(dm, c, revcone);CHKERRQ(ierr);
2366     ierr = DMPlexSetConeOrientation(dm, c, revconeO);CHKERRQ(ierr);
2367     /* Reverse orientations of support */
2368     faceSize = coneSize;
2369     ierr = DMPlexGetSupportSize(dm, c, &supportSize);CHKERRQ(ierr);
2370     ierr = DMPlexGetSupport(dm, c, &support);CHKERRQ(ierr);
2371     for (sp = 0; sp < supportSize; ++sp) {
2372       ierr = DMPlexGetConeSize(dm, support[sp], &coneSize);CHKERRQ(ierr);
2373       ierr = DMPlexGetCone(dm, support[sp], &cone);CHKERRQ(ierr);
2374       ierr = DMPlexGetConeOrientation(dm, support[sp], &coneO);CHKERRQ(ierr);
2375       for (cp = 0; cp < coneSize; ++cp) {
2376         if (cone[cp] != c) continue;
2377         ierr = DMPlexInsertConeOrientation(dm, support[sp], cp, coneO[cp] >= 0 ? -(faceSize-coneO[cp]) : faceSize+coneO[cp]);CHKERRQ(ierr);
2378       }
2379     }
2380   }
2381   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
2382   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
2383   ierr = PetscBTDestroy(&seenCells);CHKERRQ(ierr);
2384   ierr = PetscBTDestroy(&flippedCells);CHKERRQ(ierr);
2385   ierr = PetscBTDestroy(&seenFaces);CHKERRQ(ierr);
2386   ierr = PetscFree(faceFIFO);CHKERRQ(ierr);
2387   PetscFunctionReturn(0);
2388 }
2389 
2390 #undef __FUNCT__
2391 #define __FUNCT__ "DMPlexGetAdjacencySingleLevel_Internal"
2392 static PetscErrorCode DMPlexGetAdjacencySingleLevel_Internal(DM dm, PetscInt p, PetscBool useClosure, const PetscInt *tmpClosure, PetscInt *adjSize, PetscInt adj[])
2393 {
2394   const PetscInt *support = NULL;
2395   PetscInt        numAdj   = 0, maxAdjSize = *adjSize, supportSize, s;
2396   PetscErrorCode  ierr;
2397 
2398   PetscFunctionBegin;
2399   if (useClosure) {
2400     ierr = DMPlexGetConeSize(dm, p, &supportSize);CHKERRQ(ierr);
2401     ierr = DMPlexGetCone(dm, p, &support);CHKERRQ(ierr);
2402     for (s = 0; s < supportSize; ++s) {
2403       const PetscInt *cone = NULL;
2404       PetscInt        coneSize, c, q;
2405 
2406       ierr = DMPlexGetSupportSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2407       ierr = DMPlexGetSupport(dm, support[s], &cone);CHKERRQ(ierr);
2408       for (c = 0; c < coneSize; ++c) {
2409         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2410           if (cone[c] == adj[q]) break;
2411         }
2412         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2413       }
2414     }
2415   } else {
2416     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2417     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
2418     for (s = 0; s < supportSize; ++s) {
2419       const PetscInt *cone = NULL;
2420       PetscInt        coneSize, c, q;
2421 
2422       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
2423       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
2424       for (c = 0; c < coneSize; ++c) {
2425         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
2426           if (cone[c] == adj[q]) break;
2427         }
2428         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
2429       }
2430     }
2431   }
2432   *adjSize = numAdj;
2433   PetscFunctionReturn(0);
2434 }
2435 
2436 #undef __FUNCT__
2437 #define __FUNCT__ "DMPlexCreateNeighborCSR"
2438 PetscErrorCode DMPlexCreateNeighborCSR(DM dm, PetscInt cellHeight, PetscInt *numVertices, PetscInt **offsets, PetscInt **adjacency)
2439 {
2440   const PetscInt maxFaceCases = 30;
2441   PetscInt       numFaceCases = 0;
2442   PetscInt       numFaceVertices[30]; /* maxFaceCases, C89 sucks sucks sucks */
2443   PetscInt      *off, *adj;
2444   PetscInt      *neighborCells, *tmpClosure;
2445   PetscInt       maxConeSize, maxSupportSize, maxClosure, maxNeighbors;
2446   PetscInt       dim, cellDim, depth = 0, faceDepth, cStart, cEnd, c, numCells, cell;
2447   PetscErrorCode ierr;
2448 
2449   PetscFunctionBegin;
2450   /* For parallel partitioning, I think you have to communicate supports */
2451   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2452   cellDim = dim - cellHeight;
2453   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2454   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2455   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
2456   if (cEnd - cStart == 0) {
2457     if (numVertices) *numVertices = 0;
2458     if (offsets)   *offsets   = NULL;
2459     if (adjacency) *adjacency = NULL;
2460     PetscFunctionReturn(0);
2461   }
2462   numCells  = cEnd - cStart;
2463   faceDepth = depth - cellHeight;
2464   if (dim == depth) {
2465     PetscInt f, fStart, fEnd;
2466 
2467     ierr = PetscCalloc1(numCells+1, &off);CHKERRQ(ierr);
2468     /* Count neighboring cells */
2469     ierr = DMPlexGetHeightStratum(dm, cellHeight+1, &fStart, &fEnd);CHKERRQ(ierr);
2470     for (f = fStart; f < fEnd; ++f) {
2471       const PetscInt *support;
2472       PetscInt        supportSize;
2473       ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
2474       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
2475       if (supportSize == 2) {
2476         ++off[support[0]-cStart+1];
2477         ++off[support[1]-cStart+1];
2478       }
2479     }
2480     /* Prefix sum */
2481     for (c = 1; c <= numCells; ++c) off[c] += off[c-1];
2482     if (adjacency) {
2483       PetscInt *tmp;
2484 
2485       ierr = PetscMalloc1(off[numCells], &adj);CHKERRQ(ierr);
2486       ierr = PetscMalloc1((numCells+1), &tmp);CHKERRQ(ierr);
2487       ierr = PetscMemcpy(tmp, off, (numCells+1) * sizeof(PetscInt));CHKERRQ(ierr);
2488       /* Get neighboring cells */
2489       for (f = fStart; f < fEnd; ++f) {
2490         const PetscInt *support;
2491         PetscInt        supportSize;
2492         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
2493         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
2494         if (supportSize == 2) {
2495           adj[tmp[support[0]-cStart]++] = support[1];
2496           adj[tmp[support[1]-cStart]++] = support[0];
2497         }
2498       }
2499 #if defined(PETSC_USE_DEBUG)
2500       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);
2501 #endif
2502       ierr = PetscFree(tmp);CHKERRQ(ierr);
2503     }
2504     if (numVertices) *numVertices = numCells;
2505     if (offsets)   *offsets   = off;
2506     if (adjacency) *adjacency = adj;
2507     PetscFunctionReturn(0);
2508   }
2509   /* Setup face recognition */
2510   if (faceDepth == 1) {
2511     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 */
2512 
2513     for (c = cStart; c < cEnd; ++c) {
2514       PetscInt corners;
2515 
2516       ierr = DMPlexGetConeSize(dm, c, &corners);CHKERRQ(ierr);
2517       if (!cornersSeen[corners]) {
2518         PetscInt nFV;
2519 
2520         if (numFaceCases >= maxFaceCases) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Exceeded maximum number of face recognition cases");
2521         cornersSeen[corners] = 1;
2522 
2523         ierr = DMPlexGetNumFaceVertices(dm, cellDim, corners, &nFV);CHKERRQ(ierr);
2524 
2525         numFaceVertices[numFaceCases++] = nFV;
2526       }
2527     }
2528   }
2529   maxClosure   = 2*PetscMax(PetscPowInt(maxConeSize,depth+1),PetscPowInt(maxSupportSize,depth+1));
2530   maxNeighbors = PetscPowInt(maxConeSize,depth+1)*PetscPowInt(maxSupportSize,depth+1);
2531   ierr         = PetscMalloc2(maxNeighbors,&neighborCells,maxClosure,&tmpClosure);CHKERRQ(ierr);
2532   ierr         = PetscCalloc1(numCells+1, &off);CHKERRQ(ierr);
2533   /* Count neighboring cells */
2534   for (cell = cStart; cell < cEnd; ++cell) {
2535     PetscInt numNeighbors = maxNeighbors, n;
2536 
2537     ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2538     /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2539     for (n = 0; n < numNeighbors; ++n) {
2540       PetscInt        cellPair[2];
2541       PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2542       PetscInt        meetSize = 0;
2543       const PetscInt *meet    = NULL;
2544 
2545       cellPair[0] = cell; cellPair[1] = neighborCells[n];
2546       if (cellPair[0] == cellPair[1]) continue;
2547       if (!found) {
2548         ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2549         if (meetSize) {
2550           PetscInt f;
2551 
2552           for (f = 0; f < numFaceCases; ++f) {
2553             if (numFaceVertices[f] == meetSize) {
2554               found = PETSC_TRUE;
2555               break;
2556             }
2557           }
2558         }
2559         ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2560       }
2561       if (found) ++off[cell-cStart+1];
2562     }
2563   }
2564   /* Prefix sum */
2565   for (cell = 1; cell <= numCells; ++cell) off[cell] += off[cell-1];
2566 
2567   if (adjacency) {
2568     ierr = PetscMalloc1(off[numCells], &adj);CHKERRQ(ierr);
2569     /* Get neighboring cells */
2570     for (cell = cStart; cell < cEnd; ++cell) {
2571       PetscInt numNeighbors = maxNeighbors, n;
2572       PetscInt cellOffset   = 0;
2573 
2574       ierr = DMPlexGetAdjacencySingleLevel_Internal(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2575       /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2576       for (n = 0; n < numNeighbors; ++n) {
2577         PetscInt        cellPair[2];
2578         PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2579         PetscInt        meetSize = 0;
2580         const PetscInt *meet    = NULL;
2581 
2582         cellPair[0] = cell; cellPair[1] = neighborCells[n];
2583         if (cellPair[0] == cellPair[1]) continue;
2584         if (!found) {
2585           ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2586           if (meetSize) {
2587             PetscInt f;
2588 
2589             for (f = 0; f < numFaceCases; ++f) {
2590               if (numFaceVertices[f] == meetSize) {
2591                 found = PETSC_TRUE;
2592                 break;
2593               }
2594             }
2595           }
2596           ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2597         }
2598         if (found) {
2599           adj[off[cell-cStart]+cellOffset] = neighborCells[n];
2600           ++cellOffset;
2601         }
2602       }
2603     }
2604   }
2605   ierr = PetscFree2(neighborCells,tmpClosure);CHKERRQ(ierr);
2606   if (numVertices) *numVertices = numCells;
2607   if (offsets)   *offsets   = off;
2608   if (adjacency) *adjacency = adj;
2609   PetscFunctionReturn(0);
2610 }
2611 
2612 #if defined(PETSC_HAVE_CHACO)
2613 #if defined(PETSC_HAVE_UNISTD_H)
2614 #include <unistd.h>
2615 #endif
2616 /* Chaco does not have an include file */
2617 PETSC_EXTERN int interface(int nvtxs, int *start, int *adjacency, int *vwgts,
2618                        float *ewgts, float *x, float *y, float *z, char *outassignname,
2619                        char *outfilename, short *assignment, int architecture, int ndims_tot,
2620                        int mesh_dims[3], double *goal, int global_method, int local_method,
2621                        int rqi_flag, int vmax, int ndims, double eigtol, long seed);
2622 
2623 extern int FREE_GRAPH;
2624 
2625 #undef __FUNCT__
2626 #define __FUNCT__ "DMPlexPartition_Chaco"
2627 PetscErrorCode DMPlexPartition_Chaco(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2628 {
2629   enum {DEFAULT_METHOD = 1, INERTIAL_METHOD = 3};
2630   MPI_Comm       comm;
2631   int            nvtxs          = numVertices; /* number of vertices in full graph */
2632   int           *vwgts          = NULL;   /* weights for all vertices */
2633   float         *ewgts          = NULL;   /* weights for all edges */
2634   float         *x              = NULL, *y = NULL, *z = NULL; /* coordinates for inertial method */
2635   char          *outassignname  = NULL;   /*  name of assignment output file */
2636   char          *outfilename    = NULL;   /* output file name */
2637   int            architecture   = 1;      /* 0 => hypercube, d => d-dimensional mesh */
2638   int            ndims_tot      = 0;      /* total number of cube dimensions to divide */
2639   int            mesh_dims[3];            /* dimensions of mesh of processors */
2640   double        *goal          = NULL;    /* desired set sizes for each set */
2641   int            global_method = 1;       /* global partitioning algorithm */
2642   int            local_method  = 1;       /* local partitioning algorithm */
2643   int            rqi_flag      = 0;       /* should I use RQI/Symmlq eigensolver? */
2644   int            vmax          = 200;     /* how many vertices to coarsen down to? */
2645   int            ndims         = 1;       /* number of eigenvectors (2^d sets) */
2646   double         eigtol        = 0.001;   /* tolerance on eigenvectors */
2647   long           seed          = 123636512; /* for random graph mutations */
2648   short int     *assignment;              /* Output partition */
2649   int            fd_stdout, fd_pipe[2];
2650   PetscInt      *points;
2651   PetscMPIInt    commSize;
2652   int            i, v, p;
2653   PetscErrorCode ierr;
2654 
2655   PetscFunctionBegin;
2656   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2657   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2658   if (!numVertices) {
2659     ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2660     ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2661     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2662     ierr = ISCreateGeneral(comm, 0, NULL, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2663     PetscFunctionReturn(0);
2664   }
2665   FREE_GRAPH = 0;                         /* Do not let Chaco free my memory */
2666   for (i = 0; i < start[numVertices]; ++i) ++adjacency[i];
2667 
2668   if (global_method == INERTIAL_METHOD) {
2669     /* manager.createCellCoordinates(nvtxs, &x, &y, &z); */
2670     SETERRQ(comm, PETSC_ERR_SUP, "Inertial partitioning not yet supported");
2671   }
2672   mesh_dims[0] = commSize;
2673   mesh_dims[1] = 1;
2674   mesh_dims[2] = 1;
2675   ierr = PetscMalloc1(nvtxs, &assignment);CHKERRQ(ierr);
2676   /* Chaco outputs to stdout. We redirect this to a buffer. */
2677   /* TODO: check error codes for UNIX calls */
2678 #if defined(PETSC_HAVE_UNISTD_H)
2679   {
2680     int piperet;
2681     piperet = pipe(fd_pipe);
2682     if (piperet) SETERRQ(comm,PETSC_ERR_SYS,"Could not create pipe");
2683     fd_stdout = dup(1);
2684     close(1);
2685     dup2(fd_pipe[1], 1);
2686   }
2687 #endif
2688   ierr = interface(nvtxs, (int*) start, (int*) adjacency, vwgts, ewgts, x, y, z, outassignname, outfilename,
2689                    assignment, architecture, ndims_tot, mesh_dims, goal, global_method, local_method, rqi_flag,
2690                    vmax, ndims, eigtol, seed);
2691 #if defined(PETSC_HAVE_UNISTD_H)
2692   {
2693     char msgLog[10000];
2694     int  count;
2695 
2696     fflush(stdout);
2697     count = read(fd_pipe[0], msgLog, (10000-1)*sizeof(char));
2698     if (count < 0) count = 0;
2699     msgLog[count] = 0;
2700     close(1);
2701     dup2(fd_stdout, 1);
2702     close(fd_stdout);
2703     close(fd_pipe[0]);
2704     close(fd_pipe[1]);
2705     if (ierr) SETERRQ1(comm, PETSC_ERR_LIB, "Error in Chaco library: %s", msgLog);
2706   }
2707 #endif
2708   /* Convert to PetscSection+IS */
2709   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2710   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2711   for (v = 0; v < nvtxs; ++v) {
2712     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2713   }
2714   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2715   ierr = PetscMalloc1(nvtxs, &points);CHKERRQ(ierr);
2716   for (p = 0, i = 0; p < commSize; ++p) {
2717     for (v = 0; v < nvtxs; ++v) {
2718       if (assignment[v] == p) points[i++] = v;
2719     }
2720   }
2721   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2722   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2723   if (global_method == INERTIAL_METHOD) {
2724     /* manager.destroyCellCoordinates(nvtxs, &x, &y, &z); */
2725   }
2726   ierr = PetscFree(assignment);CHKERRQ(ierr);
2727   for (i = 0; i < start[numVertices]; ++i) --adjacency[i];
2728   PetscFunctionReturn(0);
2729 }
2730 #endif
2731 
2732 #if defined(PETSC_HAVE_PARMETIS)
2733 #include <parmetis.h>
2734 
2735 #undef __FUNCT__
2736 #define __FUNCT__ "DMPlexPartition_ParMetis"
2737 PetscErrorCode DMPlexPartition_ParMetis(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2738 {
2739   MPI_Comm       comm;
2740   PetscInt       nvtxs      = numVertices; /* The number of vertices in full graph */
2741   PetscInt      *vtxdist;                  /* Distribution of vertices across processes */
2742   PetscInt      *xadj       = start;       /* Start of edge list for each vertex */
2743   PetscInt      *adjncy     = adjacency;   /* Edge lists for all vertices */
2744   PetscInt      *vwgt       = NULL;        /* Vertex weights */
2745   PetscInt      *adjwgt     = NULL;        /* Edge weights */
2746   PetscInt       wgtflag    = 0;           /* Indicates which weights are present */
2747   PetscInt       numflag    = 0;           /* Indicates initial offset (0 or 1) */
2748   PetscInt       ncon       = 1;           /* The number of weights per vertex */
2749   PetscInt       nparts;                   /* The number of partitions */
2750   PetscReal     *tpwgts;                   /* The fraction of vertex weights assigned to each partition */
2751   PetscReal     *ubvec;                    /* The balance intolerance for vertex weights */
2752   PetscInt       options[5];               /* Options */
2753   /* Outputs */
2754   PetscInt       edgeCut;                  /* The number of edges cut by the partition */
2755   PetscInt      *assignment, *points;
2756   PetscMPIInt    commSize, rank, p, v, i;
2757   PetscErrorCode ierr;
2758 
2759   PetscFunctionBegin;
2760   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
2761   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2762   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
2763   nparts = commSize;
2764   options[0] = 0; /* Use all defaults */
2765   /* Calculate vertex distribution */
2766   ierr = PetscMalloc4(nparts+1,&vtxdist,nparts*ncon,&tpwgts,ncon,&ubvec,nvtxs,&assignment);CHKERRQ(ierr);
2767   vtxdist[0] = 0;
2768   ierr = MPI_Allgather(&nvtxs, 1, MPIU_INT, &vtxdist[1], 1, MPIU_INT, comm);CHKERRQ(ierr);
2769   for (p = 2; p <= nparts; ++p) {
2770     vtxdist[p] += vtxdist[p-1];
2771   }
2772   /* Calculate weights */
2773   for (p = 0; p < nparts; ++p) {
2774     tpwgts[p] = 1.0/nparts;
2775   }
2776   ubvec[0] = 1.05;
2777 
2778   if (nparts == 1) {
2779     ierr = PetscMemzero(assignment, nvtxs * sizeof(PetscInt));
2780   } else {
2781     if (vtxdist[1] == vtxdist[nparts]) {
2782       if (!rank) {
2783         PetscStackPush("METIS_PartGraphKway");
2784         ierr = METIS_PartGraphKway(&nvtxs, &ncon, xadj, adjncy, vwgt, NULL, adjwgt, &nparts, tpwgts, ubvec, NULL, &edgeCut, assignment);
2785         PetscStackPop;
2786         if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in METIS_PartGraphKway()");
2787       }
2788     } else {
2789       PetscStackPush("ParMETIS_V3_PartKway");
2790       ierr = ParMETIS_V3_PartKway(vtxdist, xadj, adjncy, vwgt, adjwgt, &wgtflag, &numflag, &ncon, &nparts, tpwgts, ubvec, options, &edgeCut, assignment, &comm);
2791       PetscStackPop;
2792       if (ierr != METIS_OK) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in ParMETIS_V3_PartKway()");
2793     }
2794   }
2795   /* Convert to PetscSection+IS */
2796   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2797   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2798   for (v = 0; v < nvtxs; ++v) {
2799     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2800   }
2801   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2802   ierr = PetscMalloc1(nvtxs, &points);CHKERRQ(ierr);
2803   for (p = 0, i = 0; p < commSize; ++p) {
2804     for (v = 0; v < nvtxs; ++v) {
2805       if (assignment[v] == p) points[i++] = v;
2806     }
2807   }
2808   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2809   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2810   ierr = PetscFree4(vtxdist,tpwgts,ubvec,assignment);CHKERRQ(ierr);
2811   PetscFunctionReturn(0);
2812 }
2813 #endif
2814 
2815 #undef __FUNCT__
2816 #define __FUNCT__ "DMPlexEnlargePartition"
2817 /* Expand the partition by BFS on the adjacency graph */
2818 PetscErrorCode DMPlexEnlargePartition(DM dm, const PetscInt start[], const PetscInt adjacency[], PetscSection origPartSection, IS origPartition, PetscSection *partSection, IS *partition)
2819 {
2820   PetscHashI      h;
2821   const PetscInt *points;
2822   PetscInt      **tmpPoints, *newPoints, totPoints = 0;
2823   PetscInt        pStart, pEnd, part, q;
2824   PetscErrorCode  ierr;
2825 
2826   PetscFunctionBegin;
2827   PetscHashICreate(h);
2828   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2829   ierr = PetscSectionGetChart(origPartSection, &pStart, &pEnd);CHKERRQ(ierr);
2830   ierr = PetscSectionSetChart(*partSection, pStart, pEnd);CHKERRQ(ierr);
2831   ierr = ISGetIndices(origPartition, &points);CHKERRQ(ierr);
2832   ierr = PetscMalloc1((pEnd - pStart), &tmpPoints);CHKERRQ(ierr);
2833   for (part = pStart; part < pEnd; ++part) {
2834     PetscInt numPoints, nP, numNewPoints, off, p, n = 0;
2835 
2836     PetscHashIClear(h);
2837     ierr = PetscSectionGetDof(origPartSection, part, &numPoints);CHKERRQ(ierr);
2838     ierr = PetscSectionGetOffset(origPartSection, part, &off);CHKERRQ(ierr);
2839     /* Add all existing points to h */
2840     for (p = 0; p < numPoints; ++p) {
2841       const PetscInt point = points[off+p];
2842       PetscHashIAdd(h, point, 1);
2843     }
2844     PetscHashISize(h, nP);
2845     if (nP != numPoints) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid partition has %d points, but only %d were unique", numPoints, nP);
2846     /* Add all points in next BFS level */
2847     /*   TODO We are brute forcing here, but could check the adjacency size to find the boundary */
2848     for (p = 0; p < numPoints; ++p) {
2849       const PetscInt point = points[off+p];
2850       PetscInt       s     = start[point], e = start[point+1], a;
2851 
2852       for (a = s; a < e; ++a) PetscHashIAdd(h, adjacency[a], 1);
2853     }
2854     PetscHashISize(h, numNewPoints);
2855     ierr = PetscSectionSetDof(*partSection, part, numNewPoints);CHKERRQ(ierr);
2856     ierr = PetscMalloc1(numNewPoints, &tmpPoints[part]);CHKERRQ(ierr);
2857     ierr =  PetscHashIGetKeys(h, &n, tmpPoints[part]);CHKERRQ(ierr);
2858     totPoints += numNewPoints;
2859   }
2860   ierr = ISRestoreIndices(origPartition, &points);CHKERRQ(ierr);
2861   PetscHashIDestroy(h);
2862   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2863   ierr = PetscMalloc1(totPoints, &newPoints);CHKERRQ(ierr);
2864   for (part = pStart, q = 0; part < pEnd; ++part) {
2865     PetscInt numPoints, p;
2866 
2867     ierr = PetscSectionGetDof(*partSection, part, &numPoints);CHKERRQ(ierr);
2868     for (p = 0; p < numPoints; ++p, ++q) newPoints[q] = tmpPoints[part][p];
2869     ierr = PetscFree(tmpPoints[part]);CHKERRQ(ierr);
2870   }
2871   ierr = PetscFree(tmpPoints);CHKERRQ(ierr);
2872   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), totPoints, newPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2873   PetscFunctionReturn(0);
2874 }
2875 
2876 #undef __FUNCT__
2877 #define __FUNCT__ "DMPlexCreatePartition"
2878 /*
2879   DMPlexCreatePartition - Create a non-overlapping partition of the points at the given height
2880 
2881   Collective on DM
2882 
2883   Input Parameters:
2884   + dm - The DM
2885   . height - The height for points in the partition
2886   - enlarge - Expand each partition with neighbors
2887 
2888   Output Parameters:
2889   + partSection - The PetscSection giving the division of points by partition
2890   . partition - The list of points by partition
2891   . origPartSection - If enlarge is true, the PetscSection giving the division of points before enlarging by partition, otherwise NULL
2892   - origPartition - If enlarge is true, the list of points before enlarging by partition, otherwise NULL
2893 
2894   Level: developer
2895 
2896 .seealso DMPlexDistribute()
2897 */
2898 PetscErrorCode DMPlexCreatePartition(DM dm, const char name[], PetscInt height, PetscBool enlarge, PetscSection *partSection, IS *partition, PetscSection *origPartSection, IS *origPartition)
2899 {
2900   char           partname[1024];
2901   PetscBool      isChaco = PETSC_FALSE, isMetis = PETSC_FALSE, flg;
2902   PetscMPIInt    size;
2903   PetscErrorCode ierr;
2904 
2905   PetscFunctionBegin;
2906   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
2907 
2908   *origPartSection = NULL;
2909   *origPartition   = NULL;
2910   if (size == 1) {
2911     PetscInt *points;
2912     PetscInt  cStart, cEnd, c;
2913 
2914     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2915     ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2916     ierr = PetscSectionSetChart(*partSection, 0, size);CHKERRQ(ierr);
2917     ierr = PetscSectionSetDof(*partSection, 0, cEnd-cStart);CHKERRQ(ierr);
2918     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2919     ierr = PetscMalloc1((cEnd - cStart), &points);CHKERRQ(ierr);
2920     for (c = cStart; c < cEnd; ++c) points[c] = c;
2921     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), cEnd-cStart, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2922     PetscFunctionReturn(0);
2923   }
2924   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_partitioner", partname, 1024, &flg);CHKERRQ(ierr);
2925   if (flg) name = partname;
2926   if (name) {
2927     ierr = PetscStrcmp(name, "chaco", &isChaco);CHKERRQ(ierr);
2928     ierr = PetscStrcmp(name, "metis", &isMetis);CHKERRQ(ierr);
2929   }
2930   if (height == 0) {
2931     PetscInt  numVertices;
2932     PetscInt *start     = NULL;
2933     PetscInt *adjacency = NULL;
2934 
2935     ierr = DMPlexCreateNeighborCSR(dm, 0, &numVertices, &start, &adjacency);CHKERRQ(ierr);
2936     if (!name || isChaco) {
2937 #if defined(PETSC_HAVE_CHACO)
2938       ierr = DMPlexPartition_Chaco(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2939 #else
2940       SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Mesh partitioning needs external package support.\nPlease reconfigure with --download-chaco.");
2941 #endif
2942     } else if (isMetis) {
2943 #if defined(PETSC_HAVE_PARMETIS)
2944       ierr = DMPlexPartition_ParMetis(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2945 #endif
2946     } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Unknown mesh partitioning package %s", name);
2947     if (enlarge) {
2948       *origPartSection = *partSection;
2949       *origPartition   = *partition;
2950 
2951       ierr = DMPlexEnlargePartition(dm, start, adjacency, *origPartSection, *origPartition, partSection, partition);CHKERRQ(ierr);
2952     }
2953     ierr = PetscFree(start);CHKERRQ(ierr);
2954     ierr = PetscFree(adjacency);CHKERRQ(ierr);
2955 # if 0
2956   } else if (height == 1) {
2957     /* Build the dual graph for faces and partition the hypergraph */
2958     PetscInt numEdges;
2959 
2960     buildFaceCSRV(mesh, mesh->getFactory()->getNumbering(mesh, mesh->depth()-1), &numEdges, &start, &adjacency, GraphPartitioner::zeroBase());
2961     GraphPartitioner().partition(numEdges, start, adjacency, partition, manager);
2962     destroyCSR(numEdges, start, adjacency);
2963 #endif
2964   } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid partition height %D", height);
2965   PetscFunctionReturn(0);
2966 }
2967 
2968 #undef __FUNCT__
2969 #define __FUNCT__ "DMPlexCreatePartitionClosure"
2970 PetscErrorCode DMPlexCreatePartitionClosure(DM dm, PetscSection pointSection, IS pointPartition, PetscSection *section, IS *partition)
2971 {
2972   /* const PetscInt  height = 0; */
2973   const PetscInt *partArray;
2974   PetscInt       *allPoints, *packPoints;
2975   PetscInt        rStart, rEnd, rank, pStart, pEnd, newSize;
2976   PetscErrorCode  ierr;
2977   PetscBT         bt;
2978   PetscSegBuffer  segpack,segpart;
2979 
2980   PetscFunctionBegin;
2981   ierr = PetscSectionGetChart(pointSection, &rStart, &rEnd);CHKERRQ(ierr);
2982   ierr = ISGetIndices(pointPartition, &partArray);CHKERRQ(ierr);
2983   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2984   ierr = PetscSectionSetChart(*section, rStart, rEnd);CHKERRQ(ierr);
2985   ierr = DMPlexGetChart(dm,&pStart,&pEnd);CHKERRQ(ierr);
2986   ierr = PetscBTCreate(pEnd-pStart,&bt);CHKERRQ(ierr);
2987   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpack);CHKERRQ(ierr);
2988   ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&segpart);CHKERRQ(ierr);
2989   for (rank = rStart; rank < rEnd; ++rank) {
2990     PetscInt partSize = 0, numPoints, offset, p, *PETSC_RESTRICT placePoints;
2991 
2992     ierr = PetscSectionGetDof(pointSection, rank, &numPoints);CHKERRQ(ierr);
2993     ierr = PetscSectionGetOffset(pointSection, rank, &offset);CHKERRQ(ierr);
2994     for (p = 0; p < numPoints; ++p) {
2995       PetscInt  point   = partArray[offset+p], closureSize, c;
2996       PetscInt *closure = NULL;
2997 
2998       /* TODO Include support for height > 0 case */
2999       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3000       for (c=0; c<closureSize; c++) {
3001         PetscInt cpoint = closure[c*2];
3002         if (!PetscBTLookupSet(bt,cpoint-pStart)) {
3003           PetscInt *PETSC_RESTRICT pt;
3004           partSize++;
3005           ierr = PetscSegBufferGetInts(segpart,1,&pt);CHKERRQ(ierr);
3006           *pt = cpoint;
3007         }
3008       }
3009       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3010     }
3011     ierr = PetscSectionSetDof(*section, rank, partSize);CHKERRQ(ierr);
3012     ierr = PetscSegBufferGetInts(segpack,partSize,&placePoints);CHKERRQ(ierr);
3013     ierr = PetscSegBufferExtractTo(segpart,placePoints);CHKERRQ(ierr);
3014     ierr = PetscSortInt(partSize,placePoints);CHKERRQ(ierr);
3015     for (p=0; p<partSize; p++) {ierr = PetscBTClear(bt,placePoints[p]-pStart);CHKERRQ(ierr);}
3016   }
3017   ierr = PetscBTDestroy(&bt);CHKERRQ(ierr);
3018   ierr = PetscSegBufferDestroy(&segpart);CHKERRQ(ierr);
3019 
3020   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3021   ierr = PetscSectionGetStorageSize(*section, &newSize);CHKERRQ(ierr);
3022   ierr = PetscMalloc1(newSize, &allPoints);CHKERRQ(ierr);
3023 
3024   ierr = PetscSegBufferExtractInPlace(segpack,&packPoints);CHKERRQ(ierr);
3025   for (rank = rStart; rank < rEnd; ++rank) {
3026     PetscInt numPoints, offset;
3027 
3028     ierr = PetscSectionGetDof(*section, rank, &numPoints);CHKERRQ(ierr);
3029     ierr = PetscSectionGetOffset(*section, rank, &offset);CHKERRQ(ierr);
3030     ierr = PetscMemcpy(&allPoints[offset], packPoints, numPoints * sizeof(PetscInt));CHKERRQ(ierr);
3031     packPoints += numPoints;
3032   }
3033 
3034   ierr = PetscSegBufferDestroy(&segpack);CHKERRQ(ierr);
3035   ierr = ISRestoreIndices(pointPartition, &partArray);CHKERRQ(ierr);
3036   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), newSize, allPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
3037   PetscFunctionReturn(0);
3038 }
3039 
3040 #undef __FUNCT__
3041 #define __FUNCT__ "DMPlexDistributeField"
3042 /*@
3043   DMPlexDistributeField - Distribute field data to match a given PetscSF, usually the SF from mesh distribution
3044 
3045   Collective on DM
3046 
3047   Input Parameters:
3048 + dm - The DMPlex object
3049 . pointSF - The PetscSF describing the communication pattern
3050 . originalSection - The PetscSection for existing data layout
3051 - originalVec - The existing data
3052 
3053   Output Parameters:
3054 + newSection - The PetscSF describing the new data layout
3055 - newVec - The new data
3056 
3057   Level: developer
3058 
3059 .seealso: DMPlexDistribute(), DMPlexDistributeData()
3060 @*/
3061 PetscErrorCode DMPlexDistributeField(DM dm, PetscSF pointSF, PetscSection originalSection, Vec originalVec, PetscSection newSection, Vec newVec)
3062 {
3063   PetscSF        fieldSF;
3064   PetscInt      *remoteOffsets, fieldSize;
3065   PetscScalar   *originalValues, *newValues;
3066   PetscErrorCode ierr;
3067 
3068   PetscFunctionBegin;
3069   ierr = PetscLogEventBegin(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
3070   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
3071 
3072   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
3073   ierr = VecSetSizes(newVec, fieldSize, PETSC_DETERMINE);CHKERRQ(ierr);
3074   ierr = VecSetType(newVec,dm->vectype);CHKERRQ(ierr);
3075 
3076   ierr = VecGetArray(originalVec, &originalValues);CHKERRQ(ierr);
3077   ierr = VecGetArray(newVec, &newValues);CHKERRQ(ierr);
3078   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
3079   ierr = PetscSFBcastBegin(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3080   ierr = PetscSFBcastEnd(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3081   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
3082   ierr = VecRestoreArray(newVec, &newValues);CHKERRQ(ierr);
3083   ierr = VecRestoreArray(originalVec, &originalValues);CHKERRQ(ierr);
3084   ierr = PetscLogEventEnd(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
3085   PetscFunctionReturn(0);
3086 }
3087 
3088 #undef __FUNCT__
3089 #define __FUNCT__ "DMPlexDistributeData"
3090 /*@
3091   DMPlexDistributeData - Distribute field data to match a given PetscSF, usually the SF from mesh distribution
3092 
3093   Collective on DM
3094 
3095   Input Parameters:
3096 + dm - The DMPlex object
3097 . pointSF - The PetscSF describing the communication pattern
3098 . originalSection - The PetscSection for existing data layout
3099 . datatype - The type of data
3100 - originalData - The existing data
3101 
3102   Output Parameters:
3103 + newSection - The PetscSF describing the new data layout
3104 - newData - The new data
3105 
3106   Level: developer
3107 
3108 .seealso: DMPlexDistribute(), DMPlexDistributeField()
3109 @*/
3110 PetscErrorCode DMPlexDistributeData(DM dm, PetscSF pointSF, PetscSection originalSection, MPI_Datatype datatype, void *originalData, PetscSection newSection, void **newData)
3111 {
3112   PetscSF        fieldSF;
3113   PetscInt      *remoteOffsets, fieldSize;
3114   PetscMPIInt    dataSize;
3115   PetscErrorCode ierr;
3116 
3117   PetscFunctionBegin;
3118   ierr = PetscLogEventBegin(DMPLEX_DistributeData,dm,0,0,0);CHKERRQ(ierr);
3119   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
3120 
3121   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
3122   ierr = MPI_Type_size(datatype, &dataSize);CHKERRQ(ierr);
3123   ierr = PetscMalloc(fieldSize * dataSize, newData);CHKERRQ(ierr);
3124 
3125   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
3126   ierr = PetscSFBcastBegin(fieldSF, datatype, originalData, *newData);CHKERRQ(ierr);
3127   ierr = PetscSFBcastEnd(fieldSF, datatype, originalData, *newData);CHKERRQ(ierr);
3128   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
3129   ierr = PetscLogEventEnd(DMPLEX_DistributeData,dm,0,0,0);CHKERRQ(ierr);
3130   PetscFunctionReturn(0);
3131 }
3132 
3133 #undef __FUNCT__
3134 #define __FUNCT__ "DMPlexDistribute"
3135 /*@C
3136   DMPlexDistribute - Distributes the mesh and any associated sections.
3137 
3138   Not Collective
3139 
3140   Input Parameter:
3141 + dm  - The original DMPlex object
3142 . partitioner - The partitioning package, or NULL for the default
3143 - overlap - The overlap of partitions, 0 is the default
3144 
3145   Output Parameter:
3146 + sf - The PetscSF used for point distribution
3147 - parallelMesh - The distributed DMPlex object, or NULL
3148 
3149   Note: If the mesh was not distributed, the return value is NULL
3150 
3151   Level: intermediate
3152 
3153 .keywords: mesh, elements
3154 .seealso: DMPlexCreate(), DMPlexDistributeByFace()
3155 @*/
3156 PetscErrorCode DMPlexDistribute(DM dm, const char partitioner[], PetscInt overlap, PetscSF *sf, DM *dmParallel)
3157 {
3158   DM_Plex               *mesh   = (DM_Plex*) dm->data, *pmesh;
3159   MPI_Comm               comm;
3160   const PetscInt         height = 0;
3161   PetscInt               dim, numRemoteRanks;
3162   IS                     origCellPart,        origPart,        cellPart,        part;
3163   PetscSection           origCellPartSection, origPartSection, cellPartSection, partSection;
3164   PetscSFNode           *remoteRanks;
3165   PetscSF                partSF, pointSF, coneSF;
3166   ISLocalToGlobalMapping renumbering;
3167   PetscSection           originalConeSection, newConeSection;
3168   PetscInt              *remoteOffsets;
3169   PetscInt              *cones, *newCones, newConesSize;
3170   PetscBool              flg;
3171   PetscMPIInt            rank, numProcs, p;
3172   PetscErrorCode         ierr;
3173 
3174   PetscFunctionBegin;
3175   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3176   if (sf) PetscValidPointer(sf,4);
3177   PetscValidPointer(dmParallel,5);
3178 
3179   ierr = PetscLogEventBegin(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3180   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3181   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3182   ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
3183 
3184   *dmParallel = NULL;
3185   if (numProcs == 1) PetscFunctionReturn(0);
3186 
3187   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
3188   /* Create cell partition - We need to rewrite to use IS, use the MatPartition stuff */
3189   ierr = PetscLogEventBegin(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
3190   if (overlap > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Overlap > 1 not yet implemented");
3191   ierr = DMPlexCreatePartition(dm, partitioner, height, overlap > 0 ? PETSC_TRUE : PETSC_FALSE, &cellPartSection, &cellPart, &origCellPartSection, &origCellPart);CHKERRQ(ierr);
3192   /* Create SF assuming a serial partition for all processes: Could check for IS length here */
3193   if (!rank) numRemoteRanks = numProcs;
3194   else       numRemoteRanks = 0;
3195   ierr = PetscMalloc1(numRemoteRanks, &remoteRanks);CHKERRQ(ierr);
3196   for (p = 0; p < numRemoteRanks; ++p) {
3197     remoteRanks[p].rank  = p;
3198     remoteRanks[p].index = 0;
3199   }
3200   ierr = PetscSFCreate(comm, &partSF);CHKERRQ(ierr);
3201   ierr = PetscSFSetGraph(partSF, 1, numRemoteRanks, NULL, PETSC_OWN_POINTER, remoteRanks, PETSC_OWN_POINTER);CHKERRQ(ierr);
3202   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-partition_view", &flg);CHKERRQ(ierr);
3203   if (flg) {
3204     ierr = PetscPrintf(comm, "Cell Partition:\n");CHKERRQ(ierr);
3205     ierr = PetscSectionView(cellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3206     ierr = ISView(cellPart, NULL);CHKERRQ(ierr);
3207     if (origCellPart) {
3208       ierr = PetscPrintf(comm, "Original Cell Partition:\n");CHKERRQ(ierr);
3209       ierr = PetscSectionView(origCellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3210       ierr = ISView(origCellPart, NULL);CHKERRQ(ierr);
3211     }
3212     ierr = PetscSFView(partSF, NULL);CHKERRQ(ierr);
3213   }
3214   /* Close the partition over the mesh */
3215   ierr = DMPlexCreatePartitionClosure(dm, cellPartSection, cellPart, &partSection, &part);CHKERRQ(ierr);
3216   ierr = ISDestroy(&cellPart);CHKERRQ(ierr);
3217   ierr = PetscSectionDestroy(&cellPartSection);CHKERRQ(ierr);
3218   /* Create new mesh */
3219   ierr  = DMPlexCreate(comm, dmParallel);CHKERRQ(ierr);
3220   ierr  = DMPlexSetDimension(*dmParallel, dim);CHKERRQ(ierr);
3221   ierr  = PetscObjectSetName((PetscObject) *dmParallel, "Parallel Mesh");CHKERRQ(ierr);
3222   pmesh = (DM_Plex*) (*dmParallel)->data;
3223   /* Distribute sieve points and the global point numbering (replaces creating remote bases) */
3224   ierr = PetscSFConvertPartition(partSF, partSection, part, &renumbering, &pointSF);CHKERRQ(ierr);
3225   if (flg) {
3226     ierr = PetscPrintf(comm, "Point Partition:\n");CHKERRQ(ierr);
3227     ierr = PetscSectionView(partSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3228     ierr = ISView(part, NULL);CHKERRQ(ierr);
3229     ierr = PetscSFView(pointSF, NULL);CHKERRQ(ierr);
3230     ierr = PetscPrintf(comm, "Point Renumbering after partition:\n");CHKERRQ(ierr);
3231     ierr = ISLocalToGlobalMappingView(renumbering, NULL);CHKERRQ(ierr);
3232   }
3233   ierr = PetscLogEventEnd(DMPLEX_Partition,dm,0,0,0);CHKERRQ(ierr);
3234   ierr = PetscLogEventBegin(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr);
3235   /* Distribute cone section */
3236   ierr = DMPlexGetConeSection(dm, &originalConeSection);CHKERRQ(ierr);
3237   ierr = DMPlexGetConeSection(*dmParallel, &newConeSection);CHKERRQ(ierr);
3238   ierr = PetscSFDistributeSection(pointSF, originalConeSection, &remoteOffsets, newConeSection);CHKERRQ(ierr);
3239   ierr = DMSetUp(*dmParallel);CHKERRQ(ierr);
3240   {
3241     PetscInt pStart, pEnd, p;
3242 
3243     ierr = PetscSectionGetChart(newConeSection, &pStart, &pEnd);CHKERRQ(ierr);
3244     for (p = pStart; p < pEnd; ++p) {
3245       PetscInt coneSize;
3246       ierr               = PetscSectionGetDof(newConeSection, p, &coneSize);CHKERRQ(ierr);
3247       pmesh->maxConeSize = PetscMax(pmesh->maxConeSize, coneSize);
3248     }
3249   }
3250   /* Communicate and renumber cones */
3251   ierr = PetscSFCreateSectionSF(pointSF, originalConeSection, remoteOffsets, newConeSection, &coneSF);CHKERRQ(ierr);
3252   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
3253   ierr = DMPlexGetCones(*dmParallel, &newCones);CHKERRQ(ierr);
3254   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3255   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3256   ierr = PetscSectionGetStorageSize(newConeSection, &newConesSize);CHKERRQ(ierr);
3257   ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newConesSize, newCones, NULL, newCones);CHKERRQ(ierr);
3258   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-cones_view", &flg);CHKERRQ(ierr);
3259   if (flg) {
3260     ierr = PetscPrintf(comm, "Serial Cone Section:\n");CHKERRQ(ierr);
3261     ierr = PetscSectionView(originalConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3262     ierr = PetscPrintf(comm, "Parallel Cone Section:\n");CHKERRQ(ierr);
3263     ierr = PetscSectionView(newConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3264     ierr = PetscSFView(coneSF, NULL);CHKERRQ(ierr);
3265   }
3266   ierr = DMPlexGetConeOrientations(dm, &cones);CHKERRQ(ierr);
3267   ierr = DMPlexGetConeOrientations(*dmParallel, &newCones);CHKERRQ(ierr);
3268   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3269   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3270   ierr = PetscSFDestroy(&coneSF);CHKERRQ(ierr);
3271   ierr = PetscLogEventEnd(DMPLEX_DistributeCones,dm,0,0,0);CHKERRQ(ierr);
3272   /* Create supports and stratify sieve */
3273   {
3274     PetscInt pStart, pEnd;
3275 
3276     ierr = PetscSectionGetChart(pmesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
3277     ierr = PetscSectionSetChart(pmesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
3278   }
3279   ierr = DMPlexSymmetrize(*dmParallel);CHKERRQ(ierr);
3280   ierr = DMPlexStratify(*dmParallel);CHKERRQ(ierr);
3281   /* Distribute Coordinates */
3282   {
3283     PetscSection originalCoordSection, newCoordSection;
3284     Vec          originalCoordinates, newCoordinates;
3285     const char  *name;
3286 
3287     ierr = DMGetCoordinateSection(dm, &originalCoordSection);CHKERRQ(ierr);
3288     ierr = DMGetCoordinateSection(*dmParallel, &newCoordSection);CHKERRQ(ierr);
3289     ierr = DMGetCoordinatesLocal(dm, &originalCoordinates);CHKERRQ(ierr);
3290     ierr = VecCreate(comm, &newCoordinates);CHKERRQ(ierr);
3291     ierr = PetscObjectGetName((PetscObject) originalCoordinates, &name);CHKERRQ(ierr);
3292     ierr = PetscObjectSetName((PetscObject) newCoordinates, name);CHKERRQ(ierr);
3293 
3294     ierr = DMPlexDistributeField(dm, pointSF, originalCoordSection, originalCoordinates, newCoordSection, newCoordinates);CHKERRQ(ierr);
3295     ierr = DMSetCoordinatesLocal(*dmParallel, newCoordinates);CHKERRQ(ierr);
3296     ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr);
3297   }
3298   /* Distribute labels */
3299   ierr = PetscLogEventBegin(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
3300   {
3301     DMLabel  next      = mesh->labels, newNext = pmesh->labels;
3302     PetscInt numLabels = 0, l;
3303 
3304     /* Bcast number of labels */
3305     while (next) {++numLabels; next = next->next;}
3306     ierr = MPI_Bcast(&numLabels, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3307     next = mesh->labels;
3308     for (l = 0; l < numLabels; ++l) {
3309       DMLabel   labelNew;
3310       PetscBool isdepth;
3311 
3312       /* Skip "depth" because it is recreated */
3313       if (!rank) {ierr = PetscStrcmp(next->name, "depth", &isdepth);CHKERRQ(ierr);}
3314       ierr = MPI_Bcast(&isdepth, 1, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
3315       if (isdepth) {if (!rank) next = next->next; continue;}
3316       ierr = DMLabelDistribute(next, partSection, part, renumbering, &labelNew);CHKERRQ(ierr);
3317       /* Insert into list */
3318       if (newNext) newNext->next = labelNew;
3319       else         pmesh->labels = labelNew;
3320       newNext = labelNew;
3321       if (!rank) next = next->next;
3322     }
3323   }
3324   ierr = PetscLogEventEnd(DMPLEX_DistributeLabels,dm,0,0,0);CHKERRQ(ierr);
3325   /* Setup hybrid structure */
3326   {
3327     const PetscInt *gpoints;
3328     PetscInt        depth, n, d;
3329 
3330     for (d = 0; d <= dim; ++d) {pmesh->hybridPointMax[d] = mesh->hybridPointMax[d];}
3331     ierr = MPI_Bcast(pmesh->hybridPointMax, dim+1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3332     ierr = ISLocalToGlobalMappingGetSize(renumbering, &n);CHKERRQ(ierr);
3333     ierr = ISLocalToGlobalMappingGetIndices(renumbering, &gpoints);CHKERRQ(ierr);
3334     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3335     for (d = 0; d <= dim; ++d) {
3336       PetscInt pmax = pmesh->hybridPointMax[d], newmax = 0, pEnd, stratum[2], p;
3337 
3338       if (pmax < 0) continue;
3339       ierr = DMPlexGetDepthStratum(dm, d > depth ? depth : d, &stratum[0], &stratum[1]);CHKERRQ(ierr);
3340       ierr = DMPlexGetDepthStratum(*dmParallel, d, NULL, &pEnd);CHKERRQ(ierr);
3341       ierr = MPI_Bcast(stratum, 2, MPIU_INT, 0, comm);CHKERRQ(ierr);
3342       for (p = 0; p < n; ++p) {
3343         const PetscInt point = gpoints[p];
3344 
3345         if ((point >= stratum[0]) && (point < stratum[1]) && (point >= pmax)) ++newmax;
3346       }
3347       if (newmax > 0) pmesh->hybridPointMax[d] = pEnd - newmax;
3348       else            pmesh->hybridPointMax[d] = -1;
3349     }
3350     ierr = ISLocalToGlobalMappingRestoreIndices(renumbering, &gpoints);CHKERRQ(ierr);
3351   }
3352   /* Cleanup Partition */
3353   ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr);
3354   ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr);
3355   ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr);
3356   ierr = ISDestroy(&part);CHKERRQ(ierr);
3357   /* Create point SF for parallel mesh */
3358   ierr = PetscLogEventBegin(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3359   {
3360     const PetscInt *leaves;
3361     PetscSFNode    *remotePoints, *rowners, *lowners;
3362     PetscInt        numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints;
3363     PetscInt        pStart, pEnd;
3364 
3365     ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr);
3366     ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr);
3367     ierr = PetscMalloc2(numRoots,&rowners,numLeaves,&lowners);CHKERRQ(ierr);
3368     for (p=0; p<numRoots; p++) {
3369       rowners[p].rank  = -1;
3370       rowners[p].index = -1;
3371     }
3372     if (origCellPart) {
3373       /* Make sure points in the original partition are not assigned to other procs */
3374       const PetscInt *origPoints;
3375 
3376       ierr = DMPlexCreatePartitionClosure(dm, origCellPartSection, origCellPart, &origPartSection, &origPart);CHKERRQ(ierr);
3377       ierr = ISGetIndices(origPart, &origPoints);CHKERRQ(ierr);
3378       for (p = 0; p < numProcs; ++p) {
3379         PetscInt dof, off, d;
3380 
3381         ierr = PetscSectionGetDof(origPartSection, p, &dof);CHKERRQ(ierr);
3382         ierr = PetscSectionGetOffset(origPartSection, p, &off);CHKERRQ(ierr);
3383         for (d = off; d < off+dof; ++d) {
3384           rowners[origPoints[d]].rank = p;
3385         }
3386       }
3387       ierr = ISRestoreIndices(origPart, &origPoints);CHKERRQ(ierr);
3388       ierr = ISDestroy(&origPart);CHKERRQ(ierr);
3389       ierr = PetscSectionDestroy(&origPartSection);CHKERRQ(ierr);
3390     }
3391     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3392     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3393 
3394     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3395     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3396     for (p = 0; p < numLeaves; ++p) {
3397       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3398         lowners[p].rank  = rank;
3399         lowners[p].index = leaves ? leaves[p] : p;
3400       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3401         lowners[p].rank  = -2;
3402         lowners[p].index = -2;
3403       }
3404     }
3405     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3406       rowners[p].rank  = -3;
3407       rowners[p].index = -3;
3408     }
3409     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3410     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3411     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3412     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3413     for (p = 0; p < numLeaves; ++p) {
3414       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3415       if (lowners[p].rank != rank) ++numGhostPoints;
3416     }
3417     ierr = PetscMalloc1(numGhostPoints,    &ghostPoints);CHKERRQ(ierr);
3418     ierr = PetscMalloc1(numGhostPoints, &remotePoints);CHKERRQ(ierr);
3419     for (p = 0, gp = 0; p < numLeaves; ++p) {
3420       if (lowners[p].rank != rank) {
3421         ghostPoints[gp]        = leaves ? leaves[p] : p;
3422         remotePoints[gp].rank  = lowners[p].rank;
3423         remotePoints[gp].index = lowners[p].index;
3424         ++gp;
3425       }
3426     }
3427     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3428     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3429     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3430   }
3431   ierr = PetscLogEventEnd(DMPLEX_DistributeSF,dm,0,0,0);CHKERRQ(ierr);
3432   /* Cleanup */
3433   if (sf) {*sf = pointSF;}
3434   else    {ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);}
3435   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3436   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3437   PetscFunctionReturn(0);
3438 }
3439 
3440 #undef __FUNCT__
3441 #define __FUNCT__ "DMPlexInvertCell"
3442 /*@C
3443   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3444 
3445   Input Parameters:
3446 + numCorners - The number of vertices in a cell
3447 - cone - The incoming cone
3448 
3449   Output Parameter:
3450 . cone - The inverted cone (in-place)
3451 
3452   Level: developer
3453 
3454 .seealso: DMPlexGenerate()
3455 @*/
3456 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3457 {
3458   int tmpc;
3459 
3460   PetscFunctionBegin;
3461   if (dim != 3) PetscFunctionReturn(0);
3462   switch (numCorners) {
3463   case 4:
3464     tmpc    = cone[0];
3465     cone[0] = cone[1];
3466     cone[1] = tmpc;
3467     break;
3468   case 8:
3469     tmpc    = cone[1];
3470     cone[1] = cone[3];
3471     cone[3] = tmpc;
3472     break;
3473   default: break;
3474   }
3475   PetscFunctionReturn(0);
3476 }
3477 
3478 #undef __FUNCT__
3479 #define __FUNCT__ "DMPlexInvertCells_Internal"
3480 /* This is to fix the tetrahedron orientation from TetGen */
3481 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3482 {
3483   PetscInt       bound = numCells*numCorners, coff;
3484   PetscErrorCode ierr;
3485 
3486   PetscFunctionBegin;
3487   for (coff = 0; coff < bound; coff += numCorners) {
3488     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3489   }
3490   PetscFunctionReturn(0);
3491 }
3492 
3493 #if defined(PETSC_HAVE_TRIANGLE)
3494 #include <triangle.h>
3495 
3496 #undef __FUNCT__
3497 #define __FUNCT__ "InitInput_Triangle"
3498 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3499 {
3500   PetscFunctionBegin;
3501   inputCtx->numberofpoints             = 0;
3502   inputCtx->numberofpointattributes    = 0;
3503   inputCtx->pointlist                  = NULL;
3504   inputCtx->pointattributelist         = NULL;
3505   inputCtx->pointmarkerlist            = NULL;
3506   inputCtx->numberofsegments           = 0;
3507   inputCtx->segmentlist                = NULL;
3508   inputCtx->segmentmarkerlist          = NULL;
3509   inputCtx->numberoftriangleattributes = 0;
3510   inputCtx->trianglelist               = NULL;
3511   inputCtx->numberofholes              = 0;
3512   inputCtx->holelist                   = NULL;
3513   inputCtx->numberofregions            = 0;
3514   inputCtx->regionlist                 = NULL;
3515   PetscFunctionReturn(0);
3516 }
3517 
3518 #undef __FUNCT__
3519 #define __FUNCT__ "InitOutput_Triangle"
3520 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3521 {
3522   PetscFunctionBegin;
3523   outputCtx->numberofpoints        = 0;
3524   outputCtx->pointlist             = NULL;
3525   outputCtx->pointattributelist    = NULL;
3526   outputCtx->pointmarkerlist       = NULL;
3527   outputCtx->numberoftriangles     = 0;
3528   outputCtx->trianglelist          = NULL;
3529   outputCtx->triangleattributelist = NULL;
3530   outputCtx->neighborlist          = NULL;
3531   outputCtx->segmentlist           = NULL;
3532   outputCtx->segmentmarkerlist     = NULL;
3533   outputCtx->numberofedges         = 0;
3534   outputCtx->edgelist              = NULL;
3535   outputCtx->edgemarkerlist        = NULL;
3536   PetscFunctionReturn(0);
3537 }
3538 
3539 #undef __FUNCT__
3540 #define __FUNCT__ "FiniOutput_Triangle"
3541 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3542 {
3543   PetscFunctionBegin;
3544   free(outputCtx->pointmarkerlist);
3545   free(outputCtx->edgelist);
3546   free(outputCtx->edgemarkerlist);
3547   free(outputCtx->trianglelist);
3548   free(outputCtx->neighborlist);
3549   PetscFunctionReturn(0);
3550 }
3551 
3552 #undef __FUNCT__
3553 #define __FUNCT__ "DMPlexGenerate_Triangle"
3554 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3555 {
3556   MPI_Comm             comm;
3557   PetscInt             dim              = 2;
3558   const PetscBool      createConvexHull = PETSC_FALSE;
3559   const PetscBool      constrained      = PETSC_FALSE;
3560   struct triangulateio in;
3561   struct triangulateio out;
3562   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3563   PetscMPIInt          rank;
3564   PetscErrorCode       ierr;
3565 
3566   PetscFunctionBegin;
3567   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3568   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3569   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3570   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3571   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3572 
3573   in.numberofpoints = vEnd - vStart;
3574   if (in.numberofpoints > 0) {
3575     PetscSection coordSection;
3576     Vec          coordinates;
3577     PetscScalar *array;
3578 
3579     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3580     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3581     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3582     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3583     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3584     for (v = vStart; v < vEnd; ++v) {
3585       const PetscInt idx = v - vStart;
3586       PetscInt       off, d;
3587 
3588       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3589       for (d = 0; d < dim; ++d) {
3590         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3591       }
3592       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3593     }
3594     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3595   }
3596   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3597   in.numberofsegments = eEnd - eStart;
3598   if (in.numberofsegments > 0) {
3599     ierr = PetscMalloc1(in.numberofsegments*2, &in.segmentlist);CHKERRQ(ierr);
3600     ierr = PetscMalloc1(in.numberofsegments, &in.segmentmarkerlist);CHKERRQ(ierr);
3601     for (e = eStart; e < eEnd; ++e) {
3602       const PetscInt  idx = e - eStart;
3603       const PetscInt *cone;
3604 
3605       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3606 
3607       in.segmentlist[idx*2+0] = cone[0] - vStart;
3608       in.segmentlist[idx*2+1] = cone[1] - vStart;
3609 
3610       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3611     }
3612   }
3613 #if 0 /* Do not currently support holes */
3614   PetscReal *holeCoords;
3615   PetscInt   h, d;
3616 
3617   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3618   if (in.numberofholes > 0) {
3619     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3620     for (h = 0; h < in.numberofholes; ++h) {
3621       for (d = 0; d < dim; ++d) {
3622         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3623       }
3624     }
3625   }
3626 #endif
3627   if (!rank) {
3628     char args[32];
3629 
3630     /* Take away 'Q' for verbose output */
3631     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3632     if (createConvexHull) {
3633       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3634     }
3635     if (constrained) {
3636       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3637     }
3638     triangulate(args, &in, &out, NULL);
3639   }
3640   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3641   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3642   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3643   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3644   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3645 
3646   {
3647     const PetscInt numCorners  = 3;
3648     const PetscInt numCells    = out.numberoftriangles;
3649     const PetscInt numVertices = out.numberofpoints;
3650     const int     *cells      = out.trianglelist;
3651     const double  *meshCoords = out.pointlist;
3652 
3653     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3654     /* Set labels */
3655     for (v = 0; v < numVertices; ++v) {
3656       if (out.pointmarkerlist[v]) {
3657         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3658       }
3659     }
3660     if (interpolate) {
3661       for (e = 0; e < out.numberofedges; e++) {
3662         if (out.edgemarkerlist[e]) {
3663           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3664           const PetscInt *edges;
3665           PetscInt        numEdges;
3666 
3667           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3668           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3669           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3670           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3671         }
3672       }
3673     }
3674     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3675   }
3676 #if 0 /* Do not currently support holes */
3677   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3678 #endif
3679   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3680   PetscFunctionReturn(0);
3681 }
3682 
3683 #undef __FUNCT__
3684 #define __FUNCT__ "DMPlexRefine_Triangle"
3685 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3686 {
3687   MPI_Comm             comm;
3688   PetscInt             dim  = 2;
3689   struct triangulateio in;
3690   struct triangulateio out;
3691   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3692   PetscMPIInt          rank;
3693   PetscErrorCode       ierr;
3694 
3695   PetscFunctionBegin;
3696   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3697   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3698   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3699   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3700   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3701   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3702   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3703 
3704   in.numberofpoints = vEnd - vStart;
3705   if (in.numberofpoints > 0) {
3706     PetscSection coordSection;
3707     Vec          coordinates;
3708     PetscScalar *array;
3709 
3710     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3711     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3712     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3713     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3714     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3715     for (v = vStart; v < vEnd; ++v) {
3716       const PetscInt idx = v - vStart;
3717       PetscInt       off, d;
3718 
3719       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3720       for (d = 0; d < dim; ++d) {
3721         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3722       }
3723       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3724     }
3725     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3726   }
3727   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3728 
3729   in.numberofcorners   = 3;
3730   in.numberoftriangles = cEnd - cStart;
3731 
3732   in.trianglearealist  = (double*) maxVolumes;
3733   if (in.numberoftriangles > 0) {
3734     ierr = PetscMalloc1(in.numberoftriangles*in.numberofcorners, &in.trianglelist);CHKERRQ(ierr);
3735     for (c = cStart; c < cEnd; ++c) {
3736       const PetscInt idx      = c - cStart;
3737       PetscInt      *closure = NULL;
3738       PetscInt       closureSize;
3739 
3740       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3741       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3742       for (v = 0; v < 3; ++v) {
3743         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3744       }
3745       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3746     }
3747   }
3748   /* TODO: Segment markers are missing on input */
3749 #if 0 /* Do not currently support holes */
3750   PetscReal *holeCoords;
3751   PetscInt   h, d;
3752 
3753   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3754   if (in.numberofholes > 0) {
3755     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3756     for (h = 0; h < in.numberofholes; ++h) {
3757       for (d = 0; d < dim; ++d) {
3758         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3759       }
3760     }
3761   }
3762 #endif
3763   if (!rank) {
3764     char args[32];
3765 
3766     /* Take away 'Q' for verbose output */
3767     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3768     triangulate(args, &in, &out, NULL);
3769   }
3770   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3771   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3772   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3773   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3774   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3775 
3776   {
3777     const PetscInt numCorners  = 3;
3778     const PetscInt numCells    = out.numberoftriangles;
3779     const PetscInt numVertices = out.numberofpoints;
3780     const int     *cells      = out.trianglelist;
3781     const double  *meshCoords = out.pointlist;
3782     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3783 
3784     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3785     /* Set labels */
3786     for (v = 0; v < numVertices; ++v) {
3787       if (out.pointmarkerlist[v]) {
3788         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3789       }
3790     }
3791     if (interpolate) {
3792       PetscInt e;
3793 
3794       for (e = 0; e < out.numberofedges; e++) {
3795         if (out.edgemarkerlist[e]) {
3796           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3797           const PetscInt *edges;
3798           PetscInt        numEdges;
3799 
3800           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3801           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3802           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3803           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3804         }
3805       }
3806     }
3807     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3808   }
3809 #if 0 /* Do not currently support holes */
3810   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3811 #endif
3812   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3813   PetscFunctionReturn(0);
3814 }
3815 #endif
3816 
3817 #if defined(PETSC_HAVE_TETGEN)
3818 #include <tetgen.h>
3819 #undef __FUNCT__
3820 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3821 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3822 {
3823   MPI_Comm       comm;
3824   const PetscInt dim  = 3;
3825   ::tetgenio     in;
3826   ::tetgenio     out;
3827   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3828   PetscMPIInt    rank;
3829   PetscErrorCode ierr;
3830 
3831   PetscFunctionBegin;
3832   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3833   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3834   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3835   in.numberofpoints = vEnd - vStart;
3836   if (in.numberofpoints > 0) {
3837     PetscSection coordSection;
3838     Vec          coordinates;
3839     PetscScalar *array;
3840 
3841     in.pointlist       = new double[in.numberofpoints*dim];
3842     in.pointmarkerlist = new int[in.numberofpoints];
3843 
3844     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3845     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3846     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3847     for (v = vStart; v < vEnd; ++v) {
3848       const PetscInt idx = v - vStart;
3849       PetscInt       off, d;
3850 
3851       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3852       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3853       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3854     }
3855     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3856   }
3857   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3858 
3859   in.numberoffacets = fEnd - fStart;
3860   if (in.numberoffacets > 0) {
3861     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3862     in.facetmarkerlist = new int[in.numberoffacets];
3863     for (f = fStart; f < fEnd; ++f) {
3864       const PetscInt idx     = f - fStart;
3865       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3866 
3867       in.facetlist[idx].numberofpolygons = 1;
3868       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3869       in.facetlist[idx].numberofholes    = 0;
3870       in.facetlist[idx].holelist         = NULL;
3871 
3872       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3873       for (p = 0; p < numPoints*2; p += 2) {
3874         const PetscInt point = points[p];
3875         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3876       }
3877 
3878       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3879       poly->numberofvertices = numVertices;
3880       poly->vertexlist       = new int[poly->numberofvertices];
3881       for (v = 0; v < numVertices; ++v) {
3882         const PetscInt vIdx = points[v] - vStart;
3883         poly->vertexlist[v] = vIdx;
3884       }
3885       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3886       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3887     }
3888   }
3889   if (!rank) {
3890     char args[32];
3891 
3892     /* Take away 'Q' for verbose output */
3893     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3894     ::tetrahedralize(args, &in, &out);
3895   }
3896   {
3897     const PetscInt numCorners  = 4;
3898     const PetscInt numCells    = out.numberoftetrahedra;
3899     const PetscInt numVertices = out.numberofpoints;
3900     const double   *meshCoords = out.pointlist;
3901     int            *cells      = out.tetrahedronlist;
3902 
3903     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3904     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3905     /* Set labels */
3906     for (v = 0; v < numVertices; ++v) {
3907       if (out.pointmarkerlist[v]) {
3908         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3909       }
3910     }
3911     if (interpolate) {
3912       PetscInt e;
3913 
3914       for (e = 0; e < out.numberofedges; e++) {
3915         if (out.edgemarkerlist[e]) {
3916           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3917           const PetscInt *edges;
3918           PetscInt        numEdges;
3919 
3920           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3921           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3922           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3923           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3924         }
3925       }
3926       for (f = 0; f < out.numberoftrifaces; f++) {
3927         if (out.trifacemarkerlist[f]) {
3928           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3929           const PetscInt *faces;
3930           PetscInt        numFaces;
3931 
3932           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3933           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3934           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3935           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3936         }
3937       }
3938     }
3939     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3940   }
3941   PetscFunctionReturn(0);
3942 }
3943 
3944 #undef __FUNCT__
3945 #define __FUNCT__ "DMPlexRefine_Tetgen"
3946 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3947 {
3948   MPI_Comm       comm;
3949   const PetscInt dim  = 3;
3950   ::tetgenio     in;
3951   ::tetgenio     out;
3952   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3953   PetscMPIInt    rank;
3954   PetscErrorCode ierr;
3955 
3956   PetscFunctionBegin;
3957   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3958   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3959   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3960   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3961   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3962 
3963   in.numberofpoints = vEnd - vStart;
3964   if (in.numberofpoints > 0) {
3965     PetscSection coordSection;
3966     Vec          coordinates;
3967     PetscScalar *array;
3968 
3969     in.pointlist       = new double[in.numberofpoints*dim];
3970     in.pointmarkerlist = new int[in.numberofpoints];
3971 
3972     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3973     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3974     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3975     for (v = vStart; v < vEnd; ++v) {
3976       const PetscInt idx = v - vStart;
3977       PetscInt       off, d;
3978 
3979       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3980       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3981       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3982     }
3983     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3984   }
3985   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3986 
3987   in.numberofcorners       = 4;
3988   in.numberoftetrahedra    = cEnd - cStart;
3989   in.tetrahedronvolumelist = (double*) maxVolumes;
3990   if (in.numberoftetrahedra > 0) {
3991     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3992     for (c = cStart; c < cEnd; ++c) {
3993       const PetscInt idx      = c - cStart;
3994       PetscInt      *closure = NULL;
3995       PetscInt       closureSize;
3996 
3997       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3998       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3999       for (v = 0; v < 4; ++v) {
4000         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4001       }
4002       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4003     }
4004   }
4005   /* TODO: Put in boundary faces with markers */
4006   if (!rank) {
4007     char args[32];
4008 
4009     /* Take away 'Q' for verbose output */
4010     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
4011     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
4012     ::tetrahedralize(args, &in, &out);
4013   }
4014   in.tetrahedronvolumelist = NULL;
4015 
4016   {
4017     const PetscInt numCorners  = 4;
4018     const PetscInt numCells    = out.numberoftetrahedra;
4019     const PetscInt numVertices = out.numberofpoints;
4020     const double   *meshCoords = out.pointlist;
4021     int            *cells      = out.tetrahedronlist;
4022 
4023     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4024 
4025     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4026     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4027     /* Set labels */
4028     for (v = 0; v < numVertices; ++v) {
4029       if (out.pointmarkerlist[v]) {
4030         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
4031       }
4032     }
4033     if (interpolate) {
4034       PetscInt e, f;
4035 
4036       for (e = 0; e < out.numberofedges; e++) {
4037         if (out.edgemarkerlist[e]) {
4038           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
4039           const PetscInt *edges;
4040           PetscInt        numEdges;
4041 
4042           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4043           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4044           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
4045           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4046         }
4047       }
4048       for (f = 0; f < out.numberoftrifaces; f++) {
4049         if (out.trifacemarkerlist[f]) {
4050           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
4051           const PetscInt *faces;
4052           PetscInt        numFaces;
4053 
4054           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4055           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4056           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
4057           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4058         }
4059       }
4060     }
4061     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4062   }
4063   PetscFunctionReturn(0);
4064 }
4065 #endif
4066 
4067 #if defined(PETSC_HAVE_CTETGEN)
4068 #include "ctetgen.h"
4069 
4070 #undef __FUNCT__
4071 #define __FUNCT__ "DMPlexGenerate_CTetgen"
4072 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
4073 {
4074   MPI_Comm       comm;
4075   const PetscInt dim  = 3;
4076   PLC           *in, *out;
4077   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
4078   PetscMPIInt    rank;
4079   PetscErrorCode ierr;
4080 
4081   PetscFunctionBegin;
4082   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
4083   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4084   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4085   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
4086   ierr = PLCCreate(&in);CHKERRQ(ierr);
4087   ierr = PLCCreate(&out);CHKERRQ(ierr);
4088 
4089   in->numberofpoints = vEnd - vStart;
4090   if (in->numberofpoints > 0) {
4091     PetscSection coordSection;
4092     Vec          coordinates;
4093     PetscScalar *array;
4094 
4095     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4096     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4097     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
4098     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
4099     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4100     for (v = vStart; v < vEnd; ++v) {
4101       const PetscInt idx = v - vStart;
4102       PetscInt       off, d, m;
4103 
4104       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4105       for (d = 0; d < dim; ++d) {
4106         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4107       }
4108       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
4109 
4110       in->pointmarkerlist[idx] = (int) m;
4111     }
4112     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4113   }
4114   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
4115 
4116   in->numberoffacets = fEnd - fStart;
4117   if (in->numberoffacets > 0) {
4118     ierr = PetscMalloc1(in->numberoffacets, &in->facetlist);CHKERRQ(ierr);
4119     ierr = PetscMalloc1(in->numberoffacets,   &in->facetmarkerlist);CHKERRQ(ierr);
4120     for (f = fStart; f < fEnd; ++f) {
4121       const PetscInt idx     = f - fStart;
4122       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
4123       polygon       *poly;
4124 
4125       in->facetlist[idx].numberofpolygons = 1;
4126 
4127       ierr = PetscMalloc1(in->facetlist[idx].numberofpolygons, &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
4128 
4129       in->facetlist[idx].numberofholes    = 0;
4130       in->facetlist[idx].holelist         = NULL;
4131 
4132       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4133       for (p = 0; p < numPoints*2; p += 2) {
4134         const PetscInt point = points[p];
4135         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
4136       }
4137 
4138       poly                   = in->facetlist[idx].polygonlist;
4139       poly->numberofvertices = numVertices;
4140       ierr                   = PetscMalloc1(poly->numberofvertices, &poly->vertexlist);CHKERRQ(ierr);
4141       for (v = 0; v < numVertices; ++v) {
4142         const PetscInt vIdx = points[v] - vStart;
4143         poly->vertexlist[v] = vIdx;
4144       }
4145       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
4146       in->facetmarkerlist[idx] = (int) m;
4147       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4148     }
4149   }
4150   if (!rank) {
4151     TetGenOpts t;
4152 
4153     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4154     t.in        = boundary; /* Should go away */
4155     t.plc       = 1;
4156     t.quality   = 1;
4157     t.edgesout  = 1;
4158     t.zeroindex = 1;
4159     t.quiet     = 1;
4160     t.verbose   = verbose;
4161     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
4162     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4163   }
4164   {
4165     const PetscInt numCorners  = 4;
4166     const PetscInt numCells    = out->numberoftetrahedra;
4167     const PetscInt numVertices = out->numberofpoints;
4168     const double   *meshCoords = out->pointlist;
4169     int            *cells      = out->tetrahedronlist;
4170 
4171     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4172     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
4173     /* Set labels */
4174     for (v = 0; v < numVertices; ++v) {
4175       if (out->pointmarkerlist[v]) {
4176         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4177       }
4178     }
4179     if (interpolate) {
4180       PetscInt e;
4181 
4182       for (e = 0; e < out->numberofedges; e++) {
4183         if (out->edgemarkerlist[e]) {
4184           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4185           const PetscInt *edges;
4186           PetscInt        numEdges;
4187 
4188           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4189           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4190           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4191           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4192         }
4193       }
4194       for (f = 0; f < out->numberoftrifaces; f++) {
4195         if (out->trifacemarkerlist[f]) {
4196           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4197           const PetscInt *faces;
4198           PetscInt        numFaces;
4199 
4200           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4201           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4202           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4203           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4204         }
4205       }
4206     }
4207     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
4208   }
4209 
4210   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4211   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4212   PetscFunctionReturn(0);
4213 }
4214 
4215 #undef __FUNCT__
4216 #define __FUNCT__ "DMPlexRefine_CTetgen"
4217 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
4218 {
4219   MPI_Comm       comm;
4220   const PetscInt dim  = 3;
4221   PLC           *in, *out;
4222   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
4223   PetscMPIInt    rank;
4224   PetscErrorCode ierr;
4225 
4226   PetscFunctionBegin;
4227   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
4228   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4229   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4230   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4231   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
4232   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4233   ierr = PLCCreate(&in);CHKERRQ(ierr);
4234   ierr = PLCCreate(&out);CHKERRQ(ierr);
4235 
4236   in->numberofpoints = vEnd - vStart;
4237   if (in->numberofpoints > 0) {
4238     PetscSection coordSection;
4239     Vec          coordinates;
4240     PetscScalar *array;
4241 
4242     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
4243     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
4244     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4245     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4246     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4247     for (v = vStart; v < vEnd; ++v) {
4248       const PetscInt idx = v - vStart;
4249       PetscInt       off, d, m;
4250 
4251       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4252       for (d = 0; d < dim; ++d) {
4253         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4254       }
4255       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
4256 
4257       in->pointmarkerlist[idx] = (int) m;
4258     }
4259     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4260   }
4261   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4262 
4263   in->numberofcorners       = 4;
4264   in->numberoftetrahedra    = cEnd - cStart;
4265   in->tetrahedronvolumelist = maxVolumes;
4266   if (in->numberoftetrahedra > 0) {
4267     ierr = PetscMalloc1(in->numberoftetrahedra*in->numberofcorners, &in->tetrahedronlist);CHKERRQ(ierr);
4268     for (c = cStart; c < cEnd; ++c) {
4269       const PetscInt idx      = c - cStart;
4270       PetscInt      *closure = NULL;
4271       PetscInt       closureSize;
4272 
4273       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4274       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4275       for (v = 0; v < 4; ++v) {
4276         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4277       }
4278       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4279     }
4280   }
4281   if (!rank) {
4282     TetGenOpts t;
4283 
4284     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4285 
4286     t.in        = dm; /* Should go away */
4287     t.refine    = 1;
4288     t.varvolume = 1;
4289     t.quality   = 1;
4290     t.edgesout  = 1;
4291     t.zeroindex = 1;
4292     t.quiet     = 1;
4293     t.verbose   = verbose; /* Change this */
4294 
4295     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4296     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4297   }
4298   {
4299     const PetscInt numCorners  = 4;
4300     const PetscInt numCells    = out->numberoftetrahedra;
4301     const PetscInt numVertices = out->numberofpoints;
4302     const double   *meshCoords = out->pointlist;
4303     int            *cells      = out->tetrahedronlist;
4304     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4305 
4306     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4307     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4308     /* Set labels */
4309     for (v = 0; v < numVertices; ++v) {
4310       if (out->pointmarkerlist[v]) {
4311         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4312       }
4313     }
4314     if (interpolate) {
4315       PetscInt e, f;
4316 
4317       for (e = 0; e < out->numberofedges; e++) {
4318         if (out->edgemarkerlist[e]) {
4319           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4320           const PetscInt *edges;
4321           PetscInt        numEdges;
4322 
4323           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4324           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4325           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4326           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4327         }
4328       }
4329       for (f = 0; f < out->numberoftrifaces; f++) {
4330         if (out->trifacemarkerlist[f]) {
4331           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4332           const PetscInt *faces;
4333           PetscInt        numFaces;
4334 
4335           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4336           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4337           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4338           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4339         }
4340       }
4341     }
4342     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4343   }
4344   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4345   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4346   PetscFunctionReturn(0);
4347 }
4348 #endif
4349 
4350 #undef __FUNCT__
4351 #define __FUNCT__ "DMPlexGenerate"
4352 /*@C
4353   DMPlexGenerate - Generates a mesh.
4354 
4355   Not Collective
4356 
4357   Input Parameters:
4358 + boundary - The DMPlex boundary object
4359 . name - The mesh generation package name
4360 - interpolate - Flag to create intermediate mesh elements
4361 
4362   Output Parameter:
4363 . mesh - The DMPlex object
4364 
4365   Level: intermediate
4366 
4367 .keywords: mesh, elements
4368 .seealso: DMPlexCreate(), DMRefine()
4369 @*/
4370 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4371 {
4372   PetscInt       dim;
4373   char           genname[1024];
4374   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4375   PetscErrorCode ierr;
4376 
4377   PetscFunctionBegin;
4378   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4379   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4380   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4381   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4382   if (flg) name = genname;
4383   if (name) {
4384     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4385     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4386     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4387   }
4388   switch (dim) {
4389   case 1:
4390     if (!name || isTriangle) {
4391 #if defined(PETSC_HAVE_TRIANGLE)
4392       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4393 #else
4394       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4395 #endif
4396     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4397     break;
4398   case 2:
4399     if (!name || isCTetgen) {
4400 #if defined(PETSC_HAVE_CTETGEN)
4401       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4402 #else
4403       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4404 #endif
4405     } else if (isTetgen) {
4406 #if defined(PETSC_HAVE_TETGEN)
4407       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4408 #else
4409       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4410 #endif
4411     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4412     break;
4413   default:
4414     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4415   }
4416   PetscFunctionReturn(0);
4417 }
4418 
4419 #undef __FUNCT__
4420 #define __FUNCT__ "DMRefine_Plex"
4421 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
4422 {
4423   PetscReal      refinementLimit;
4424   PetscInt       dim, cStart, cEnd;
4425   char           genname[1024], *name = NULL;
4426   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4427   PetscErrorCode ierr;
4428 
4429   PetscFunctionBegin;
4430   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4431   if (isUniform) {
4432     CellRefiner cellRefiner;
4433 
4434     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
4435     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
4436     PetscFunctionReturn(0);
4437   }
4438   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
4439   if (refinementLimit == 0.0) PetscFunctionReturn(0);
4440   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
4441   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4442   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4443   if (flg) name = genname;
4444   if (name) {
4445     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4446     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4447     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4448   }
4449   switch (dim) {
4450   case 2:
4451     if (!name || isTriangle) {
4452 #if defined(PETSC_HAVE_TRIANGLE)
4453       double  *maxVolumes;
4454       PetscInt c;
4455 
4456       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4457       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4458       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4459       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
4460 #else
4461       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
4462 #endif
4463     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4464     break;
4465   case 3:
4466     if (!name || isCTetgen) {
4467 #if defined(PETSC_HAVE_CTETGEN)
4468       PetscReal *maxVolumes;
4469       PetscInt   c;
4470 
4471       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4472       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4473       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4474 #else
4475       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4476 #endif
4477     } else if (isTetgen) {
4478 #if defined(PETSC_HAVE_TETGEN)
4479       double  *maxVolumes;
4480       PetscInt c;
4481 
4482       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4483       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4484       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4485 #else
4486       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4487 #endif
4488     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4489     break;
4490   default:
4491     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
4492   }
4493   PetscFunctionReturn(0);
4494 }
4495 
4496 #undef __FUNCT__
4497 #define __FUNCT__ "DMPlexGetDepthLabel"
4498 /*@
4499   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
4500 
4501   Not Collective
4502 
4503   Input Parameter:
4504 . dm    - The DMPlex object
4505 
4506   Output Parameter:
4507 . depthLabel - The DMLabel recording point depth
4508 
4509   Level: developer
4510 
4511 .keywords: mesh, points
4512 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4513 @*/
4514 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
4515 {
4516   DM_Plex       *mesh = (DM_Plex*) dm->data;
4517   PetscErrorCode ierr;
4518 
4519   PetscFunctionBegin;
4520   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4521   PetscValidPointer(depthLabel, 2);
4522   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
4523   *depthLabel = mesh->depthLabel;
4524   PetscFunctionReturn(0);
4525 }
4526 
4527 #undef __FUNCT__
4528 #define __FUNCT__ "DMPlexGetDepth"
4529 /*@
4530   DMPlexGetDepth - Get the depth of the DAG representing this mesh
4531 
4532   Not Collective
4533 
4534   Input Parameter:
4535 . dm    - The DMPlex object
4536 
4537   Output Parameter:
4538 . depth - The number of strata (breadth first levels) in the DAG
4539 
4540   Level: developer
4541 
4542 .keywords: mesh, points
4543 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4544 @*/
4545 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
4546 {
4547   DMLabel        label;
4548   PetscInt       d = 0;
4549   PetscErrorCode ierr;
4550 
4551   PetscFunctionBegin;
4552   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4553   PetscValidPointer(depth, 2);
4554   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4555   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
4556   *depth = d-1;
4557   PetscFunctionReturn(0);
4558 }
4559 
4560 #undef __FUNCT__
4561 #define __FUNCT__ "DMPlexGetDepthStratum"
4562 /*@
4563   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
4564 
4565   Not Collective
4566 
4567   Input Parameters:
4568 + dm           - The DMPlex object
4569 - stratumValue - The requested depth
4570 
4571   Output Parameters:
4572 + start - The first point at this depth
4573 - end   - One beyond the last point at this depth
4574 
4575   Level: developer
4576 
4577 .keywords: mesh, points
4578 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
4579 @*/
4580 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4581 {
4582   DMLabel        label;
4583   PetscInt       pStart, pEnd;
4584   PetscErrorCode ierr;
4585 
4586   PetscFunctionBegin;
4587   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4588   if (start) {PetscValidPointer(start, 3); *start = 0;}
4589   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4590   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4591   if (pStart == pEnd) PetscFunctionReturn(0);
4592   if (stratumValue < 0) {
4593     if (start) *start = pStart;
4594     if (end)   *end   = pEnd;
4595     PetscFunctionReturn(0);
4596   }
4597   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4598   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
4599   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
4600   PetscFunctionReturn(0);
4601 }
4602 
4603 #undef __FUNCT__
4604 #define __FUNCT__ "DMPlexGetHeightStratum"
4605 /*@
4606   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4607 
4608   Not Collective
4609 
4610   Input Parameters:
4611 + dm           - The DMPlex object
4612 - stratumValue - The requested height
4613 
4614   Output Parameters:
4615 + start - The first point at this height
4616 - end   - One beyond the last point at this height
4617 
4618   Level: developer
4619 
4620 .keywords: mesh, points
4621 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4622 @*/
4623 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4624 {
4625   DMLabel        label;
4626   PetscInt       depth, pStart, pEnd;
4627   PetscErrorCode ierr;
4628 
4629   PetscFunctionBegin;
4630   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4631   if (start) {PetscValidPointer(start, 3); *start = 0;}
4632   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4633   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4634   if (pStart == pEnd) PetscFunctionReturn(0);
4635   if (stratumValue < 0) {
4636     if (start) *start = pStart;
4637     if (end)   *end   = pEnd;
4638     PetscFunctionReturn(0);
4639   }
4640   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4641   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4642   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4643   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4644   PetscFunctionReturn(0);
4645 }
4646 
4647 #undef __FUNCT__
4648 #define __FUNCT__ "DMPlexCreateSectionInitial"
4649 /* Set the number of dof on each point and separate by fields */
4650 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4651 {
4652   PetscInt      *numDofTot;
4653   PetscInt       depth, pStart = 0, pEnd = 0;
4654   PetscInt       p, d, dep, f;
4655   PetscErrorCode ierr;
4656 
4657   PetscFunctionBegin;
4658   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
4659   for (d = 0; d <= dim; ++d) {
4660     numDofTot[d] = 0;
4661     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4662   }
4663   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4664   if (numFields > 0) {
4665     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4666     if (numComp) {
4667       for (f = 0; f < numFields; ++f) {
4668         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4669       }
4670     }
4671   }
4672   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4673   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4674   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4675   for (dep = 0; dep <= depth; ++dep) {
4676     d    = dim == depth ? dep : (!dep ? 0 : dim);
4677     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
4678     for (p = pStart; p < pEnd; ++p) {
4679       for (f = 0; f < numFields; ++f) {
4680         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4681       }
4682       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4683     }
4684   }
4685   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4686   PetscFunctionReturn(0);
4687 }
4688 
4689 #undef __FUNCT__
4690 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4691 /* Set the number of dof on each point and separate by fields
4692    If constDof is PETSC_DETERMINE, constrain every dof on the point
4693 */
4694 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4695 {
4696   PetscInt       numFields;
4697   PetscInt       bc;
4698   PetscErrorCode ierr;
4699 
4700   PetscFunctionBegin;
4701   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4702   for (bc = 0; bc < numBC; ++bc) {
4703     PetscInt        field = 0;
4704     const PetscInt *idx;
4705     PetscInt        n, i;
4706 
4707     if (numFields) field = bcField[bc];
4708     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4709     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4710     for (i = 0; i < n; ++i) {
4711       const PetscInt p        = idx[i];
4712       PetscInt       numConst = constDof;
4713 
4714       /* Constrain every dof on the point */
4715       if (numConst < 0) {
4716         if (numFields) {
4717           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4718         } else {
4719           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4720         }
4721       }
4722       if (numFields) {
4723         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4724       }
4725       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4726     }
4727     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4728   }
4729   PetscFunctionReturn(0);
4730 }
4731 
4732 #undef __FUNCT__
4733 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4734 /* Set the constrained indices on each point and separate by fields */
4735 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4736 {
4737   PetscInt      *maxConstraints;
4738   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4739   PetscErrorCode ierr;
4740 
4741   PetscFunctionBegin;
4742   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4743   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4744   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
4745   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4746   for (p = pStart; p < pEnd; ++p) {
4747     PetscInt cdof;
4748 
4749     if (numFields) {
4750       for (f = 0; f < numFields; ++f) {
4751         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4752         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4753       }
4754     } else {
4755       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4756       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4757     }
4758   }
4759   for (f = 0; f < numFields; ++f) {
4760     maxConstraints[numFields] += maxConstraints[f];
4761   }
4762   if (maxConstraints[numFields]) {
4763     PetscInt *indices;
4764 
4765     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
4766     for (p = pStart; p < pEnd; ++p) {
4767       PetscInt cdof, d;
4768 
4769       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4770       if (cdof) {
4771         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4772         if (numFields) {
4773           PetscInt numConst = 0, foff = 0;
4774 
4775           for (f = 0; f < numFields; ++f) {
4776             PetscInt cfdof, fdof;
4777 
4778             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4779             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4780             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4781             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4782             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4783             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4784             numConst += cfdof;
4785             foff     += fdof;
4786           }
4787           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4788         } else {
4789           for (d = 0; d < cdof; ++d) indices[d] = d;
4790         }
4791         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4792       }
4793     }
4794     ierr = PetscFree(indices);CHKERRQ(ierr);
4795   }
4796   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4797   PetscFunctionReturn(0);
4798 }
4799 
4800 #undef __FUNCT__
4801 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4802 /* Set the constrained field indices on each point */
4803 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4804 {
4805   const PetscInt *points, *indices;
4806   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4807   PetscErrorCode  ierr;
4808 
4809   PetscFunctionBegin;
4810   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4811   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4812 
4813   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4814   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4815   if (!constraintIndices) {
4816     PetscInt *idx, i;
4817 
4818     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4819     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
4820     for (i = 0; i < maxDof; ++i) idx[i] = i;
4821     for (p = 0; p < numPoints; ++p) {
4822       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4823     }
4824     ierr = PetscFree(idx);CHKERRQ(ierr);
4825   } else {
4826     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4827     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4828     for (p = 0; p < numPoints; ++p) {
4829       PetscInt fcdof;
4830 
4831       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4832       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);
4833       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4834     }
4835     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4836   }
4837   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4838   PetscFunctionReturn(0);
4839 }
4840 
4841 #undef __FUNCT__
4842 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4843 /* Set the constrained indices on each point and separate by fields */
4844 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4845 {
4846   PetscInt      *indices;
4847   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4848   PetscErrorCode ierr;
4849 
4850   PetscFunctionBegin;
4851   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4852   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
4853   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4854   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4855   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4856   for (p = pStart; p < pEnd; ++p) {
4857     PetscInt cdof, d;
4858 
4859     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4860     if (cdof) {
4861       PetscInt numConst = 0, foff = 0;
4862 
4863       for (f = 0; f < numFields; ++f) {
4864         const PetscInt *fcind;
4865         PetscInt        fdof, fcdof;
4866 
4867         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4868         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4869         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4870         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4871         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4872         foff     += fdof;
4873         numConst += fcdof;
4874       }
4875       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4876       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4877     }
4878   }
4879   ierr = PetscFree(indices);CHKERRQ(ierr);
4880   PetscFunctionReturn(0);
4881 }
4882 
4883 #undef __FUNCT__
4884 #define __FUNCT__ "DMPlexCreateSection"
4885 /*@C
4886   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4887 
4888   Not Collective
4889 
4890   Input Parameters:
4891 + dm        - The DMPlex object
4892 . dim       - The spatial dimension of the problem
4893 . numFields - The number of fields in the problem
4894 . numComp   - An array of size numFields that holds the number of components for each field
4895 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4896 . numBC     - The number of boundary conditions
4897 . bcField   - An array of size numBC giving the field number for each boundry condition
4898 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4899 
4900   Output Parameter:
4901 . section - The PetscSection object
4902 
4903   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
4904   nubmer of dof for field 0 on each edge.
4905 
4906   Level: developer
4907 
4908   Fortran Notes:
4909   A Fortran 90 version is available as DMPlexCreateSectionF90()
4910 
4911 .keywords: mesh, elements
4912 .seealso: DMPlexCreate(), PetscSectionCreate()
4913 @*/
4914 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
4915 {
4916   PetscErrorCode ierr;
4917 
4918   PetscFunctionBegin;
4919   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4920   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4921   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4922   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4923   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
4924   PetscFunctionReturn(0);
4925 }
4926 
4927 #undef __FUNCT__
4928 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4929 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4930 {
4931   PetscSection   section;
4932   PetscErrorCode ierr;
4933 
4934   PetscFunctionBegin;
4935   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4936   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4937   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4938   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4939   PetscFunctionReturn(0);
4940 }
4941 
4942 #undef __FUNCT__
4943 #define __FUNCT__ "DMPlexGetConeSection"
4944 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4945 {
4946   DM_Plex *mesh = (DM_Plex*) dm->data;
4947 
4948   PetscFunctionBegin;
4949   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4950   if (section) *section = mesh->coneSection;
4951   PetscFunctionReturn(0);
4952 }
4953 
4954 #undef __FUNCT__
4955 #define __FUNCT__ "DMPlexGetSupportSection"
4956 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4957 {
4958   DM_Plex *mesh = (DM_Plex*) dm->data;
4959 
4960   PetscFunctionBegin;
4961   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4962   if (section) *section = mesh->supportSection;
4963   PetscFunctionReturn(0);
4964 }
4965 
4966 #undef __FUNCT__
4967 #define __FUNCT__ "DMPlexGetCones"
4968 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4969 {
4970   DM_Plex *mesh = (DM_Plex*) dm->data;
4971 
4972   PetscFunctionBegin;
4973   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4974   if (cones) *cones = mesh->cones;
4975   PetscFunctionReturn(0);
4976 }
4977 
4978 #undef __FUNCT__
4979 #define __FUNCT__ "DMPlexGetConeOrientations"
4980 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4981 {
4982   DM_Plex *mesh = (DM_Plex*) dm->data;
4983 
4984   PetscFunctionBegin;
4985   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4986   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4987   PetscFunctionReturn(0);
4988 }
4989 
4990 /******************************** FEM Support **********************************/
4991 
4992 #undef __FUNCT__
4993 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
4994 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4995 {
4996   PetscScalar    *array, *vArray;
4997   const PetscInt *cone, *coneO;
4998   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4999   PetscErrorCode  ierr;
5000 
5001   PetscFunctionBeginHot;
5002   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5003   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5004   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5005   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5006   if (!values || !*values) {
5007     if ((point >= pStart) && (point < pEnd)) {
5008       PetscInt dof;
5009 
5010       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5011       size += dof;
5012     }
5013     for (p = 0; p < numPoints; ++p) {
5014       const PetscInt cp = cone[p];
5015       PetscInt       dof;
5016 
5017       if ((cp < pStart) || (cp >= pEnd)) continue;
5018       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5019       size += dof;
5020     }
5021     if (!values) {
5022       if (csize) *csize = size;
5023       PetscFunctionReturn(0);
5024     }
5025     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
5026   } else {
5027     array = *values;
5028   }
5029   size = 0;
5030   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5031   if ((point >= pStart) && (point < pEnd)) {
5032     PetscInt     dof, off, d;
5033     PetscScalar *varr;
5034 
5035     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5036     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5037     varr = &vArray[off];
5038     for (d = 0; d < dof; ++d, ++offset) {
5039       array[offset] = varr[d];
5040     }
5041     size += dof;
5042   }
5043   for (p = 0; p < numPoints; ++p) {
5044     const PetscInt cp = cone[p];
5045     PetscInt       o  = coneO[p];
5046     PetscInt       dof, off, d;
5047     PetscScalar   *varr;
5048 
5049     if ((cp < pStart) || (cp >= pEnd)) continue;
5050     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5051     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
5052     varr = &vArray[off];
5053     if (o >= 0) {
5054       for (d = 0; d < dof; ++d, ++offset) {
5055         array[offset] = varr[d];
5056       }
5057     } else {
5058       for (d = dof-1; d >= 0; --d, ++offset) {
5059         array[offset] = varr[d];
5060       }
5061     }
5062     size += dof;
5063   }
5064   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5065   if (!*values) {
5066     if (csize) *csize = size;
5067     *values = array;
5068   } else {
5069     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5070     *csize = size;
5071   }
5072   PetscFunctionReturn(0);
5073 }
5074 
5075 #undef __FUNCT__
5076 #define __FUNCT__ "DMPlexVecGetClosure_Static"
5077 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5078 {
5079   PetscInt       offset = 0, p;
5080   PetscErrorCode ierr;
5081 
5082   PetscFunctionBeginHot;
5083   *size = 0;
5084   for (p = 0; p < numPoints*2; p += 2) {
5085     const PetscInt point = points[p];
5086     const PetscInt o     = points[p+1];
5087     PetscInt       dof, off, d;
5088     const PetscScalar *varr;
5089 
5090     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5091     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5092     varr = &vArray[off];
5093     if (o >= 0) {
5094       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
5095     } else {
5096       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
5097     }
5098   }
5099   *size = offset;
5100   PetscFunctionReturn(0);
5101 }
5102 
5103 #undef __FUNCT__
5104 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
5105 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
5106 {
5107   PetscInt       offset = 0, f;
5108   PetscErrorCode ierr;
5109 
5110   PetscFunctionBeginHot;
5111   *size = 0;
5112   for (f = 0; f < numFields; ++f) {
5113     PetscInt fcomp, p;
5114 
5115     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5116     for (p = 0; p < numPoints*2; p += 2) {
5117       const PetscInt point = points[p];
5118       const PetscInt o     = points[p+1];
5119       PetscInt       fdof, foff, d, c;
5120       const PetscScalar *varr;
5121 
5122       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5123       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5124       varr = &vArray[foff];
5125       if (o >= 0) {
5126         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
5127       } else {
5128         for (d = fdof/fcomp-1; d >= 0; --d) {
5129           for (c = 0; c < fcomp; ++c, ++offset) {
5130             array[offset] = varr[d*fcomp+c];
5131           }
5132         }
5133       }
5134     }
5135   }
5136   *size = offset;
5137   PetscFunctionReturn(0);
5138 }
5139 
5140 #undef __FUNCT__
5141 #define __FUNCT__ "DMPlexVecGetClosure"
5142 /*@C
5143   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
5144 
5145   Not collective
5146 
5147   Input Parameters:
5148 + dm - The DM
5149 . section - The section describing the layout in v, or NULL to use the default section
5150 . v - The local vector
5151 - point - The sieve point in the DM
5152 
5153   Output Parameters:
5154 + csize - The number of values in the closure, or NULL
5155 - values - The array of values, which is a borrowed array and should not be freed
5156 
5157   Fortran Notes:
5158   Since it returns an array, this routine is only available in Fortran 90, and you must
5159   include petsc.h90 in your code.
5160 
5161   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5162 
5163   Level: intermediate
5164 
5165 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5166 @*/
5167 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5168 {
5169   PetscSection    clSection;
5170   IS              clPoints;
5171   PetscScalar    *array, *vArray;
5172   PetscInt       *points = NULL;
5173   const PetscInt *clp;
5174   PetscInt        depth, numFields, numPoints, size;
5175   PetscErrorCode  ierr;
5176 
5177   PetscFunctionBeginHot;
5178   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5179   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5180   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5181   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5182   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5183   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5184   if (depth == 1 && numFields < 2) {
5185     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
5186     PetscFunctionReturn(0);
5187   }
5188   /* Get points */
5189   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5190   if (!clPoints) {
5191     PetscInt pStart, pEnd, p, q;
5192 
5193     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5194     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5195     /* Compress out points not in the section */
5196     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5197       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5198         points[q*2]   = points[p];
5199         points[q*2+1] = points[p+1];
5200         ++q;
5201       }
5202     }
5203     numPoints = q;
5204   } else {
5205     PetscInt dof, off;
5206 
5207     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5208     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5209     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5210     numPoints = dof/2;
5211     points    = (PetscInt *) &clp[off];
5212   }
5213   /* Get array */
5214   if (!values || !*values) {
5215     PetscInt asize = 0, dof, p;
5216 
5217     for (p = 0; p < numPoints*2; p += 2) {
5218       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5219       asize += dof;
5220     }
5221     if (!values) {
5222       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5223       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5224       if (csize) *csize = asize;
5225       PetscFunctionReturn(0);
5226     }
5227     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
5228   } else {
5229     array = *values;
5230   }
5231   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5232   /* Get values */
5233   if (numFields > 1) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
5234   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
5235   /* Cleanup points */
5236   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5237   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5238   /* Cleanup array */
5239   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5240   if (!*values) {
5241     if (csize) *csize = size;
5242     *values = array;
5243   } else {
5244     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5245     *csize = size;
5246   }
5247   PetscFunctionReturn(0);
5248 }
5249 
5250 #undef __FUNCT__
5251 #define __FUNCT__ "DMPlexVecRestoreClosure"
5252 /*@C
5253   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
5254 
5255   Not collective
5256 
5257   Input Parameters:
5258 + dm - The DM
5259 . section - The section describing the layout in v, or NULL to use the default section
5260 . v - The local vector
5261 . point - The sieve point in the DM
5262 . csize - The number of values in the closure, or NULL
5263 - values - The array of values, which is a borrowed array and should not be freed
5264 
5265   Fortran Notes:
5266   Since it returns an array, this routine is only available in Fortran 90, and you must
5267   include petsc.h90 in your code.
5268 
5269   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5270 
5271   Level: intermediate
5272 
5273 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5274 @*/
5275 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5276 {
5277   PetscInt       size = 0;
5278   PetscErrorCode ierr;
5279 
5280   PetscFunctionBegin;
5281   /* Should work without recalculating size */
5282   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
5283   PetscFunctionReturn(0);
5284 }
5285 
5286 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
5287 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
5288 
5289 #undef __FUNCT__
5290 #define __FUNCT__ "updatePoint_private"
5291 PETSC_STATIC_INLINE PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5292 {
5293   PetscInt        cdof;   /* The number of constraints on this point */
5294   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5295   PetscScalar    *a;
5296   PetscInt        off, cind = 0, k;
5297   PetscErrorCode  ierr;
5298 
5299   PetscFunctionBegin;
5300   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5301   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5302   a    = &array[off];
5303   if (!cdof || setBC) {
5304     if (orientation >= 0) {
5305       for (k = 0; k < dof; ++k) {
5306         fuse(&a[k], values[k]);
5307       }
5308     } else {
5309       for (k = 0; k < dof; ++k) {
5310         fuse(&a[k], values[dof-k-1]);
5311       }
5312     }
5313   } else {
5314     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5315     if (orientation >= 0) {
5316       for (k = 0; k < dof; ++k) {
5317         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5318         fuse(&a[k], values[k]);
5319       }
5320     } else {
5321       for (k = 0; k < dof; ++k) {
5322         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5323         fuse(&a[k], values[dof-k-1]);
5324       }
5325     }
5326   }
5327   PetscFunctionReturn(0);
5328 }
5329 
5330 #undef __FUNCT__
5331 #define __FUNCT__ "updatePointBC_private"
5332 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5333 {
5334   PetscInt        cdof;   /* The number of constraints on this point */
5335   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5336   PetscScalar    *a;
5337   PetscInt        off, cind = 0, k;
5338   PetscErrorCode  ierr;
5339 
5340   PetscFunctionBegin;
5341   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5342   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5343   a    = &array[off];
5344   if (cdof) {
5345     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5346     if (orientation >= 0) {
5347       for (k = 0; k < dof; ++k) {
5348         if ((cind < cdof) && (k == cdofs[cind])) {
5349           fuse(&a[k], values[k]);
5350           ++cind;
5351         }
5352       }
5353     } else {
5354       for (k = 0; k < dof; ++k) {
5355         if ((cind < cdof) && (k == cdofs[cind])) {
5356           fuse(&a[k], values[dof-k-1]);
5357           ++cind;
5358         }
5359       }
5360     }
5361   }
5362   PetscFunctionReturn(0);
5363 }
5364 
5365 #undef __FUNCT__
5366 #define __FUNCT__ "updatePointFields_private"
5367 PETSC_STATIC_INLINE PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt o, PetscInt f, PetscInt fcomp, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscScalar values[], PetscInt *offset, PetscScalar array[])
5368 {
5369   PetscScalar    *a;
5370   PetscInt        fdof, foff, fcdof, foffset = *offset;
5371   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5372   PetscInt        cind = 0, k, c;
5373   PetscErrorCode  ierr;
5374 
5375   PetscFunctionBegin;
5376   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5377   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5378   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5379   a    = &array[foff];
5380   if (!fcdof || setBC) {
5381     if (o >= 0) {
5382       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
5383     } else {
5384       for (k = fdof/fcomp-1; k >= 0; --k) {
5385         for (c = 0; c < fcomp; ++c) {
5386           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5387         }
5388       }
5389     }
5390   } else {
5391     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5392     if (o >= 0) {
5393       for (k = 0; k < fdof; ++k) {
5394         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
5395         fuse(&a[k], values[foffset+k]);
5396       }
5397     } else {
5398       for (k = fdof/fcomp-1; k >= 0; --k) {
5399         for (c = 0; c < fcomp; ++c) {
5400           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
5401           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5402         }
5403       }
5404     }
5405   }
5406   *offset += fdof;
5407   PetscFunctionReturn(0);
5408 }
5409 
5410 #undef __FUNCT__
5411 #define __FUNCT__ "updatePointFieldsBC_private"
5412 PETSC_STATIC_INLINE PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, PetscInt o, PetscInt f, PetscInt fcomp, void (*fuse)(PetscScalar*, PetscScalar), const PetscScalar values[], PetscInt *offset, PetscScalar array[])
5413 {
5414   PetscScalar    *a;
5415   PetscInt        fdof, foff, fcdof, foffset = *offset;
5416   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5417   PetscInt        cind = 0, k, c;
5418   PetscErrorCode  ierr;
5419 
5420   PetscFunctionBegin;
5421   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5422   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5423   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5424   a    = &array[foff];
5425   if (fcdof) {
5426     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5427     if (o >= 0) {
5428       for (k = 0; k < fdof; ++k) {
5429         if ((cind < fcdof) && (k == fcdofs[cind])) {
5430           fuse(&a[k], values[foffset+k]);
5431           ++cind;
5432         }
5433       }
5434     } else {
5435       for (k = fdof/fcomp-1; k >= 0; --k) {
5436         for (c = 0; c < fcomp; ++c) {
5437           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
5438             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5439             ++cind;
5440           }
5441         }
5442       }
5443     }
5444   }
5445   *offset += fdof;
5446   PetscFunctionReturn(0);
5447 }
5448 
5449 #undef __FUNCT__
5450 #define __FUNCT__ "DMPlexVecSetClosure_Static"
5451 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5452 {
5453   PetscScalar    *array;
5454   const PetscInt *cone, *coneO;
5455   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5456   PetscErrorCode  ierr;
5457 
5458   PetscFunctionBeginHot;
5459   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5460   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5461   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5462   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5463   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5464   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5465     const PetscInt cp = !p ? point : cone[p-1];
5466     const PetscInt o  = !p ? 0     : coneO[p-1];
5467 
5468     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5469     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5470     /* ADD_VALUES */
5471     {
5472       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5473       PetscScalar    *a;
5474       PetscInt        cdof, coff, cind = 0, k;
5475 
5476       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5477       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5478       a    = &array[coff];
5479       if (!cdof) {
5480         if (o >= 0) {
5481           for (k = 0; k < dof; ++k) {
5482             a[k] += values[off+k];
5483           }
5484         } else {
5485           for (k = 0; k < dof; ++k) {
5486             a[k] += values[off+dof-k-1];
5487           }
5488         }
5489       } else {
5490         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5491         if (o >= 0) {
5492           for (k = 0; k < dof; ++k) {
5493             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5494             a[k] += values[off+k];
5495           }
5496         } else {
5497           for (k = 0; k < dof; ++k) {
5498             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5499             a[k] += values[off+dof-k-1];
5500           }
5501         }
5502       }
5503     }
5504   }
5505   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 #undef __FUNCT__
5510 #define __FUNCT__ "DMPlexVecSetClosure"
5511 /*@C
5512   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5513 
5514   Not collective
5515 
5516   Input Parameters:
5517 + dm - The DM
5518 . section - The section describing the layout in v, or NULL to use the default section
5519 . v - The local vector
5520 . point - The sieve point in the DM
5521 . values - The array of values
5522 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5523 
5524   Fortran Notes:
5525   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5526 
5527   Level: intermediate
5528 
5529 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5530 @*/
5531 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5532 {
5533   PetscSection    clSection;
5534   IS              clPoints;
5535   PetscScalar    *array;
5536   PetscInt       *points = NULL;
5537   const PetscInt *clp;
5538   PetscInt        depth, numFields, numPoints, p;
5539   PetscErrorCode  ierr;
5540 
5541   PetscFunctionBeginHot;
5542   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5543   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5544   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5545   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5546   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5547   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5548   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5549     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5550     PetscFunctionReturn(0);
5551   }
5552   /* Get points */
5553   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5554   if (!clPoints) {
5555     PetscInt pStart, pEnd, q;
5556 
5557     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5558     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5559     /* Compress out points not in the section */
5560     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5561       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5562         points[q*2]   = points[p];
5563         points[q*2+1] = points[p+1];
5564         ++q;
5565       }
5566     }
5567     numPoints = q;
5568   } else {
5569     PetscInt dof, off;
5570 
5571     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5572     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5573     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5574     numPoints = dof/2;
5575     points    = (PetscInt *) &clp[off];
5576   }
5577   /* Get array */
5578   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5579   /* Get values */
5580   if (numFields > 1) {
5581     PetscInt offset = 0, fcomp, f;
5582     for (f = 0; f < numFields; ++f) {
5583       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5584       switch (mode) {
5585       case INSERT_VALUES:
5586         for (p = 0; p < numPoints*2; p += 2) {
5587           const PetscInt point = points[p];
5588           const PetscInt o     = points[p+1];
5589           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
5590         } break;
5591       case INSERT_ALL_VALUES:
5592         for (p = 0; p < numPoints*2; p += 2) {
5593           const PetscInt point = points[p];
5594           const PetscInt o     = points[p+1];
5595           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
5596         } break;
5597       case INSERT_BC_VALUES:
5598         for (p = 0; p < numPoints*2; p += 2) {
5599           const PetscInt point = points[p];
5600           const PetscInt o     = points[p+1];
5601           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
5602         } break;
5603       case ADD_VALUES:
5604         for (p = 0; p < numPoints*2; p += 2) {
5605           const PetscInt point = points[p];
5606           const PetscInt o     = points[p+1];
5607           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
5608         } break;
5609       case ADD_ALL_VALUES:
5610         for (p = 0; p < numPoints*2; p += 2) {
5611           const PetscInt point = points[p];
5612           const PetscInt o     = points[p+1];
5613           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
5614         } break;
5615       default:
5616         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5617       }
5618     }
5619   } else {
5620     PetscInt dof, off;
5621 
5622     switch (mode) {
5623     case INSERT_VALUES:
5624       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5625         PetscInt o = points[p+1];
5626         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5627         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5628       } break;
5629     case INSERT_ALL_VALUES:
5630       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5631         PetscInt o = points[p+1];
5632         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5633         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5634       } break;
5635     case INSERT_BC_VALUES:
5636       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5637         PetscInt o = points[p+1];
5638         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5639         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5640       } break;
5641     case ADD_VALUES:
5642       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5643         PetscInt o = points[p+1];
5644         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5645         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5646       } break;
5647     case ADD_ALL_VALUES:
5648       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5649         PetscInt o = points[p+1];
5650         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5651         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5652       } break;
5653     default:
5654       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5655     }
5656   }
5657   /* Cleanup points */
5658   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5659   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5660   /* Cleanup array */
5661   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5662   PetscFunctionReturn(0);
5663 }
5664 
5665 #undef __FUNCT__
5666 #define __FUNCT__ "DMPlexPrintMatSetValues"
5667 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numIndices, const PetscInt indices[], const PetscScalar values[])
5668 {
5669   PetscMPIInt    rank;
5670   PetscInt       i, j;
5671   PetscErrorCode ierr;
5672 
5673   PetscFunctionBegin;
5674   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5675   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5676   for (i = 0; i < numIndices; i++) {
5677     ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat indices[%D] = %D\n", rank, i, indices[i]);CHKERRQ(ierr);
5678   }
5679   for (i = 0; i < numIndices; i++) {
5680     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5681     for (j = 0; j < numIndices; j++) {
5682 #if defined(PETSC_USE_COMPLEX)
5683       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numIndices+j]), (double)PetscImaginaryPart(values[i*numIndices+j]));CHKERRQ(ierr);
5684 #else
5685       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numIndices+j]);CHKERRQ(ierr);
5686 #endif
5687     }
5688     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5689   }
5690   PetscFunctionReturn(0);
5691 }
5692 
5693 #undef __FUNCT__
5694 #define __FUNCT__ "indicesPoint_private"
5695 /* . off - The global offset of this point */
5696 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5697 {
5698   PetscInt        dof;    /* The number of unknowns on this point */
5699   PetscInt        cdof;   /* The number of constraints on this point */
5700   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5701   PetscInt        cind = 0, k;
5702   PetscErrorCode  ierr;
5703 
5704   PetscFunctionBegin;
5705   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5706   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5707   if (!cdof || setBC) {
5708     if (orientation >= 0) {
5709       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5710     } else {
5711       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5712     }
5713   } else {
5714     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5715     if (orientation >= 0) {
5716       for (k = 0; k < dof; ++k) {
5717         if ((cind < cdof) && (k == cdofs[cind])) {
5718           /* Insert check for returning constrained indices */
5719           indices[*loff+k] = -(off+k+1);
5720           ++cind;
5721         } else {
5722           indices[*loff+k] = off+k-cind;
5723         }
5724       }
5725     } else {
5726       for (k = 0; k < dof; ++k) {
5727         if ((cind < cdof) && (k == cdofs[cind])) {
5728           /* Insert check for returning constrained indices */
5729           indices[*loff+dof-k-1] = -(off+k+1);
5730           ++cind;
5731         } else {
5732           indices[*loff+dof-k-1] = off+k-cind;
5733         }
5734       }
5735     }
5736   }
5737   *loff += dof;
5738   PetscFunctionReturn(0);
5739 }
5740 
5741 #undef __FUNCT__
5742 #define __FUNCT__ "indicesPointFields_private"
5743 /* . off - The global offset of this point */
5744 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5745 {
5746   PetscInt       numFields, foff, f;
5747   PetscErrorCode ierr;
5748 
5749   PetscFunctionBegin;
5750   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5751   for (f = 0, foff = 0; f < numFields; ++f) {
5752     PetscInt        fdof, fcomp, cfdof;
5753     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5754     PetscInt        cind = 0, k, c;
5755 
5756     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5757     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5758     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5759     if (!cfdof || setBC) {
5760       if (orientation >= 0) {
5761         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5762       } else {
5763         for (k = fdof/fcomp-1; k >= 0; --k) {
5764           for (c = 0; c < fcomp; ++c) {
5765             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5766           }
5767         }
5768       }
5769     } else {
5770       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5771       if (orientation >= 0) {
5772         for (k = 0; k < fdof; ++k) {
5773           if ((cind < cfdof) && (k == fcdofs[cind])) {
5774             indices[foffs[f]+k] = -(off+foff+k+1);
5775             ++cind;
5776           } else {
5777             indices[foffs[f]+k] = off+foff+k-cind;
5778           }
5779         }
5780       } else {
5781         for (k = fdof/fcomp-1; k >= 0; --k) {
5782           for (c = 0; c < fcomp; ++c) {
5783             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5784               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5785               ++cind;
5786             } else {
5787               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5788             }
5789           }
5790         }
5791       }
5792     }
5793     foff     += fdof - cfdof;
5794     foffs[f] += fdof;
5795   }
5796   PetscFunctionReturn(0);
5797 }
5798 
5799 #undef __FUNCT__
5800 #define __FUNCT__ "DMPlexMatSetClosure"
5801 /*@C
5802   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5803 
5804   Not collective
5805 
5806   Input Parameters:
5807 + dm - The DM
5808 . section - The section describing the layout in v, or NULL to use the default section
5809 . globalSection - The section describing the layout in v, or NULL to use the default global section
5810 . A - The matrix
5811 . point - The sieve point in the DM
5812 . values - The array of values
5813 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5814 
5815   Fortran Notes:
5816   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5817 
5818   Level: intermediate
5819 
5820 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5821 @*/
5822 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5823 {
5824   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5825   PetscSection    clSection;
5826   IS              clPoints;
5827   PetscInt       *points = NULL;
5828   const PetscInt *clp;
5829   PetscInt       *indices;
5830   PetscInt        offsets[32];
5831   PetscInt        numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5832   PetscErrorCode  ierr;
5833 
5834   PetscFunctionBegin;
5835   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5836   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5837   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5838   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5839   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5840   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5841   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5842   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5843   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5844   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5845   if (!clPoints) {
5846     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5847     /* Compress out points not in the section */
5848     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5849     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5850       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5851         points[q*2]   = points[p];
5852         points[q*2+1] = points[p+1];
5853         ++q;
5854       }
5855     }
5856     numPoints = q;
5857   } else {
5858     PetscInt dof, off;
5859 
5860     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5861     numPoints = dof/2;
5862     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5863     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5864     points = (PetscInt *) &clp[off];
5865   }
5866   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5867     PetscInt fdof;
5868 
5869     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5870     for (f = 0; f < numFields; ++f) {
5871       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5872       offsets[f+1] += fdof;
5873     }
5874     numIndices += dof;
5875   }
5876   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5877 
5878   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5879   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5880   if (numFields) {
5881     for (p = 0; p < numPoints*2; p += 2) {
5882       PetscInt o = points[p+1];
5883       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5884       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5885     }
5886   } else {
5887     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5888       PetscInt o = points[p+1];
5889       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5890       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5891     }
5892   }
5893   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr);}
5894   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5895   if (ierr) {
5896     PetscMPIInt    rank;
5897     PetscErrorCode ierr2;
5898 
5899     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5900     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5901     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr2);
5902     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5903     CHKERRQ(ierr);
5904   }
5905   if (!clPoints) {
5906     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5907   } else {
5908     ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5909   }
5910   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5911   PetscFunctionReturn(0);
5912 }
5913 
5914 #undef __FUNCT__
5915 #define __FUNCT__ "DMPlexGetHybridBounds"
5916 /*@
5917   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5918 
5919   Input Parameter:
5920 . dm - The DMPlex object
5921 
5922   Output Parameters:
5923 + cMax - The first hybrid cell
5924 . cMax - The first hybrid face
5925 . cMax - The first hybrid edge
5926 - cMax - The first hybrid vertex
5927 
5928   Level: developer
5929 
5930 .seealso DMPlexCreateHybridMesh()
5931 @*/
5932 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5933 {
5934   DM_Plex       *mesh = (DM_Plex*) dm->data;
5935   PetscInt       dim;
5936   PetscErrorCode ierr;
5937 
5938   PetscFunctionBegin;
5939   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5940   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5941   if (cMax) *cMax = mesh->hybridPointMax[dim];
5942   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5943   if (eMax) *eMax = mesh->hybridPointMax[1];
5944   if (vMax) *vMax = mesh->hybridPointMax[0];
5945   PetscFunctionReturn(0);
5946 }
5947 
5948 #undef __FUNCT__
5949 #define __FUNCT__ "DMPlexSetHybridBounds"
5950 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5951 {
5952   DM_Plex       *mesh = (DM_Plex*) dm->data;
5953   PetscInt       dim;
5954   PetscErrorCode ierr;
5955 
5956   PetscFunctionBegin;
5957   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5958   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5959   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5960   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5961   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5962   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5963   PetscFunctionReturn(0);
5964 }
5965 
5966 #undef __FUNCT__
5967 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5968 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5969 {
5970   DM_Plex *mesh = (DM_Plex*) dm->data;
5971 
5972   PetscFunctionBegin;
5973   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5974   PetscValidPointer(cellHeight, 2);
5975   *cellHeight = mesh->vtkCellHeight;
5976   PetscFunctionReturn(0);
5977 }
5978 
5979 #undef __FUNCT__
5980 #define __FUNCT__ "DMPlexSetVTKCellHeight"
5981 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5982 {
5983   DM_Plex *mesh = (DM_Plex*) dm->data;
5984 
5985   PetscFunctionBegin;
5986   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5987   mesh->vtkCellHeight = cellHeight;
5988   PetscFunctionReturn(0);
5989 }
5990 
5991 #undef __FUNCT__
5992 #define __FUNCT__ "DMPlexCreateNumbering_Private"
5993 /* We can easily have a form that takes an IS instead */
5994 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
5995 {
5996   PetscSection   section, globalSection;
5997   PetscInt      *numbers, p;
5998   PetscErrorCode ierr;
5999 
6000   PetscFunctionBegin;
6001   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6002   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6003   for (p = pStart; p < pEnd; ++p) {
6004     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6005   }
6006   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6007   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6008   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
6009   for (p = pStart; p < pEnd; ++p) {
6010     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6011   }
6012   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6013   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6014   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6015   PetscFunctionReturn(0);
6016 }
6017 
6018 #undef __FUNCT__
6019 #define __FUNCT__ "DMPlexGetCellNumbering"
6020 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6021 {
6022   DM_Plex       *mesh = (DM_Plex*) dm->data;
6023   PetscInt       cellHeight, cStart, cEnd, cMax;
6024   PetscErrorCode ierr;
6025 
6026   PetscFunctionBegin;
6027   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6028   if (!mesh->globalCellNumbers) {
6029     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6030     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6031     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6032     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
6033     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
6034   }
6035   *globalCellNumbers = mesh->globalCellNumbers;
6036   PetscFunctionReturn(0);
6037 }
6038 
6039 #undef __FUNCT__
6040 #define __FUNCT__ "DMPlexGetVertexNumbering"
6041 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6042 {
6043   DM_Plex       *mesh = (DM_Plex*) dm->data;
6044   PetscInt       vStart, vEnd, vMax;
6045   PetscErrorCode ierr;
6046 
6047   PetscFunctionBegin;
6048   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6049   if (!mesh->globalVertexNumbers) {
6050     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6051     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6052     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
6053     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
6054   }
6055   *globalVertexNumbers = mesh->globalVertexNumbers;
6056   PetscFunctionReturn(0);
6057 }
6058 
6059 
6060 #undef __FUNCT__
6061 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
6062 /*@C
6063   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
6064   the local section and an SF describing the section point overlap.
6065 
6066   Input Parameters:
6067   + s - The PetscSection for the local field layout
6068   . sf - The SF describing parallel layout of the section points
6069   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
6070   . label - The label specifying the points
6071   - labelValue - The label stratum specifying the points
6072 
6073   Output Parameter:
6074   . gsection - The PetscSection for the global field layout
6075 
6076   Note: This gives negative sizes and offsets to points not owned by this process
6077 
6078   Level: developer
6079 
6080 .seealso: PetscSectionCreate()
6081 @*/
6082 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
6083 {
6084   PetscInt      *neg = NULL, *tmpOff = NULL;
6085   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
6086   PetscErrorCode ierr;
6087 
6088   PetscFunctionBegin;
6089   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
6090   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
6091   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
6092   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
6093   if (nroots >= 0) {
6094     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
6095     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
6096     if (nroots > pEnd-pStart) {
6097       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
6098     } else {
6099       tmpOff = &(*gsection)->atlasDof[-pStart];
6100     }
6101   }
6102   /* Mark ghost points with negative dof */
6103   for (p = pStart; p < pEnd; ++p) {
6104     PetscInt value;
6105 
6106     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6107     if (value != labelValue) continue;
6108     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6109     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6110     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6111     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6112     if (neg) neg[p] = -(dof+1);
6113   }
6114   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6115   if (nroots >= 0) {
6116     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6117     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6118     if (nroots > pEnd-pStart) {
6119       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6120     }
6121   }
6122   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6123   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6124     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6125     (*gsection)->atlasOff[p] = off;
6126     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6127   }
6128   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
6129   globalOff -= off;
6130   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6131     (*gsection)->atlasOff[p] += globalOff;
6132     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6133   }
6134   /* Put in negative offsets for ghost points */
6135   if (nroots >= 0) {
6136     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6137     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6138     if (nroots > pEnd-pStart) {
6139       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6140     }
6141   }
6142   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6143   ierr = PetscFree(neg);CHKERRQ(ierr);
6144   PetscFunctionReturn(0);
6145 }
6146 
6147 #undef __FUNCT__
6148 #define __FUNCT__ "DMPlexCheckSymmetry"
6149 /*@
6150   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6151 
6152   Input Parameters:
6153   + dm - The DMPlex object
6154 
6155   Note: This is a useful diagnostic when creating meshes programmatically.
6156 
6157   Level: developer
6158 
6159 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6160 @*/
6161 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6162 {
6163   PetscSection    coneSection, supportSection;
6164   const PetscInt *cone, *support;
6165   PetscInt        coneSize, c, supportSize, s;
6166   PetscInt        pStart, pEnd, p, csize, ssize;
6167   PetscErrorCode  ierr;
6168 
6169   PetscFunctionBegin;
6170   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6171   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6172   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6173   /* Check that point p is found in the support of its cone points, and vice versa */
6174   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6175   for (p = pStart; p < pEnd; ++p) {
6176     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6177     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6178     for (c = 0; c < coneSize; ++c) {
6179       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6180       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6181       for (s = 0; s < supportSize; ++s) {
6182         if (support[s] == p) break;
6183       }
6184       if (s >= supportSize) {
6185         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6186         for (s = 0; s < coneSize; ++s) {
6187           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6188         }
6189         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6190         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6191         for (s = 0; s < supportSize; ++s) {
6192           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6193         }
6194         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6195         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6196       }
6197     }
6198     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6199     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6200     for (s = 0; s < supportSize; ++s) {
6201       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6202       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6203       for (c = 0; c < coneSize; ++c) {
6204         if (cone[c] == p) break;
6205       }
6206       if (c >= coneSize) {
6207         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6208         for (c = 0; c < supportSize; ++c) {
6209           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6210         }
6211         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6212         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6213         for (c = 0; c < coneSize; ++c) {
6214           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6215         }
6216         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6217         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6218       }
6219     }
6220   }
6221   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6222   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6223   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6224   PetscFunctionReturn(0);
6225 }
6226 
6227 #undef __FUNCT__
6228 #define __FUNCT__ "DMPlexCheckSkeleton"
6229 /*@
6230   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6231 
6232   Input Parameters:
6233 + dm - The DMPlex object
6234 . isSimplex - Are the cells simplices or tensor products
6235 - cellHeight - Normally 0
6236 
6237   Note: This is a useful diagnostic when creating meshes programmatically.
6238 
6239   Level: developer
6240 
6241 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6242 @*/
6243 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6244 {
6245   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6246   PetscErrorCode ierr;
6247 
6248   PetscFunctionBegin;
6249   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6250   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6251   switch (dim) {
6252   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6253   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6254   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6255   default:
6256     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6257   }
6258   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6259   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6260   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6261   cMax = cMax >= 0 ? cMax : cEnd;
6262   for (c = cStart; c < cMax; ++c) {
6263     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6264 
6265     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6266     for (cl = 0; cl < closureSize*2; cl += 2) {
6267       const PetscInt p = closure[cl];
6268       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6269     }
6270     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6271     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6272   }
6273   for (c = cMax; c < cEnd; ++c) {
6274     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6275 
6276     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6277     for (cl = 0; cl < closureSize*2; cl += 2) {
6278       const PetscInt p = closure[cl];
6279       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6280     }
6281     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6282     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
6283   }
6284   PetscFunctionReturn(0);
6285 }
6286 
6287 #undef __FUNCT__
6288 #define __FUNCT__ "DMPlexCheckFaces"
6289 /*@
6290   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6291 
6292   Input Parameters:
6293 + dm - The DMPlex object
6294 . isSimplex - Are the cells simplices or tensor products
6295 - cellHeight - Normally 0
6296 
6297   Note: This is a useful diagnostic when creating meshes programmatically.
6298 
6299   Level: developer
6300 
6301 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6302 @*/
6303 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6304 {
6305   PetscInt       pMax[4];
6306   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6307   PetscErrorCode ierr;
6308 
6309   PetscFunctionBegin;
6310   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6311   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6312   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6313   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6314   for (h = cellHeight; h < dim; ++h) {
6315     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6316     for (c = cStart; c < cEnd; ++c) {
6317       const PetscInt *cone, *ornt, *faces;
6318       PetscInt        numFaces, faceSize, coneSize,f;
6319       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6320 
6321       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6322       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6323       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6324       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6325       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6326       for (cl = 0; cl < closureSize*2; cl += 2) {
6327         const PetscInt p = closure[cl];
6328         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6329       }
6330       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6331       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
6332       for (f = 0; f < numFaces; ++f) {
6333         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6334 
6335         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6336         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6337           const PetscInt p = fclosure[cl];
6338           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6339         }
6340         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);
6341         for (v = 0; v < fnumCorners; ++v) {
6342           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]);
6343         }
6344         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6345       }
6346       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6347       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6348     }
6349   }
6350   PetscFunctionReturn(0);
6351 }
6352