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