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