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