xref: /petsc/src/dm/impls/plex/plex.c (revision b90c6cbe8a28dbbfeb8633979a88a1769a41a59e)
1 #include <petsc-private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <../src/sys/utils/hash.h>
3 #include <petsc-private/vecimpl.h>
4 #include <petsc-private/isimpl.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     }
340   }
341   PetscFunctionReturn(0);
342 }
343 
344 #undef __FUNCT__
345 #define __FUNCT__ "DMView_Plex"
346 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
347 {
348   PetscBool      iascii, isbinary;
349   PetscErrorCode ierr;
350 
351   PetscFunctionBegin;
352   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
353   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
354   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
355   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
356   if (iascii) {
357     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
358 #if 0
359   } else if (isbinary) {
360     ierr = DMPlexView_Binary(dm, viewer);CHKERRQ(ierr);
361 #endif
362   }
363   PetscFunctionReturn(0);
364 }
365 
366 #undef __FUNCT__
367 #define __FUNCT__ "DMDestroy_Plex"
368 PetscErrorCode DMDestroy_Plex(DM dm)
369 {
370   DM_Plex       *mesh = (DM_Plex*) dm->data;
371   DMLabel        next  = mesh->labels;
372   PetscErrorCode ierr;
373 
374   PetscFunctionBegin;
375   if (--mesh->refct > 0) PetscFunctionReturn(0);
376   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
377   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
378   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
379   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
380   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
381   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
382   while (next) {
383     DMLabel tmp = next->next;
384 
385     ierr = DMLabelDestroy(&next);CHKERRQ(ierr);
386     next = tmp;
387   }
388   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
389   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
390   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
391   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
392   ierr = PetscFree(mesh);CHKERRQ(ierr);
393   PetscFunctionReturn(0);
394 }
395 
396 #undef __FUNCT__
397 #define __FUNCT__ "DMPlexGetAdjacencySingleLevel_Private"
398 PetscErrorCode DMPlexGetAdjacencySingleLevel_Private(DM dm, PetscInt p, PetscBool useClosure, const PetscInt *tmpClosure, PetscInt *adjSize, PetscInt adj[])
399 {
400   const PetscInt *support = NULL;
401   PetscInt        numAdj   = 0, maxAdjSize = *adjSize, supportSize, s;
402   PetscErrorCode  ierr;
403 
404   PetscFunctionBegin;
405   if (useClosure) {
406     ierr = DMPlexGetConeSize(dm, p, &supportSize);CHKERRQ(ierr);
407     ierr = DMPlexGetCone(dm, p, &support);CHKERRQ(ierr);
408     for (s = 0; s < supportSize; ++s) {
409       const PetscInt *cone = NULL;
410       PetscInt        coneSize, c, q;
411 
412       ierr = DMPlexGetSupportSize(dm, support[s], &coneSize);CHKERRQ(ierr);
413       ierr = DMPlexGetSupport(dm, support[s], &cone);CHKERRQ(ierr);
414       for (c = 0; c < coneSize; ++c) {
415         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
416           if (cone[c] == adj[q]) break;
417         }
418         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
419       }
420     }
421   } else {
422     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
423     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
424     for (s = 0; s < supportSize; ++s) {
425       const PetscInt *cone = NULL;
426       PetscInt        coneSize, c, q;
427 
428       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
429       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
430       for (c = 0; c < coneSize; ++c) {
431         for (q = 0; q < numAdj || (adj[numAdj++] = cone[c],0); ++q) {
432           if (cone[c] == adj[q]) break;
433         }
434         if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
435       }
436     }
437   }
438   *adjSize = numAdj;
439   PetscFunctionReturn(0);
440 }
441 
442 #undef __FUNCT__
443 #define __FUNCT__ "DMPlexGetAdjacency_Private"
444 PetscErrorCode DMPlexGetAdjacency_Private(DM dm, PetscInt p, PetscBool useClosure, const PetscInt *tmpClosure, PetscInt *adjSize, PetscInt adj[])
445 {
446   const PetscInt *star  = tmpClosure;
447   PetscInt        numAdj = 0, maxAdjSize = *adjSize, starSize, s;
448   PetscErrorCode  ierr;
449 
450   PetscFunctionBegin;
451   ierr = DMPlexGetTransitiveClosure(dm, p, useClosure, &starSize, (PetscInt**) &star);CHKERRQ(ierr);
452   for (s = 2; s < starSize*2; s += 2) {
453     const PetscInt *closure = NULL;
454     PetscInt        closureSize, c, q;
455 
456     ierr = DMPlexGetTransitiveClosure(dm, star[s], (PetscBool)!useClosure, &closureSize, (PetscInt**) &closure);CHKERRQ(ierr);
457     for (c = 0; c < closureSize*2; c += 2) {
458       for (q = 0; q < numAdj || (adj[numAdj++] = closure[c],0); ++q) {
459         if (closure[c] == adj[q]) break;
460       }
461       if (numAdj > maxAdjSize) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid mesh exceeded adjacency allocation (%D)", maxAdjSize);
462     }
463     ierr = DMPlexRestoreTransitiveClosure(dm, star[s], (PetscBool)!useClosure, &closureSize, (PetscInt**) &closure);CHKERRQ(ierr);
464   }
465   *adjSize = numAdj;
466   PetscFunctionReturn(0);
467 }
468 
469 #undef __FUNCT__
470 #define __FUNCT__ "DMPlexSetPreallocationCenterDimension"
471 PetscErrorCode DMPlexSetPreallocationCenterDimension(DM dm, PetscInt preallocCenterDim)
472 {
473   DM_Plex *mesh = (DM_Plex*) dm->data;
474 
475   PetscFunctionBegin;
476   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
477   mesh->preallocCenterDim = preallocCenterDim;
478   PetscFunctionReturn(0);
479 }
480 
481 #undef __FUNCT__
482 #define __FUNCT__ "DMPlexPreallocateOperator"
483 PetscErrorCode DMPlexPreallocateOperator(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix)
484 {
485   DM_Plex           *mesh = (DM_Plex*) dm->data;
486   MPI_Comm           comm;
487   PetscSF            sf, sfDof, sfAdj;
488   PetscSection       leafSectionAdj, rootSectionAdj, sectionAdj;
489   PetscInt           nleaves, l, p;
490   const PetscInt    *leaves;
491   const PetscSFNode *remotes;
492   PetscInt           dim, pStart, pEnd, numDof, globalOffStart, globalOffEnd, numCols;
493   PetscInt          *tmpClosure, *tmpAdj, *adj, *rootAdj, *cols, *remoteOffsets;
494   PetscInt           depth, maxConeSize, maxSupportSize, maxClosureSize, maxAdjSize, adjSize;
495   PetscLayout        rLayout;
496   PetscInt           locRows, rStart, rEnd, r;
497   PetscMPIInt        size;
498   PetscBool          useClosure, debug = PETSC_FALSE;
499   PetscErrorCode     ierr;
500 
501   PetscFunctionBegin;
502   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
503   ierr = PetscOptionsGetBool(NULL, "-dm_view_preallocation", &debug, NULL);CHKERRQ(ierr);
504   ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
505   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
506   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
507   /* Create dof SF based on point SF */
508   if (debug) {
509     ierr = PetscPrintf(comm, "Input Section for Preallocation:\n");CHKERRQ(ierr);
510     ierr = PetscSectionView(section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
511     ierr = PetscPrintf(comm, "Input Global Section for Preallocation:\n");CHKERRQ(ierr);
512     ierr = PetscSectionView(sectionGlobal, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
513     ierr = PetscPrintf(comm, "Input SF for Preallocation:\n");CHKERRQ(ierr);
514     ierr = PetscSFView(sf, NULL);CHKERRQ(ierr);
515   }
516   ierr = PetscSFCreateRemoteOffsets(sf, section, section, &remoteOffsets);CHKERRQ(ierr);
517   ierr = PetscSFCreateSectionSF(sf, section, remoteOffsets, section, &sfDof);CHKERRQ(ierr);
518   if (debug) {
519     ierr = PetscPrintf(comm, "Dof SF for Preallocation:\n");CHKERRQ(ierr);
520     ierr = PetscSFView(sfDof, NULL);CHKERRQ(ierr);
521   }
522   /* Create section for dof adjacency (dof ==> # adj dof) */
523   /*   FEM:   Two points p and q are adjacent if q \in closure(star(p)), preallocCenterDim = dim   */
524   /*   FVM:   Two points p and q are adjacent if q \in star(cone(p)),    preallocCenterDim = dim-1 */
525   /*   FVM++: Two points p and q are adjacent if q \in star(closure(p)), preallocCenterDim = 0     */
526   if (mesh->preallocCenterDim == dim) {
527     useClosure = PETSC_FALSE;
528   } else if (mesh->preallocCenterDim == 0) {
529     useClosure = PETSC_TRUE;
530   } else SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Do not support preallocation with center points of dimension %d", mesh->preallocCenterDim);
531 
532   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
533   ierr = PetscSectionGetStorageSize(section, &numDof);CHKERRQ(ierr);
534   ierr = PetscSectionCreate(comm, &leafSectionAdj);CHKERRQ(ierr);
535   ierr = PetscSectionSetChart(leafSectionAdj, 0, numDof);CHKERRQ(ierr);
536   ierr = PetscSectionCreate(comm, &rootSectionAdj);CHKERRQ(ierr);
537   ierr = PetscSectionSetChart(rootSectionAdj, 0, numDof);CHKERRQ(ierr);
538   /*   Fill in the ghost dofs on the interface */
539   ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, &remotes);CHKERRQ(ierr);
540   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
541   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
542 
543   maxClosureSize = 2*PetscMax(PetscPowInt(mesh->maxConeSize,depth),PetscPowInt(mesh->maxSupportSize,depth)) + 2;
544   maxAdjSize     = PetscPowInt(mesh->maxConeSize,depth) * PetscPowInt(mesh->maxSupportSize,depth) + 1;
545 
546   ierr = PetscMalloc2(maxClosureSize,PetscInt,&tmpClosure,maxAdjSize,PetscInt,&tmpAdj);CHKERRQ(ierr);
547 
548   /*
549    ** The bootstrapping process involves six rounds with similar structure of visiting neighbors of each point.
550     1. Visit unowned points on interface, count adjacencies placing in leafSectionAdj
551        Reduce those counts to rootSectionAdj (now redundantly counting some interface points)
552     2. Visit owned points on interface, count adjacencies placing in rootSectionAdj
553        Create sfAdj connecting rootSectionAdj and leafSectionAdj
554     3. Visit unowned points on interface, write adjacencies to adj
555        Gather adj to rootAdj (note that there is redundancy in rootAdj when multiple procs find the same adjacencies)
556     4. Visit owned points on interface, write adjacencies to rootAdj
557        Remove redundancy in rootAdj
558    ** The last two traversals use transitive closure
559     5. Visit all owned points in the subdomain, count dofs for each point (sectionAdj)
560        Allocate memory addressed by sectionAdj (cols)
561     6. Visit all owned points in the subdomain, insert dof adjacencies into cols
562    ** Knowing all the column adjacencies, check ownership and sum into dnz and onz
563   */
564 
565   for (l = 0; l < nleaves; ++l) {
566     PetscInt dof, off, d, q;
567     PetscInt p = leaves[l], numAdj = maxAdjSize;
568 
569     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
570     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
571     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
572     for (q = 0; q < numAdj; ++q) {
573       const PetscInt padj = tmpAdj[q];
574       PetscInt ndof, ncdof;
575 
576       if ((padj < pStart) || (padj >= pEnd)) continue;
577       ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
578       ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
579       for (d = off; d < off+dof; ++d) {
580         ierr = PetscSectionAddDof(leafSectionAdj, d, ndof-ncdof);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr);
585   if (debug) {
586     ierr = PetscPrintf(comm, "Adjacency Section for Preallocation on Leaves:\n");CHKERRQ(ierr);
587     ierr = PetscSectionView(leafSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
588   }
589   /* Get maximum remote adjacency sizes for owned dofs on interface (roots) */
590   if (size > 1) {
591     ierr = PetscSFReduceBegin(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr);
592     ierr = PetscSFReduceEnd(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr);
593   }
594   if (debug) {
595     ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots:\n");CHKERRQ(ierr);
596     ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
597   }
598   /* Add in local adjacency sizes for owned dofs on interface (roots) */
599   for (p = pStart; p < pEnd; ++p) {
600     PetscInt numAdj = maxAdjSize, adof, dof, off, d, q;
601 
602     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
603     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
604     if (!dof) continue;
605     ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr);
606     if (adof <= 0) continue;
607     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
608     for (q = 0; q < numAdj; ++q) {
609       const PetscInt padj = tmpAdj[q];
610       PetscInt ndof, ncdof;
611 
612       if ((padj < pStart) || (padj >= pEnd)) continue;
613       ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
614       ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
615       for (d = off; d < off+dof; ++d) {
616         ierr = PetscSectionAddDof(rootSectionAdj, d, ndof-ncdof);CHKERRQ(ierr);
617       }
618     }
619   }
620   ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr);
621   if (debug) {
622     ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after local additions:\n");CHKERRQ(ierr);
623     ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
624   }
625   /* Create adj SF based on dof SF */
626   ierr = PetscSFCreateRemoteOffsets(sfDof, rootSectionAdj, leafSectionAdj, &remoteOffsets);CHKERRQ(ierr);
627   ierr = PetscSFCreateSectionSF(sfDof, rootSectionAdj, remoteOffsets, leafSectionAdj, &sfAdj);CHKERRQ(ierr);
628   if (debug) {
629     ierr = PetscPrintf(comm, "Adjacency SF for Preallocation:\n");CHKERRQ(ierr);
630     ierr = PetscSFView(sfAdj, NULL);CHKERRQ(ierr);
631   }
632   ierr = PetscSFDestroy(&sfDof);CHKERRQ(ierr);
633   /* Create leaf adjacency */
634   ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr);
635   ierr = PetscSectionGetStorageSize(leafSectionAdj, &adjSize);CHKERRQ(ierr);
636   ierr = PetscMalloc(adjSize * sizeof(PetscInt), &adj);CHKERRQ(ierr);
637   ierr = PetscMemzero(adj, adjSize * sizeof(PetscInt));CHKERRQ(ierr);
638   for (l = 0; l < nleaves; ++l) {
639     PetscInt dof, off, d, q;
640     PetscInt p = leaves[l], numAdj = maxAdjSize;
641 
642     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
643     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
644     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
645     for (d = off; d < off+dof; ++d) {
646       PetscInt aoff, i = 0;
647 
648       ierr = PetscSectionGetOffset(leafSectionAdj, d, &aoff);CHKERRQ(ierr);
649       for (q = 0; q < numAdj; ++q) {
650         const PetscInt padj = tmpAdj[q];
651         PetscInt ndof, ncdof, ngoff, nd;
652 
653         if ((padj < pStart) || (padj >= pEnd)) continue;
654         ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
655         ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
656         ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr);
657         for (nd = 0; nd < ndof-ncdof; ++nd) {
658           adj[aoff+i] = (ngoff < 0 ? -(ngoff+1) : ngoff) + nd;
659           ++i;
660         }
661       }
662     }
663   }
664   /* Debugging */
665   if (debug) {
666     IS tmp;
667     ierr = PetscPrintf(comm, "Leaf adjacency indices\n");CHKERRQ(ierr);
668     ierr = ISCreateGeneral(comm, adjSize, adj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr);
669     ierr = ISView(tmp, NULL);CHKERRQ(ierr);
670   }
671   /* Gather adjacenct indices to root */
672   ierr = PetscSectionGetStorageSize(rootSectionAdj, &adjSize);CHKERRQ(ierr);
673   ierr = PetscMalloc(adjSize * sizeof(PetscInt), &rootAdj);CHKERRQ(ierr);
674   for (r = 0; r < adjSize; ++r) rootAdj[r] = -1;
675   if (size > 1) {
676     ierr = PetscSFGatherBegin(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr);
677     ierr = PetscSFGatherEnd(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr);
678   }
679   ierr = PetscSFDestroy(&sfAdj);CHKERRQ(ierr);
680   ierr = PetscFree(adj);CHKERRQ(ierr);
681   /* Debugging */
682   if (debug) {
683     IS tmp;
684     ierr = PetscPrintf(comm, "Root adjacency indices after gather\n");CHKERRQ(ierr);
685     ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr);
686     ierr = ISView(tmp, NULL);CHKERRQ(ierr);
687   }
688   /* Add in local adjacency indices for owned dofs on interface (roots) */
689   for (p = pStart; p < pEnd; ++p) {
690     PetscInt numAdj = maxAdjSize, adof, dof, off, d, q;
691 
692     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
693     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
694     if (!dof) continue;
695     ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr);
696     if (adof <= 0) continue;
697     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
698     for (d = off; d < off+dof; ++d) {
699       PetscInt adof, aoff, i;
700 
701       ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr);
702       ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr);
703       i    = adof-1;
704       for (q = 0; q < numAdj; ++q) {
705         const PetscInt padj = tmpAdj[q];
706         PetscInt ndof, ncdof, ngoff, nd;
707 
708         if ((padj < pStart) || (padj >= pEnd)) continue;
709         ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
710         ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
711         ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr);
712         for (nd = 0; nd < ndof-ncdof; ++nd) {
713           rootAdj[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd;
714           --i;
715         }
716       }
717     }
718   }
719   /* Debugging */
720   if (debug) {
721     IS tmp;
722     ierr = PetscPrintf(comm, "Root adjacency indices\n");CHKERRQ(ierr);
723     ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr);
724     ierr = ISView(tmp, NULL);CHKERRQ(ierr);
725   }
726   /* Compress indices */
727   ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr);
728   for (p = pStart; p < pEnd; ++p) {
729     PetscInt dof, cdof, off, d;
730     PetscInt adof, aoff;
731 
732     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
733     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
734     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
735     if (!dof) continue;
736     ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr);
737     if (adof <= 0) continue;
738     for (d = off; d < off+dof-cdof; ++d) {
739       ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr);
740       ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr);
741       ierr = PetscSortRemoveDupsInt(&adof, &rootAdj[aoff]);CHKERRQ(ierr);
742       ierr = PetscSectionSetDof(rootSectionAdj, d, adof);CHKERRQ(ierr);
743     }
744   }
745   /* Debugging */
746   if (debug) {
747     IS tmp;
748     ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after compression:\n");CHKERRQ(ierr);
749     ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
750     ierr = PetscPrintf(comm, "Root adjacency indices after compression\n");CHKERRQ(ierr);
751     ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr);
752     ierr = ISView(tmp, NULL);CHKERRQ(ierr);
753   }
754   /* Build adjacency section: Maps global indices to sets of adjacent global indices */
755   ierr = PetscSectionGetOffsetRange(sectionGlobal, &globalOffStart, &globalOffEnd);CHKERRQ(ierr);
756   ierr = PetscSectionCreate(comm, &sectionAdj);CHKERRQ(ierr);
757   ierr = PetscSectionSetChart(sectionAdj, globalOffStart, globalOffEnd);CHKERRQ(ierr);
758   for (p = pStart; p < pEnd; ++p) {
759     PetscInt  numAdj = maxAdjSize, dof, cdof, off, goff, d, q;
760     PetscBool found  = PETSC_TRUE;
761 
762     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
763     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
764     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
765     ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
766     for (d = 0; d < dof-cdof; ++d) {
767       PetscInt ldof, rdof;
768 
769       ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr);
770       ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr);
771       if (ldof > 0) {
772         /* We do not own this point */
773       } else if (rdof > 0) {
774         ierr = PetscSectionSetDof(sectionAdj, goff+d, rdof);CHKERRQ(ierr);
775       } else {
776         found = PETSC_FALSE;
777       }
778     }
779     if (found) continue;
780     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
781     ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
782     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
783     for (q = 0; q < numAdj; ++q) {
784       const PetscInt padj = tmpAdj[q];
785       PetscInt ndof, ncdof, noff;
786 
787       if ((padj < pStart) || (padj >= pEnd)) continue;
788       ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
789       ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
790       ierr = PetscSectionGetOffset(section, padj, &noff);CHKERRQ(ierr);
791       for (d = goff; d < goff+dof-cdof; ++d) {
792         ierr = PetscSectionAddDof(sectionAdj, d, ndof-ncdof);CHKERRQ(ierr);
793       }
794     }
795   }
796   ierr = PetscSectionSetUp(sectionAdj);CHKERRQ(ierr);
797   if (debug) {
798     ierr = PetscPrintf(comm, "Adjacency Section for Preallocation:\n");CHKERRQ(ierr);
799     ierr = PetscSectionView(sectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
800   }
801   /* Get adjacent indices */
802   ierr = PetscSectionGetStorageSize(sectionAdj, &numCols);CHKERRQ(ierr);
803   ierr = PetscMalloc(numCols * sizeof(PetscInt), &cols);CHKERRQ(ierr);
804   for (p = pStart; p < pEnd; ++p) {
805     PetscInt  numAdj = maxAdjSize, dof, cdof, off, goff, d, q;
806     PetscBool found  = PETSC_TRUE;
807 
808     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
809     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
810     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
811     ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
812     for (d = 0; d < dof-cdof; ++d) {
813       PetscInt ldof, rdof;
814 
815       ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr);
816       ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr);
817       if (ldof > 0) {
818         /* We do not own this point */
819       } else if (rdof > 0) {
820         PetscInt aoff, roff;
821 
822         ierr = PetscSectionGetOffset(sectionAdj, goff+d, &aoff);CHKERRQ(ierr);
823         ierr = PetscSectionGetOffset(rootSectionAdj, off+d, &roff);CHKERRQ(ierr);
824         ierr = PetscMemcpy(&cols[aoff], &rootAdj[roff], rdof * sizeof(PetscInt));CHKERRQ(ierr);
825       } else {
826         found = PETSC_FALSE;
827       }
828     }
829     if (found) continue;
830     ierr = DMPlexGetAdjacency_Private(dm, p, useClosure, tmpClosure, &numAdj, tmpAdj);CHKERRQ(ierr);
831     for (d = goff; d < goff+dof-cdof; ++d) {
832       PetscInt adof, aoff, i = 0;
833 
834       ierr = PetscSectionGetDof(sectionAdj, d, &adof);CHKERRQ(ierr);
835       ierr = PetscSectionGetOffset(sectionAdj, d, &aoff);CHKERRQ(ierr);
836       for (q = 0; q < numAdj; ++q) {
837         const PetscInt  padj = tmpAdj[q];
838         PetscInt        ndof, ncdof, ngoff, nd;
839         const PetscInt *ncind;
840 
841         /* Adjacent points may not be in the section chart */
842         if ((padj < pStart) || (padj >= pEnd)) continue;
843         ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr);
844         ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr);
845         ierr = PetscSectionGetConstraintIndices(section, padj, &ncind);CHKERRQ(ierr);
846         ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr);
847         for (nd = 0; nd < ndof-ncdof; ++nd, ++i) {
848           cols[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd;
849         }
850       }
851       if (i != adof) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of entries %D != %D for dof %D (point %D)", i, adof, d, p);
852     }
853   }
854   ierr = PetscSectionDestroy(&leafSectionAdj);CHKERRQ(ierr);
855   ierr = PetscSectionDestroy(&rootSectionAdj);CHKERRQ(ierr);
856   ierr = PetscFree(rootAdj);CHKERRQ(ierr);
857   ierr = PetscFree2(tmpClosure, tmpAdj);CHKERRQ(ierr);
858   /* Debugging */
859   if (debug) {
860     IS tmp;
861     ierr = PetscPrintf(comm, "Column indices\n");CHKERRQ(ierr);
862     ierr = ISCreateGeneral(comm, numCols, cols, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr);
863     ierr = ISView(tmp, NULL);CHKERRQ(ierr);
864   }
865   /* Create allocation vectors from adjacency graph */
866   ierr = MatGetLocalSize(A, &locRows, NULL);CHKERRQ(ierr);
867   ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)A), &rLayout);CHKERRQ(ierr);
868   ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
869   ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
870   ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
871   ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
872   ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
873   /* Only loop over blocks of rows */
874   if (rStart%bs || rEnd%bs) SETERRQ3(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Invalid layout [%d, %d) for matrix, must be divisible by block size %d", rStart, rEnd, bs);
875   for (r = rStart/bs; r < rEnd/bs; ++r) {
876     const PetscInt row = r*bs;
877     PetscInt       numCols, cStart, c;
878 
879     ierr = PetscSectionGetDof(sectionAdj, row, &numCols);CHKERRQ(ierr);
880     ierr = PetscSectionGetOffset(sectionAdj, row, &cStart);CHKERRQ(ierr);
881     for (c = cStart; c < cStart+numCols; ++c) {
882       if ((cols[c] >= rStart*bs) && (cols[c] < rEnd*bs)) {
883         ++dnz[r-rStart];
884         if (cols[c] >= row) ++dnzu[r-rStart];
885       } else {
886         ++onz[r-rStart];
887         if (cols[c] >= row) ++onzu[r-rStart];
888       }
889     }
890   }
891   if (bs > 1) {
892     for (r = 0; r < locRows/bs; ++r) {
893       dnz[r]  /= bs;
894       onz[r]  /= bs;
895       dnzu[r] /= bs;
896       onzu[r] /= bs;
897     }
898   }
899   /* Set matrix pattern */
900   ierr = MatXAIJSetPreallocation(A, bs, dnz, onz, dnzu, onzu);CHKERRQ(ierr);
901   ierr = MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
902   /* Fill matrix with zeros */
903   if (fillMatrix) {
904     PetscScalar *values;
905     PetscInt     maxRowLen = 0;
906 
907     for (r = rStart; r < rEnd; ++r) {
908       PetscInt len;
909 
910       ierr      = PetscSectionGetDof(sectionAdj, r, &len);CHKERRQ(ierr);
911       maxRowLen = PetscMax(maxRowLen, len);
912     }
913     ierr = PetscMalloc(maxRowLen * sizeof(PetscScalar), &values);CHKERRQ(ierr);
914     ierr = PetscMemzero(values, maxRowLen * sizeof(PetscScalar));CHKERRQ(ierr);
915     for (r = rStart; r < rEnd; ++r) {
916       PetscInt numCols, cStart;
917 
918       ierr = PetscSectionGetDof(sectionAdj, r, &numCols);CHKERRQ(ierr);
919       ierr = PetscSectionGetOffset(sectionAdj, r, &cStart);CHKERRQ(ierr);
920       ierr = MatSetValues(A, 1, &r, numCols, &cols[cStart], values, INSERT_VALUES);CHKERRQ(ierr);
921     }
922     ierr = PetscFree(values);CHKERRQ(ierr);
923     ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
924     ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
925   }
926   ierr = PetscSectionDestroy(&sectionAdj);CHKERRQ(ierr);
927   ierr = PetscFree(cols);CHKERRQ(ierr);
928   PetscFunctionReturn(0);
929 }
930 
931 #if 0
932 #undef __FUNCT__
933 #define __FUNCT__ "DMPlexPreallocateOperator_2"
934 PetscErrorCode DMPlexPreallocateOperator_2(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix)
935 {
936   PetscInt       *tmpClosure,*tmpAdj,*visits;
937   PetscInt        c,cStart,cEnd,pStart,pEnd;
938   PetscErrorCode  ierr;
939 
940   PetscFunctionBegin;
941   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
942   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
943   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
944 
945   maxClosureSize = 2*PetscMax(PetscPowInt(mesh->maxConeSize,depth),PetscPowInt(mesh->maxSupportSize,depth));
946 
947   ierr    = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
948   npoints = pEnd - pStart;
949 
950   ierr = PetscMalloc3(maxClosureSize,PetscInt,&tmpClosure,npoints,PetscInt,&lvisits,npoints,PetscInt,&visits);CHKERRQ(ierr);
951   ierr = PetscMemzero(lvisits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr);
952   ierr = PetscMemzero(visits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr);
953   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
954   for (c=cStart; c<cEnd; c++) {
955     PetscInt *support = tmpClosure;
956     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_FALSE, &supportSize, (PetscInt**)&support);CHKERRQ(ierr);
957     for (p=0; p<supportSize; p++) lvisits[support[p]]++;
958   }
959   ierr = PetscSFReduceBegin(sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr);
960   ierr = PetscSFReduceEnd  (sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr);
961   ierr = PetscSFBcastBegin(sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr);
962   ierr = PetscSFBcastEnd  (sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr);
963 
964   ierr = PetscSFGetRanks();CHKERRQ(ierr);
965 
966 
967   ierr = PetscMalloc2(maxClosureSize*maxClosureSize,PetscInt,&cellmat,npoints,PetscInt,&owner);CHKERRQ(ierr);
968   for (c=cStart; c<cEnd; c++) {
969     ierr = PetscMemzero(cellmat,maxClosureSize*maxClosureSize*sizeof(PetscInt));CHKERRQ(ierr);
970     /*
971      Depth-first walk of transitive closure.
972      At each leaf frame f of transitive closure that we see, add 1/visits[f] to each pair (p,q) not marked as done in cellmat.
973      This contribution is added to dnz if owning ranks of p and q match, to onz otherwise.
974      */
975   }
976 
977   ierr = PetscSFReduceBegin(sf,MPIU_INT,ldnz,dnz,MPI_SUM);CHKERRQ(ierr);
978   ierr = PetscSFReduceEnd  (sf,MPIU_INT,lonz,onz,MPI_SUM);CHKERRQ(ierr);
979   PetscFunctionReturn(0);
980 }
981 #endif
982 
983 #undef __FUNCT__
984 #define __FUNCT__ "DMCreateMatrix_Plex"
985 PetscErrorCode DMCreateMatrix_Plex(DM dm, MatType mtype, Mat *J)
986 {
987   PetscSection   section, sectionGlobal;
988   PetscInt       bs = -1;
989   PetscInt       localSize;
990   PetscBool      isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock, isSymmetric;
991   PetscErrorCode ierr;
992 
993   PetscFunctionBegin;
994 #if !defined(PETSC_USE_DYNAMIC_LIBRARIES)
995   ierr = MatInitializePackage(NULL);CHKERRQ(ierr);
996 #endif
997   if (!mtype) mtype = MATAIJ;
998   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
999   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
1000   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
1001   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
1002   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
1003   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
1004   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
1005   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
1006   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
1007   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
1008   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
1009   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
1010   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
1011   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
1012   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
1013   /* Check for symmetric storage */
1014   isSymmetric = (PetscBool) (isSymBlock || isSymSeqBlock || isSymMPIBlock);
1015   if (isSymmetric) {
1016     ierr = MatSetOption(*J, MAT_IGNORE_LOWER_TRIANGULAR, PETSC_TRUE);CHKERRQ(ierr);
1017   }
1018   if (!isShell) {
1019     PetscBool fillMatrix = (PetscBool) !dm->prealloc_only;
1020     PetscInt *dnz, *onz, *dnzu, *onzu, bsLocal, bsMax, bsMin;
1021 
1022     if (bs < 0) {
1023       if (isBlock || isSeqBlock || isMPIBlock || isSymBlock || isSymSeqBlock || isSymMPIBlock) {
1024         PetscInt pStart, pEnd, p, dof, cdof;
1025 
1026         ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
1027         for (p = pStart; p < pEnd; ++p) {
1028           ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
1029           ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
1030           if (dof-cdof) {
1031             if (bs < 0) {
1032               bs = dof-cdof;
1033             } else if (bs != dof-cdof) {
1034               /* Layout does not admit a pointwise block size */
1035               bs = 1;
1036               break;
1037             }
1038           }
1039         }
1040         /* Must have same blocksize on all procs (some might have no points) */
1041         bsLocal = bs;
1042         ierr = MPI_Allreduce(&bsLocal, &bsMax, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1043         bsLocal = bs < 0 ? bsMax : bs;
1044         ierr = MPI_Allreduce(&bsLocal, &bsMin, 1, MPIU_INT, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1045         if (bsMin != bsMax) {
1046           bs = 1;
1047         } else {
1048           bs = bsMax;
1049         }
1050       } else {
1051         bs = 1;
1052       }
1053     }
1054     ierr = PetscMalloc4(localSize/bs, PetscInt, &dnz, localSize/bs, PetscInt, &onz, localSize/bs, PetscInt, &dnzu, localSize/bs, PetscInt, &onzu);CHKERRQ(ierr);
1055     ierr = PetscMemzero(dnz,  localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
1056     ierr = PetscMemzero(onz,  localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
1057     ierr = PetscMemzero(dnzu, localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
1058     ierr = PetscMemzero(onzu, localSize/bs * sizeof(PetscInt));CHKERRQ(ierr);
1059     ierr = DMPlexPreallocateOperator(dm, bs, section, sectionGlobal, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
1060     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
1061   }
1062   PetscFunctionReturn(0);
1063 }
1064 
1065 #undef __FUNCT__
1066 #define __FUNCT__ "DMPlexGetDimension"
1067 /*@
1068   DMPlexGetDimension - Return the topological mesh dimension
1069 
1070   Not collective
1071 
1072   Input Parameter:
1073 . mesh - The DMPlex
1074 
1075   Output Parameter:
1076 . dim - The topological mesh dimension
1077 
1078   Level: beginner
1079 
1080 .seealso: DMPlexCreate()
1081 @*/
1082 PetscErrorCode DMPlexGetDimension(DM dm, PetscInt *dim)
1083 {
1084   DM_Plex *mesh = (DM_Plex*) dm->data;
1085 
1086   PetscFunctionBegin;
1087   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1088   PetscValidPointer(dim, 2);
1089   *dim = mesh->dim;
1090   PetscFunctionReturn(0);
1091 }
1092 
1093 #undef __FUNCT__
1094 #define __FUNCT__ "DMPlexSetDimension"
1095 /*@
1096   DMPlexSetDimension - Set the topological mesh dimension
1097 
1098   Collective on mesh
1099 
1100   Input Parameters:
1101 + mesh - The DMPlex
1102 - dim - The topological mesh dimension
1103 
1104   Level: beginner
1105 
1106 .seealso: DMPlexCreate()
1107 @*/
1108 PetscErrorCode DMPlexSetDimension(DM dm, PetscInt dim)
1109 {
1110   DM_Plex *mesh = (DM_Plex*) dm->data;
1111 
1112   PetscFunctionBegin;
1113   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1114   PetscValidLogicalCollectiveInt(dm, dim, 2);
1115   mesh->dim               = dim;
1116   mesh->preallocCenterDim = dim;
1117   PetscFunctionReturn(0);
1118 }
1119 
1120 #undef __FUNCT__
1121 #define __FUNCT__ "DMPlexGetChart"
1122 /*@
1123   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
1124 
1125   Not collective
1126 
1127   Input Parameter:
1128 . mesh - The DMPlex
1129 
1130   Output Parameters:
1131 + pStart - The first mesh point
1132 - pEnd   - The upper bound for mesh points
1133 
1134   Level: beginner
1135 
1136 .seealso: DMPlexCreate(), DMPlexSetChart()
1137 @*/
1138 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
1139 {
1140   DM_Plex       *mesh = (DM_Plex*) dm->data;
1141   PetscErrorCode ierr;
1142 
1143   PetscFunctionBegin;
1144   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1145   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1146   PetscFunctionReturn(0);
1147 }
1148 
1149 #undef __FUNCT__
1150 #define __FUNCT__ "DMPlexSetChart"
1151 /*@
1152   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
1153 
1154   Not collective
1155 
1156   Input Parameters:
1157 + mesh - The DMPlex
1158 . pStart - The first mesh point
1159 - pEnd   - The upper bound for mesh points
1160 
1161   Output Parameters:
1162 
1163   Level: beginner
1164 
1165 .seealso: DMPlexCreate(), DMPlexGetChart()
1166 @*/
1167 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
1168 {
1169   DM_Plex       *mesh = (DM_Plex*) dm->data;
1170   PetscErrorCode ierr;
1171 
1172   PetscFunctionBegin;
1173   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1174   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1175   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
1176   PetscFunctionReturn(0);
1177 }
1178 
1179 #undef __FUNCT__
1180 #define __FUNCT__ "DMPlexGetConeSize"
1181 /*@
1182   DMPlexGetConeSize - Return the number of in-edges for this point in the Sieve DAG
1183 
1184   Not collective
1185 
1186   Input Parameters:
1187 + mesh - The DMPlex
1188 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1189 
1190   Output Parameter:
1191 . size - The cone size for point p
1192 
1193   Level: beginner
1194 
1195 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1196 @*/
1197 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
1198 {
1199   DM_Plex       *mesh = (DM_Plex*) dm->data;
1200   PetscErrorCode ierr;
1201 
1202   PetscFunctionBegin;
1203   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1204   PetscValidPointer(size, 3);
1205   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1206   PetscFunctionReturn(0);
1207 }
1208 
1209 #undef __FUNCT__
1210 #define __FUNCT__ "DMPlexSetConeSize"
1211 /*@
1212   DMPlexSetConeSize - Set the number of in-edges for this point in the Sieve DAG
1213 
1214   Not collective
1215 
1216   Input Parameters:
1217 + mesh - The DMPlex
1218 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1219 - size - The cone size for point p
1220 
1221   Output Parameter:
1222 
1223   Note:
1224   This should be called after DMPlexSetChart().
1225 
1226   Level: beginner
1227 
1228 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
1229 @*/
1230 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
1231 {
1232   DM_Plex       *mesh = (DM_Plex*) dm->data;
1233   PetscErrorCode ierr;
1234 
1235   PetscFunctionBegin;
1236   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1237   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1238 
1239   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
1240   PetscFunctionReturn(0);
1241 }
1242 
1243 #undef __FUNCT__
1244 #define __FUNCT__ "DMPlexGetCone"
1245 /*@C
1246   DMPlexGetCone - Return the points on the in-edges for this point in the Sieve DAG
1247 
1248   Not collective
1249 
1250   Input Parameters:
1251 + mesh - The DMPlex
1252 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1253 
1254   Output Parameter:
1255 . cone - An array of points which are on the in-edges for point p
1256 
1257   Level: beginner
1258 
1259   Fortran Notes:
1260   Since it returns an array, this routine is only available in Fortran 90, and you must
1261   include petsc.h90 in your code.
1262 
1263   You must also call DMPlexRestoreCone() after you finish using the returned array.
1264 
1265 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart()
1266 @*/
1267 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
1268 {
1269   DM_Plex       *mesh = (DM_Plex*) dm->data;
1270   PetscInt       off;
1271   PetscErrorCode ierr;
1272 
1273   PetscFunctionBegin;
1274   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1275   PetscValidPointer(cone, 3);
1276   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1277   *cone = &mesh->cones[off];
1278   PetscFunctionReturn(0);
1279 }
1280 
1281 #undef __FUNCT__
1282 #define __FUNCT__ "DMPlexSetCone"
1283 /*@
1284   DMPlexSetCone - Set the points on the in-edges for this point in the Sieve DAG
1285 
1286   Not collective
1287 
1288   Input Parameters:
1289 + mesh - The DMPlex
1290 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1291 - cone - An array of points which are on the in-edges for point p
1292 
1293   Output Parameter:
1294 
1295   Note:
1296   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1297 
1298   Level: beginner
1299 
1300 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1301 @*/
1302 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
1303 {
1304   DM_Plex       *mesh = (DM_Plex*) dm->data;
1305   PetscInt       pStart, pEnd;
1306   PetscInt       dof, off, c;
1307   PetscErrorCode ierr;
1308 
1309   PetscFunctionBegin;
1310   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1311   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1312   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1313   if (dof) PetscValidPointer(cone, 3);
1314   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1315   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);
1316   for (c = 0; c < dof; ++c) {
1317     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);
1318     mesh->cones[off+c] = cone[c];
1319   }
1320   PetscFunctionReturn(0);
1321 }
1322 
1323 #undef __FUNCT__
1324 #define __FUNCT__ "DMPlexGetConeOrientation"
1325 /*@C
1326   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the Sieve DAG
1327 
1328   Not collective
1329 
1330   Input Parameters:
1331 + mesh - The DMPlex
1332 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1333 
1334   Output Parameter:
1335 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1336                     integer giving the prescription for cone traversal. If it is negative, the cone is
1337                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1338                     the index of the cone point on which to start.
1339 
1340   Level: beginner
1341 
1342   Fortran Notes:
1343   Since it returns an array, this routine is only available in Fortran 90, and you must
1344   include petsc.h90 in your code.
1345 
1346   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
1347 
1348 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
1349 @*/
1350 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
1351 {
1352   DM_Plex       *mesh = (DM_Plex*) dm->data;
1353   PetscInt       off;
1354   PetscErrorCode ierr;
1355 
1356   PetscFunctionBegin;
1357   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1358 #if defined(PETSC_USE_DEBUG)
1359   {
1360     PetscInt dof;
1361     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1362     if (dof) PetscValidPointer(coneOrientation, 3);
1363   }
1364 #endif
1365   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1366 
1367   *coneOrientation = &mesh->coneOrientations[off];
1368   PetscFunctionReturn(0);
1369 }
1370 
1371 #undef __FUNCT__
1372 #define __FUNCT__ "DMPlexSetConeOrientation"
1373 /*@
1374   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the Sieve DAG
1375 
1376   Not collective
1377 
1378   Input Parameters:
1379 + mesh - The DMPlex
1380 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1381 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1382                     integer giving the prescription for cone traversal. If it is negative, the cone is
1383                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1384                     the index of the cone point on which to start.
1385 
1386   Output Parameter:
1387 
1388   Note:
1389   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1390 
1391   Level: beginner
1392 
1393 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1394 @*/
1395 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
1396 {
1397   DM_Plex       *mesh = (DM_Plex*) dm->data;
1398   PetscInt       pStart, pEnd;
1399   PetscInt       dof, off, c;
1400   PetscErrorCode ierr;
1401 
1402   PetscFunctionBegin;
1403   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1404   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1405   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1406   if (dof) PetscValidPointer(coneOrientation, 3);
1407   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1408   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);
1409   for (c = 0; c < dof; ++c) {
1410     PetscInt cdof, o = coneOrientation[c];
1411 
1412     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
1413     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);
1414     mesh->coneOrientations[off+c] = o;
1415   }
1416   PetscFunctionReturn(0);
1417 }
1418 
1419 #undef __FUNCT__
1420 #define __FUNCT__ "DMPlexInsertCone"
1421 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
1422 {
1423   DM_Plex       *mesh = (DM_Plex*) dm->data;
1424   PetscInt       pStart, pEnd;
1425   PetscInt       dof, off;
1426   PetscErrorCode ierr;
1427 
1428   PetscFunctionBegin;
1429   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1430   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1431   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);
1432   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);
1433   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1434   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1435   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);
1436   mesh->cones[off+conePos] = conePoint;
1437   PetscFunctionReturn(0);
1438 }
1439 
1440 #undef __FUNCT__
1441 #define __FUNCT__ "DMPlexInsertConeOrientation"
1442 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
1443 {
1444   DM_Plex       *mesh = (DM_Plex*) dm->data;
1445   PetscInt       pStart, pEnd;
1446   PetscInt       dof, off;
1447   PetscErrorCode ierr;
1448 
1449   PetscFunctionBegin;
1450   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1451   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1452   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);
1453   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1454   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1455   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);
1456   mesh->coneOrientations[off+conePos] = coneOrientation;
1457   PetscFunctionReturn(0);
1458 }
1459 
1460 #undef __FUNCT__
1461 #define __FUNCT__ "DMPlexGetSupportSize"
1462 /*@
1463   DMPlexGetSupportSize - Return the number of out-edges for this point in the Sieve DAG
1464 
1465   Not collective
1466 
1467   Input Parameters:
1468 + mesh - The DMPlex
1469 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1470 
1471   Output Parameter:
1472 . size - The support size for point p
1473 
1474   Level: beginner
1475 
1476 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
1477 @*/
1478 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
1479 {
1480   DM_Plex       *mesh = (DM_Plex*) dm->data;
1481   PetscErrorCode ierr;
1482 
1483   PetscFunctionBegin;
1484   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1485   PetscValidPointer(size, 3);
1486   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1487   PetscFunctionReturn(0);
1488 }
1489 
1490 #undef __FUNCT__
1491 #define __FUNCT__ "DMPlexSetSupportSize"
1492 /*@
1493   DMPlexSetSupportSize - Set the number of out-edges for this point in the Sieve DAG
1494 
1495   Not collective
1496 
1497   Input Parameters:
1498 + mesh - The DMPlex
1499 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1500 - size - The support size for point p
1501 
1502   Output Parameter:
1503 
1504   Note:
1505   This should be called after DMPlexSetChart().
1506 
1507   Level: beginner
1508 
1509 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
1510 @*/
1511 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
1512 {
1513   DM_Plex       *mesh = (DM_Plex*) dm->data;
1514   PetscErrorCode ierr;
1515 
1516   PetscFunctionBegin;
1517   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1518   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1519 
1520   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
1521   PetscFunctionReturn(0);
1522 }
1523 
1524 #undef __FUNCT__
1525 #define __FUNCT__ "DMPlexGetSupport"
1526 /*@C
1527   DMPlexGetSupport - Return the points on the out-edges for this point in the Sieve DAG
1528 
1529   Not collective
1530 
1531   Input Parameters:
1532 + mesh - The DMPlex
1533 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1534 
1535   Output Parameter:
1536 . support - An array of points which are on the out-edges for point p
1537 
1538   Level: beginner
1539 
1540   Fortran Notes:
1541   Since it returns an array, this routine is only available in Fortran 90, and you must
1542   include petsc.h90 in your code.
1543 
1544   You must also call DMPlexRestoreSupport() after you finish using the returned array.
1545 
1546 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1547 @*/
1548 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
1549 {
1550   DM_Plex       *mesh = (DM_Plex*) dm->data;
1551   PetscInt       off;
1552   PetscErrorCode ierr;
1553 
1554   PetscFunctionBegin;
1555   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1556   PetscValidPointer(support, 3);
1557   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1558   *support = &mesh->supports[off];
1559   PetscFunctionReturn(0);
1560 }
1561 
1562 #undef __FUNCT__
1563 #define __FUNCT__ "DMPlexSetSupport"
1564 /*@
1565   DMPlexSetSupport - Set the points on the out-edges for this point in the Sieve DAG
1566 
1567   Not collective
1568 
1569   Input Parameters:
1570 + mesh - The DMPlex
1571 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1572 - support - An array of points which are on the in-edges for point p
1573 
1574   Output Parameter:
1575 
1576   Note:
1577   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
1578 
1579   Level: beginner
1580 
1581 .seealso: DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
1582 @*/
1583 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
1584 {
1585   DM_Plex       *mesh = (DM_Plex*) dm->data;
1586   PetscInt       pStart, pEnd;
1587   PetscInt       dof, off, c;
1588   PetscErrorCode ierr;
1589 
1590   PetscFunctionBegin;
1591   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1592   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1593   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1594   if (dof) PetscValidPointer(support, 3);
1595   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1596   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);
1597   for (c = 0; c < dof; ++c) {
1598     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);
1599     mesh->supports[off+c] = support[c];
1600   }
1601   PetscFunctionReturn(0);
1602 }
1603 
1604 #undef __FUNCT__
1605 #define __FUNCT__ "DMPlexInsertSupport"
1606 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
1607 {
1608   DM_Plex       *mesh = (DM_Plex*) dm->data;
1609   PetscInt       pStart, pEnd;
1610   PetscInt       dof, off;
1611   PetscErrorCode ierr;
1612 
1613   PetscFunctionBegin;
1614   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1615   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1616   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1617   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1618   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);
1619   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);
1620   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);
1621   mesh->supports[off+supportPos] = supportPoint;
1622   PetscFunctionReturn(0);
1623 }
1624 
1625 #undef __FUNCT__
1626 #define __FUNCT__ "DMPlexGetTransitiveClosure"
1627 /*@C
1628   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1629 
1630   Not collective
1631 
1632   Input Parameters:
1633 + mesh - The DMPlex
1634 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1635 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1636 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1637 
1638   Output Parameters:
1639 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1640 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1641 
1642   Note:
1643   If using internal storage (points is NULL on input), each call overwrites the last output.
1644 
1645   Fortran Notes:
1646   Since it returns an array, this routine is only available in Fortran 90, and you must
1647   include petsc.h90 in your code.
1648 
1649   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1650 
1651   Level: beginner
1652 
1653 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1654 @*/
1655 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1656 {
1657   DM_Plex        *mesh = (DM_Plex*) dm->data;
1658   PetscInt       *closure, *fifo;
1659   const PetscInt *tmp = NULL, *tmpO = NULL;
1660   PetscInt        tmpSize, t;
1661   PetscInt        depth       = 0, maxSize;
1662   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1663   PetscErrorCode  ierr;
1664 
1665   PetscFunctionBegin;
1666   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1667   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1668   maxSize = 2*PetscMax(PetscMax(PetscPowInt(mesh->maxConeSize,depth),PetscPowInt(mesh->maxSupportSize,depth)),depth) + 2;
1669   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1670   if (*points) {
1671     closure = *points;
1672   } else {
1673     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1674   }
1675   closure[0] = p; closure[1] = 0;
1676   /* This is only 1-level */
1677   if (useCone) {
1678     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1679     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1680     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1681   } else {
1682     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1683     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1684   }
1685   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1686     const PetscInt cp = tmp[t];
1687     const PetscInt co = tmpO ? tmpO[t] : 0;
1688 
1689     closure[closureSize]   = cp;
1690     closure[closureSize+1] = co;
1691     fifo[fifoSize]         = cp;
1692     fifo[fifoSize+1]       = co;
1693   }
1694   while (fifoSize - fifoStart) {
1695     const PetscInt q   = fifo[fifoStart];
1696     const PetscInt o   = fifo[fifoStart+1];
1697     const PetscInt rev = o >= 0 ? 0 : 1;
1698     const PetscInt off = rev ? -(o+1) : o;
1699 
1700     if (useCone) {
1701       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1702       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1703       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1704     } else {
1705       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1706       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1707       tmpO = NULL;
1708     }
1709     for (t = 0; t < tmpSize; ++t) {
1710       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1711       const PetscInt cp = tmp[i];
1712       /* Must propogate orientation */
1713       const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0;
1714       PetscInt       c;
1715 
1716       /* Check for duplicate */
1717       for (c = 0; c < closureSize; c += 2) {
1718         if (closure[c] == cp) break;
1719       }
1720       if (c == closureSize) {
1721         closure[closureSize]   = cp;
1722         closure[closureSize+1] = co;
1723         fifo[fifoSize]         = cp;
1724         fifo[fifoSize+1]       = co;
1725         closureSize           += 2;
1726         fifoSize              += 2;
1727       }
1728     }
1729     fifoStart += 2;
1730   }
1731   if (numPoints) *numPoints = closureSize/2;
1732   if (points)    *points    = closure;
1733   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1734   PetscFunctionReturn(0);
1735 }
1736 
1737 #undef __FUNCT__
1738 #define __FUNCT__ "DMPlexRestoreTransitiveClosure"
1739 /*@C
1740   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1741 
1742   Not collective
1743 
1744   Input Parameters:
1745 + mesh - The DMPlex
1746 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1747 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1748 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1749 
1750   Output Parameters:
1751 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1752 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1753 
1754   Note:
1755   If not using internal storage (points is not NULL on input), this call is unnecessary
1756 
1757   Fortran Notes:
1758   Since it returns an array, this routine is only available in Fortran 90, and you must
1759   include petsc.h90 in your code.
1760 
1761   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1762 
1763   Level: beginner
1764 
1765 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1766 @*/
1767 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1768 {
1769   PetscErrorCode ierr;
1770 
1771   PetscFunctionBegin;
1772   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1773   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, points);CHKERRQ(ierr);
1774   PetscFunctionReturn(0);
1775 }
1776 
1777 #undef __FUNCT__
1778 #define __FUNCT__ "DMPlexGetMaxSizes"
1779 /*@
1780   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the Sieve DAG
1781 
1782   Not collective
1783 
1784   Input Parameter:
1785 . mesh - The DMPlex
1786 
1787   Output Parameters:
1788 + maxConeSize - The maximum number of in-edges
1789 - maxSupportSize - The maximum number of out-edges
1790 
1791   Level: beginner
1792 
1793 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1794 @*/
1795 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
1796 {
1797   DM_Plex *mesh = (DM_Plex*) dm->data;
1798 
1799   PetscFunctionBegin;
1800   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1801   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
1802   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
1803   PetscFunctionReturn(0);
1804 }
1805 
1806 #undef __FUNCT__
1807 #define __FUNCT__ "DMSetUp_Plex"
1808 PetscErrorCode DMSetUp_Plex(DM dm)
1809 {
1810   DM_Plex       *mesh = (DM_Plex*) dm->data;
1811   PetscInt       size;
1812   PetscErrorCode ierr;
1813 
1814   PetscFunctionBegin;
1815   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1816   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
1817   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
1818   ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->cones);CHKERRQ(ierr);
1819   ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->coneOrientations);CHKERRQ(ierr);
1820   ierr = PetscMemzero(mesh->coneOrientations, size * sizeof(PetscInt));CHKERRQ(ierr);
1821   if (mesh->maxSupportSize) {
1822     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1823     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
1824     ierr = PetscMalloc(size * sizeof(PetscInt), &mesh->supports);CHKERRQ(ierr);
1825   }
1826   PetscFunctionReturn(0);
1827 }
1828 
1829 #undef __FUNCT__
1830 #define __FUNCT__ "DMCreateSubDM_Plex"
1831 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
1832 {
1833   PetscSection   section, sectionGlobal;
1834   PetscInt      *subIndices;
1835   PetscInt       subSize = 0, subOff = 0, nF, f, pStart, pEnd, p;
1836   PetscErrorCode ierr;
1837 
1838   PetscFunctionBegin;
1839   if (!numFields) PetscFunctionReturn(0);
1840   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1841   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
1842   if (!section) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default section for DMPlex before splitting fields");
1843   if (!sectionGlobal) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Must set default global section for DMPlex before splitting fields");
1844   ierr = PetscSectionGetNumFields(section, &nF);CHKERRQ(ierr);
1845   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);
1846   ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
1847   for (p = pStart; p < pEnd; ++p) {
1848     PetscInt gdof;
1849 
1850     ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
1851     if (gdof > 0) {
1852       for (f = 0; f < numFields; ++f) {
1853         PetscInt fdof, fcdof;
1854 
1855         ierr     = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
1856         ierr     = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
1857         subSize += fdof-fcdof;
1858       }
1859     }
1860   }
1861   ierr = PetscMalloc(subSize * sizeof(PetscInt), &subIndices);CHKERRQ(ierr);
1862   for (p = pStart; p < pEnd; ++p) {
1863     PetscInt gdof, goff;
1864 
1865     ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
1866     if (gdof > 0) {
1867       ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr);
1868       for (f = 0; f < numFields; ++f) {
1869         PetscInt fdof, fcdof, fc, f2, poff = 0;
1870 
1871         /* Can get rid of this loop by storing field information in the global section */
1872         for (f2 = 0; f2 < fields[f]; ++f2) {
1873           ierr  = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
1874           ierr  = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
1875           poff += fdof-fcdof;
1876         }
1877         ierr = PetscSectionGetFieldDof(section, p, fields[f], &fdof);CHKERRQ(ierr);
1878         ierr = PetscSectionGetFieldConstraintDof(section, p, fields[f], &fcdof);CHKERRQ(ierr);
1879         for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
1880           subIndices[subOff] = goff+poff+fc;
1881         }
1882       }
1883     }
1884   }
1885   if (is) {ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);}
1886   if (subdm) {
1887     PetscSection subsection;
1888     PetscBool    haveNull = PETSC_FALSE;
1889     PetscInt     f, nf = 0;
1890 
1891     ierr = DMPlexClone(dm, subdm);CHKERRQ(ierr);
1892     ierr = PetscSectionCreateSubsection(section, numFields, fields, &subsection);CHKERRQ(ierr);
1893     ierr = DMSetDefaultSection(*subdm, subsection);CHKERRQ(ierr);
1894     ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
1895     for (f = 0; f < numFields; ++f) {
1896       (*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[fields[f]];
1897       if ((*subdm)->nullspaceConstructors[f]) {
1898         haveNull = PETSC_TRUE;
1899         nf       = f;
1900       }
1901     }
1902     if (haveNull) {
1903       MatNullSpace nullSpace;
1904 
1905       ierr = (*(*subdm)->nullspaceConstructors[nf])(*subdm, nf, &nullSpace);CHKERRQ(ierr);
1906       ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
1907       ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
1908     }
1909     if (dm->fields) {
1910       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);
1911       ierr = DMSetNumFields(*subdm, numFields);CHKERRQ(ierr);
1912       for (f = 0; f < numFields; ++f) {
1913         ierr = PetscObjectListDuplicate(dm->fields[fields[f]]->olist, &(*subdm)->fields[f]->olist);CHKERRQ(ierr);
1914       }
1915       if (numFields == 1) {
1916         MatNullSpace space;
1917         Mat          pmat;
1918 
1919         ierr = PetscObjectQuery((*subdm)->fields[0], "nullspace", (PetscObject*) &space);CHKERRQ(ierr);
1920         if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) space);CHKERRQ(ierr);}
1921         ierr = PetscObjectQuery((*subdm)->fields[0], "nearnullspace", (PetscObject*) &space);CHKERRQ(ierr);
1922         if (space) {ierr = PetscObjectCompose((PetscObject) *is, "nearnullspace", (PetscObject) space);CHKERRQ(ierr);}
1923         ierr = PetscObjectQuery((*subdm)->fields[0], "pmat", (PetscObject*) &pmat);CHKERRQ(ierr);
1924         if (pmat) {ierr = PetscObjectCompose((PetscObject) *is, "pmat", (PetscObject) pmat);CHKERRQ(ierr);}
1925       }
1926     }
1927   }
1928   PetscFunctionReturn(0);
1929 }
1930 
1931 #undef __FUNCT__
1932 #define __FUNCT__ "DMPlexSymmetrize"
1933 /*@
1934   DMPlexSymmetrize - Creates support (out-edge) information from cone (in-edge) inoformation
1935 
1936   Not collective
1937 
1938   Input Parameter:
1939 . mesh - The DMPlex
1940 
1941   Output Parameter:
1942 
1943   Note:
1944   This should be called after all calls to DMPlexSetCone()
1945 
1946   Level: beginner
1947 
1948 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
1949 @*/
1950 PetscErrorCode DMPlexSymmetrize(DM dm)
1951 {
1952   DM_Plex       *mesh = (DM_Plex*) dm->data;
1953   PetscInt      *offsets;
1954   PetscInt       supportSize;
1955   PetscInt       pStart, pEnd, p;
1956   PetscErrorCode ierr;
1957 
1958   PetscFunctionBegin;
1959   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1960   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
1961   /* Calculate support sizes */
1962   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1963   for (p = pStart; p < pEnd; ++p) {
1964     PetscInt dof, off, c;
1965 
1966     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1967     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1968     for (c = off; c < off+dof; ++c) {
1969       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
1970     }
1971   }
1972   for (p = pStart; p < pEnd; ++p) {
1973     PetscInt dof;
1974 
1975     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1976 
1977     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
1978   }
1979   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1980   /* Calculate supports */
1981   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
1982   ierr = PetscMalloc(supportSize * sizeof(PetscInt), &mesh->supports);CHKERRQ(ierr);
1983   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &offsets);CHKERRQ(ierr);
1984   ierr = PetscMemzero(offsets, (pEnd - pStart) * sizeof(PetscInt));CHKERRQ(ierr);
1985   for (p = pStart; p < pEnd; ++p) {
1986     PetscInt dof, off, c;
1987 
1988     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1989     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1990     for (c = off; c < off+dof; ++c) {
1991       const PetscInt q = mesh->cones[c];
1992       PetscInt       offS;
1993 
1994       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
1995 
1996       mesh->supports[offS+offsets[q]] = p;
1997       ++offsets[q];
1998     }
1999   }
2000   ierr = PetscFree(offsets);CHKERRQ(ierr);
2001   PetscFunctionReturn(0);
2002 }
2003 
2004 #undef __FUNCT__
2005 #define __FUNCT__ "DMPlexSetDepth_Private"
2006 PetscErrorCode DMPlexSetDepth_Private(DM dm, PetscInt p, PetscInt *depth)
2007 {
2008   PetscInt       d;
2009   PetscErrorCode ierr;
2010 
2011   PetscFunctionBegin;
2012   ierr = DMPlexGetLabelValue(dm, "depth", p, &d);CHKERRQ(ierr);
2013   if (d < 0) {
2014     /* We are guaranteed that the point has a cone since the depth was not yet set */
2015     const PetscInt *cone = NULL;
2016     PetscInt        dCone;
2017 
2018     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
2019     ierr = DMPlexSetDepth_Private(dm, cone[0], &dCone);CHKERRQ(ierr);
2020     d    = dCone+1;
2021     ierr = DMPlexSetLabelValue(dm, "depth", p, d);CHKERRQ(ierr);
2022   }
2023   *depth = d;
2024   PetscFunctionReturn(0);
2025 }
2026 
2027 #undef __FUNCT__
2028 #define __FUNCT__ "DMPlexStratify"
2029 /*@
2030   DMPlexStratify - The Sieve DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
2031   can be illustrated by Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
2032   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
2033   the DAG.
2034 
2035   Not collective
2036 
2037   Input Parameter:
2038 . mesh - The DMPlex
2039 
2040   Output Parameter:
2041 
2042   Notes:
2043   The normal association for the point grade is element dimension (or co-dimension). For instance, all vertices would
2044   have depth 0, and all edges depth 1. Likewise, all cells heights would have height 0, and all faces height 1.
2045 
2046   This should be called after all calls to DMPlexSymmetrize()
2047 
2048   Level: beginner
2049 
2050 .seealso: DMPlexCreate(), DMPlexSymmetrize()
2051 @*/
2052 PetscErrorCode DMPlexStratify(DM dm)
2053 {
2054   DM_Plex       *mesh = (DM_Plex*) dm->data;
2055   PetscInt       pStart, pEnd, p;
2056   PetscInt       numRoots = 0, numLeaves = 0;
2057   PetscErrorCode ierr;
2058 
2059   PetscFunctionBegin;
2060   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2061   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2062   /* Calculate depth */
2063   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2064   /* Initialize roots and count leaves */
2065   for (p = pStart; p < pEnd; ++p) {
2066     PetscInt coneSize, supportSize;
2067 
2068     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2069     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2070     if (!coneSize && supportSize) {
2071       ++numRoots;
2072       ierr = DMPlexSetLabelValue(dm, "depth", p, 0);CHKERRQ(ierr);
2073     } else if (!supportSize && coneSize) {
2074       ++numLeaves;
2075     } else if (!supportSize && !coneSize) {
2076       /* Isolated points */
2077       ierr = DMPlexSetLabelValue(dm, "depth", p, 0);CHKERRQ(ierr);
2078     }
2079   }
2080   if (numRoots + numLeaves == (pEnd - pStart)) {
2081     for (p = pStart; p < pEnd; ++p) {
2082       PetscInt coneSize, supportSize;
2083 
2084       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2085       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2086       if (!supportSize && coneSize) {
2087         ierr = DMPlexSetLabelValue(dm, "depth", p, 1);CHKERRQ(ierr);
2088       }
2089     }
2090   } else {
2091     /* This might be slow since lookup is not fast */
2092     for (p = pStart; p < pEnd; ++p) {
2093       PetscInt depth;
2094 
2095       ierr = DMPlexSetDepth_Private(dm, p, &depth);CHKERRQ(ierr);
2096     }
2097   }
2098   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2099   PetscFunctionReturn(0);
2100 }
2101 
2102 #undef __FUNCT__
2103 #define __FUNCT__ "DMPlexGetJoin"
2104 /*@C
2105   DMPlexGetJoin - Get an array for the join of the set of points
2106 
2107   Not Collective
2108 
2109   Input Parameters:
2110 + dm - The DMPlex object
2111 . numPoints - The number of input points for the join
2112 - points - The input points
2113 
2114   Output Parameters:
2115 + numCoveredPoints - The number of points in the join
2116 - coveredPoints - The points in the join
2117 
2118   Level: intermediate
2119 
2120   Note: Currently, this is restricted to a single level join
2121 
2122   Fortran Notes:
2123   Since it returns an array, this routine is only available in Fortran 90, and you must
2124   include petsc.h90 in your code.
2125 
2126   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2127 
2128 .keywords: mesh
2129 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
2130 @*/
2131 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2132 {
2133   DM_Plex       *mesh = (DM_Plex*) dm->data;
2134   PetscInt      *join[2];
2135   PetscInt       joinSize, i = 0;
2136   PetscInt       dof, off, p, c, m;
2137   PetscErrorCode ierr;
2138 
2139   PetscFunctionBegin;
2140   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2141   PetscValidPointer(points, 2);
2142   PetscValidPointer(numCoveredPoints, 3);
2143   PetscValidPointer(coveredPoints, 4);
2144   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
2145   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
2146   /* Copy in support of first point */
2147   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
2148   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
2149   for (joinSize = 0; joinSize < dof; ++joinSize) {
2150     join[i][joinSize] = mesh->supports[off+joinSize];
2151   }
2152   /* Check each successive support */
2153   for (p = 1; p < numPoints; ++p) {
2154     PetscInt newJoinSize = 0;
2155 
2156     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
2157     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
2158     for (c = 0; c < dof; ++c) {
2159       const PetscInt point = mesh->supports[off+c];
2160 
2161       for (m = 0; m < joinSize; ++m) {
2162         if (point == join[i][m]) {
2163           join[1-i][newJoinSize++] = point;
2164           break;
2165         }
2166       }
2167     }
2168     joinSize = newJoinSize;
2169     i        = 1-i;
2170   }
2171   *numCoveredPoints = joinSize;
2172   *coveredPoints    = join[i];
2173   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
2174   PetscFunctionReturn(0);
2175 }
2176 
2177 #undef __FUNCT__
2178 #define __FUNCT__ "DMPlexRestoreJoin"
2179 /*@C
2180   DMPlexRestoreJoin - Restore an array for the join of the set of points
2181 
2182   Not Collective
2183 
2184   Input Parameters:
2185 + dm - The DMPlex object
2186 . numPoints - The number of input points for the join
2187 - points - The input points
2188 
2189   Output Parameters:
2190 + numCoveredPoints - The number of points in the join
2191 - coveredPoints - The points in the join
2192 
2193   Fortran Notes:
2194   Since it returns an array, this routine is only available in Fortran 90, and you must
2195   include petsc.h90 in your code.
2196 
2197   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2198 
2199   Level: intermediate
2200 
2201 .keywords: mesh
2202 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
2203 @*/
2204 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2205 {
2206   PetscErrorCode ierr;
2207 
2208   PetscFunctionBegin;
2209   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2210   PetscValidPointer(coveredPoints, 4);
2211   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2212   PetscFunctionReturn(0);
2213 }
2214 
2215 #undef __FUNCT__
2216 #define __FUNCT__ "DMPlexGetFullJoin"
2217 /*@C
2218   DMPlexGetFullJoin - Get an array for the join of the set of points
2219 
2220   Not Collective
2221 
2222   Input Parameters:
2223 + dm - The DMPlex object
2224 . numPoints - The number of input points for the join
2225 - points - The input points
2226 
2227   Output Parameters:
2228 + numCoveredPoints - The number of points in the join
2229 - coveredPoints - The points in the join
2230 
2231   Fortran Notes:
2232   Since it returns an array, this routine is only available in Fortran 90, and you must
2233   include petsc.h90 in your code.
2234 
2235   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2236 
2237   Level: intermediate
2238 
2239 .keywords: mesh
2240 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
2241 @*/
2242 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2243 {
2244   DM_Plex       *mesh = (DM_Plex*) dm->data;
2245   PetscInt      *offsets, **closures;
2246   PetscInt      *join[2];
2247   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
2248   PetscInt       p, d, c, m;
2249   PetscErrorCode ierr;
2250 
2251   PetscFunctionBegin;
2252   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2253   PetscValidPointer(points, 2);
2254   PetscValidPointer(numCoveredPoints, 3);
2255   PetscValidPointer(coveredPoints, 4);
2256 
2257   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2258   ierr    = PetscMalloc(numPoints * sizeof(PetscInt*), &closures);CHKERRQ(ierr);
2259   ierr    = PetscMemzero(closures,numPoints*sizeof(PetscInt*));CHKERRQ(ierr);
2260   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2261   maxSize = PetscPowInt(mesh->maxSupportSize,depth);
2262   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
2263   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
2264 
2265   for (p = 0; p < numPoints; ++p) {
2266     PetscInt closureSize;
2267 
2268     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
2269 
2270     offsets[p*(depth+2)+0] = 0;
2271     for (d = 0; d < depth+1; ++d) {
2272       PetscInt pStart, pEnd, i;
2273 
2274       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
2275       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
2276         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2277           offsets[p*(depth+2)+d+1] = i;
2278           break;
2279         }
2280       }
2281       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
2282     }
2283     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);
2284   }
2285   for (d = 0; d < depth+1; ++d) {
2286     PetscInt dof;
2287 
2288     /* Copy in support of first point */
2289     dof = offsets[d+1] - offsets[d];
2290     for (joinSize = 0; joinSize < dof; ++joinSize) {
2291       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
2292     }
2293     /* Check each successive cone */
2294     for (p = 1; p < numPoints && joinSize; ++p) {
2295       PetscInt newJoinSize = 0;
2296 
2297       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
2298       for (c = 0; c < dof; ++c) {
2299         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
2300 
2301         for (m = 0; m < joinSize; ++m) {
2302           if (point == join[i][m]) {
2303             join[1-i][newJoinSize++] = point;
2304             break;
2305           }
2306         }
2307       }
2308       joinSize = newJoinSize;
2309       i        = 1-i;
2310     }
2311     if (joinSize) break;
2312   }
2313   *numCoveredPoints = joinSize;
2314   *coveredPoints    = join[i];
2315   for (p = 0; p < numPoints; ++p) {
2316     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
2317   }
2318   ierr = PetscFree(closures);CHKERRQ(ierr);
2319   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2320   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
2321   PetscFunctionReturn(0);
2322 }
2323 
2324 #undef __FUNCT__
2325 #define __FUNCT__ "DMPlexGetMeet"
2326 /*@C
2327   DMPlexGetMeet - Get an array for the meet of the set of points
2328 
2329   Not Collective
2330 
2331   Input Parameters:
2332 + dm - The DMPlex object
2333 . numPoints - The number of input points for the meet
2334 - points - The input points
2335 
2336   Output Parameters:
2337 + numCoveredPoints - The number of points in the meet
2338 - coveredPoints - The points in the meet
2339 
2340   Level: intermediate
2341 
2342   Note: Currently, this is restricted to a single level meet
2343 
2344   Fortran Notes:
2345   Since it returns an array, this routine is only available in Fortran 90, and you must
2346   include petsc.h90 in your code.
2347 
2348   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2349 
2350 .keywords: mesh
2351 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
2352 @*/
2353 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
2354 {
2355   DM_Plex       *mesh = (DM_Plex*) dm->data;
2356   PetscInt      *meet[2];
2357   PetscInt       meetSize, i = 0;
2358   PetscInt       dof, off, p, c, m;
2359   PetscErrorCode ierr;
2360 
2361   PetscFunctionBegin;
2362   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2363   PetscValidPointer(points, 2);
2364   PetscValidPointer(numCoveringPoints, 3);
2365   PetscValidPointer(coveringPoints, 4);
2366   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2367   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2368   /* Copy in cone of first point */
2369   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
2370   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
2371   for (meetSize = 0; meetSize < dof; ++meetSize) {
2372     meet[i][meetSize] = mesh->cones[off+meetSize];
2373   }
2374   /* Check each successive cone */
2375   for (p = 1; p < numPoints; ++p) {
2376     PetscInt newMeetSize = 0;
2377 
2378     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
2379     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
2380     for (c = 0; c < dof; ++c) {
2381       const PetscInt point = mesh->cones[off+c];
2382 
2383       for (m = 0; m < meetSize; ++m) {
2384         if (point == meet[i][m]) {
2385           meet[1-i][newMeetSize++] = point;
2386           break;
2387         }
2388       }
2389     }
2390     meetSize = newMeetSize;
2391     i        = 1-i;
2392   }
2393   *numCoveringPoints = meetSize;
2394   *coveringPoints    = meet[i];
2395   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2396   PetscFunctionReturn(0);
2397 }
2398 
2399 #undef __FUNCT__
2400 #define __FUNCT__ "DMPlexRestoreMeet"
2401 /*@C
2402   DMPlexRestoreMeet - Restore an array for the meet of the set of points
2403 
2404   Not Collective
2405 
2406   Input Parameters:
2407 + dm - The DMPlex object
2408 . numPoints - The number of input points for the meet
2409 - points - The input points
2410 
2411   Output Parameters:
2412 + numCoveredPoints - The number of points in the meet
2413 - coveredPoints - The points in the meet
2414 
2415   Level: intermediate
2416 
2417   Fortran Notes:
2418   Since it returns an array, this routine is only available in Fortran 90, and you must
2419   include petsc.h90 in your code.
2420 
2421   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2422 
2423 .keywords: mesh
2424 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
2425 @*/
2426 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2427 {
2428   PetscErrorCode ierr;
2429 
2430   PetscFunctionBegin;
2431   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2432   PetscValidPointer(coveredPoints, 4);
2433   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2434   PetscFunctionReturn(0);
2435 }
2436 
2437 #undef __FUNCT__
2438 #define __FUNCT__ "DMPlexGetFullMeet"
2439 /*@C
2440   DMPlexGetFullMeet - Get an array for the meet of the set of points
2441 
2442   Not Collective
2443 
2444   Input Parameters:
2445 + dm - The DMPlex object
2446 . numPoints - The number of input points for the meet
2447 - points - The input points
2448 
2449   Output Parameters:
2450 + numCoveredPoints - The number of points in the meet
2451 - coveredPoints - The points in the meet
2452 
2453   Level: intermediate
2454 
2455   Fortran Notes:
2456   Since it returns an array, this routine is only available in Fortran 90, and you must
2457   include petsc.h90 in your code.
2458 
2459   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2460 
2461 .keywords: mesh
2462 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
2463 @*/
2464 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2465 {
2466   DM_Plex       *mesh = (DM_Plex*) dm->data;
2467   PetscInt      *offsets, **closures;
2468   PetscInt      *meet[2];
2469   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
2470   PetscInt       p, h, c, m;
2471   PetscErrorCode ierr;
2472 
2473   PetscFunctionBegin;
2474   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2475   PetscValidPointer(points, 2);
2476   PetscValidPointer(numCoveredPoints, 3);
2477   PetscValidPointer(coveredPoints, 4);
2478 
2479   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
2480   ierr    = PetscMalloc(numPoints * sizeof(PetscInt*), &closures);CHKERRQ(ierr);
2481   ierr    = DMGetWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2482   maxSize = PetscPowInt(mesh->maxConeSize,height);
2483   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2484   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2485 
2486   for (p = 0; p < numPoints; ++p) {
2487     PetscInt closureSize;
2488 
2489     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
2490 
2491     offsets[p*(height+2)+0] = 0;
2492     for (h = 0; h < height+1; ++h) {
2493       PetscInt pStart, pEnd, i;
2494 
2495       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
2496       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
2497         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2498           offsets[p*(height+2)+h+1] = i;
2499           break;
2500         }
2501       }
2502       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
2503     }
2504     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);
2505   }
2506   for (h = 0; h < height+1; ++h) {
2507     PetscInt dof;
2508 
2509     /* Copy in cone of first point */
2510     dof = offsets[h+1] - offsets[h];
2511     for (meetSize = 0; meetSize < dof; ++meetSize) {
2512       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
2513     }
2514     /* Check each successive cone */
2515     for (p = 1; p < numPoints && meetSize; ++p) {
2516       PetscInt newMeetSize = 0;
2517 
2518       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
2519       for (c = 0; c < dof; ++c) {
2520         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
2521 
2522         for (m = 0; m < meetSize; ++m) {
2523           if (point == meet[i][m]) {
2524             meet[1-i][newMeetSize++] = point;
2525             break;
2526           }
2527         }
2528       }
2529       meetSize = newMeetSize;
2530       i        = 1-i;
2531     }
2532     if (meetSize) break;
2533   }
2534   *numCoveredPoints = meetSize;
2535   *coveredPoints    = meet[i];
2536   for (p = 0; p < numPoints; ++p) {
2537     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
2538   }
2539   ierr = PetscFree(closures);CHKERRQ(ierr);
2540   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2541   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2542   PetscFunctionReturn(0);
2543 }
2544 
2545 #undef __FUNCT__
2546 #define __FUNCT__ "DMPlexGetNumFaceVertices_Internal"
2547 PetscErrorCode DMPlexGetNumFaceVertices_Internal(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
2548 {
2549   MPI_Comm       comm;
2550   PetscErrorCode ierr;
2551 
2552   PetscFunctionBegin;
2553   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2554   PetscValidPointer(numFaceVertices,3);
2555   switch (cellDim) {
2556   case 0:
2557     *numFaceVertices = 0;
2558     break;
2559   case 1:
2560     *numFaceVertices = 1;
2561     break;
2562   case 2:
2563     switch (numCorners) {
2564     case 3: /* triangle */
2565       *numFaceVertices = 2; /* Edge has 2 vertices */
2566       break;
2567     case 4: /* quadrilateral */
2568       *numFaceVertices = 2; /* Edge has 2 vertices */
2569       break;
2570     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
2571       *numFaceVertices = 3; /* Edge has 3 vertices */
2572       break;
2573     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
2574       *numFaceVertices = 3; /* Edge has 3 vertices */
2575       break;
2576     default:
2577       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2578     }
2579     break;
2580   case 3:
2581     switch (numCorners) {
2582     case 4: /* tetradehdron */
2583       *numFaceVertices = 3; /* Face has 3 vertices */
2584       break;
2585     case 6: /* tet cohesive cells */
2586       *numFaceVertices = 4; /* Face has 4 vertices */
2587       break;
2588     case 8: /* hexahedron */
2589       *numFaceVertices = 4; /* Face has 4 vertices */
2590       break;
2591     case 9: /* tet cohesive Lagrange cells */
2592       *numFaceVertices = 6; /* Face has 6 vertices */
2593       break;
2594     case 10: /* quadratic tetrahedron */
2595       *numFaceVertices = 6; /* Face has 6 vertices */
2596       break;
2597     case 12: /* hex cohesive Lagrange cells */
2598       *numFaceVertices = 6; /* Face has 6 vertices */
2599       break;
2600     case 18: /* quadratic tet cohesive Lagrange cells */
2601       *numFaceVertices = 6; /* Face has 6 vertices */
2602       break;
2603     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
2604       *numFaceVertices = 9; /* Face has 9 vertices */
2605       break;
2606     default:
2607       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2608     }
2609     break;
2610   default:
2611     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %d", cellDim);
2612   }
2613   PetscFunctionReturn(0);
2614 }
2615 
2616 #undef __FUNCT__
2617 #define __FUNCT__ "DMPlexCreateNeighborCSR"
2618 PetscErrorCode DMPlexCreateNeighborCSR(DM dm, PetscInt cellHeight, PetscInt *numVertices, PetscInt **offsets, PetscInt **adjacency)
2619 {
2620   const PetscInt maxFaceCases = 30;
2621   PetscInt       numFaceCases = 0;
2622   PetscInt       numFaceVertices[30]; /* maxFaceCases, C89 sucks sucks sucks */
2623   PetscInt      *off, *adj;
2624   PetscInt      *neighborCells, *tmpClosure;
2625   PetscInt       maxConeSize, maxSupportSize, maxClosure, maxNeighbors;
2626   PetscInt       dim, cellDim, depth = 0, faceDepth, cStart, cEnd, c, numCells, cell;
2627   PetscErrorCode ierr;
2628 
2629   PetscFunctionBegin;
2630   /* For parallel partitioning, I think you have to communicate supports */
2631   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2632   cellDim = dim - cellHeight;
2633   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2634   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2635   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
2636   if (cEnd - cStart == 0) {
2637     if (numVertices) *numVertices = 0;
2638     if (offsets)   *offsets   = NULL;
2639     if (adjacency) *adjacency = NULL;
2640     PetscFunctionReturn(0);
2641   }
2642   numCells  = cEnd - cStart;
2643   faceDepth = depth - cellHeight;
2644   /* Setup face recognition */
2645   if (faceDepth == 1) {
2646     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 */
2647 
2648     for (c = cStart; c < cEnd; ++c) {
2649       PetscInt corners;
2650 
2651       ierr = DMPlexGetConeSize(dm, c, &corners);CHKERRQ(ierr);
2652       if (!cornersSeen[corners]) {
2653         PetscInt nFV;
2654 
2655         if (numFaceCases >= maxFaceCases) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Exceeded maximum number of face recognition cases");
2656         cornersSeen[corners] = 1;
2657 
2658         ierr = DMPlexGetNumFaceVertices_Internal(dm, cellDim, corners, &nFV);CHKERRQ(ierr);
2659 
2660         numFaceVertices[numFaceCases++] = nFV;
2661       }
2662     }
2663   }
2664   maxClosure   = 2*PetscMax(PetscPowInt(maxConeSize,depth),PetscPowInt(maxSupportSize,depth));
2665   maxNeighbors = PetscPowInt(maxConeSize,depth)*PetscPowInt(maxSupportSize,depth);
2666   ierr         = PetscMalloc2(maxNeighbors,PetscInt,&neighborCells,maxClosure,PetscInt,&tmpClosure);CHKERRQ(ierr);
2667   ierr         = PetscMalloc((numCells+1) * sizeof(PetscInt), &off);CHKERRQ(ierr);
2668   ierr         = PetscMemzero(off, (numCells+1) * sizeof(PetscInt));CHKERRQ(ierr);
2669   /* Count neighboring cells */
2670   for (cell = cStart; cell < cEnd; ++cell) {
2671     PetscInt numNeighbors = maxNeighbors, n;
2672 
2673     ierr = DMPlexGetAdjacencySingleLevel_Private(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2674     /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2675     for (n = 0; n < numNeighbors; ++n) {
2676       PetscInt        cellPair[2];
2677       PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2678       PetscInt        meetSize = 0;
2679       const PetscInt *meet    = NULL;
2680 
2681       cellPair[0] = cell; cellPair[1] = neighborCells[n];
2682       if (cellPair[0] == cellPair[1]) continue;
2683       if (!found) {
2684         ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2685         if (meetSize) {
2686           PetscInt f;
2687 
2688           for (f = 0; f < numFaceCases; ++f) {
2689             if (numFaceVertices[f] == meetSize) {
2690               found = PETSC_TRUE;
2691               break;
2692             }
2693           }
2694         }
2695         ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2696       }
2697       if (found) ++off[cell-cStart+1];
2698     }
2699   }
2700   /* Prefix sum */
2701   for (cell = 1; cell <= numCells; ++cell) off[cell] += off[cell-1];
2702 
2703   if (adjacency) {
2704     ierr = PetscMalloc(off[numCells] * sizeof(PetscInt), &adj);CHKERRQ(ierr);
2705     /* Get neighboring cells */
2706     for (cell = cStart; cell < cEnd; ++cell) {
2707       PetscInt numNeighbors = maxNeighbors, n;
2708       PetscInt cellOffset   = 0;
2709 
2710       ierr = DMPlexGetAdjacencySingleLevel_Private(dm, cell, PETSC_TRUE, tmpClosure, &numNeighbors, neighborCells);CHKERRQ(ierr);
2711       /* Get meet with each cell, and check with recognizer (could optimize to check each pair only once) */
2712       for (n = 0; n < numNeighbors; ++n) {
2713         PetscInt        cellPair[2];
2714         PetscBool       found    = faceDepth > 1 ? PETSC_TRUE : PETSC_FALSE;
2715         PetscInt        meetSize = 0;
2716         const PetscInt *meet    = NULL;
2717 
2718         cellPair[0] = cell; cellPair[1] = neighborCells[n];
2719         if (cellPair[0] == cellPair[1]) continue;
2720         if (!found) {
2721           ierr = DMPlexGetMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2722           if (meetSize) {
2723             PetscInt f;
2724 
2725             for (f = 0; f < numFaceCases; ++f) {
2726               if (numFaceVertices[f] == meetSize) {
2727                 found = PETSC_TRUE;
2728                 break;
2729               }
2730             }
2731           }
2732           ierr = DMPlexRestoreMeet(dm, 2, cellPair, &meetSize, &meet);CHKERRQ(ierr);
2733         }
2734         if (found) {
2735           adj[off[cell-cStart]+cellOffset] = neighborCells[n];
2736           ++cellOffset;
2737         }
2738       }
2739     }
2740   }
2741   ierr = PetscFree2(neighborCells,tmpClosure);CHKERRQ(ierr);
2742   if (numVertices) *numVertices = numCells;
2743   if (offsets)   *offsets   = off;
2744   if (adjacency) *adjacency = adj;
2745   PetscFunctionReturn(0);
2746 }
2747 
2748 #if defined(PETSC_HAVE_CHACO)
2749 #if defined(PETSC_HAVE_UNISTD_H)
2750 #include <unistd.h>
2751 #endif
2752 /* Chaco does not have an include file */
2753 PETSC_EXTERN int interface(int nvtxs, int *start, int *adjacency, int *vwgts,
2754                        float *ewgts, float *x, float *y, float *z, char *outassignname,
2755                        char *outfilename, short *assignment, int architecture, int ndims_tot,
2756                        int mesh_dims[3], double *goal, int global_method, int local_method,
2757                        int rqi_flag, int vmax, int ndims, double eigtol, long seed);
2758 
2759 extern int FREE_GRAPH;
2760 
2761 #undef __FUNCT__
2762 #define __FUNCT__ "DMPlexPartition_Chaco"
2763 PetscErrorCode DMPlexPartition_Chaco(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2764 {
2765   enum {DEFAULT_METHOD = 1, INERTIAL_METHOD = 3};
2766   MPI_Comm       comm;
2767   int            nvtxs          = numVertices; /* number of vertices in full graph */
2768   int           *vwgts          = NULL;   /* weights for all vertices */
2769   float         *ewgts          = NULL;   /* weights for all edges */
2770   float         *x              = NULL, *y = NULL, *z = NULL; /* coordinates for inertial method */
2771   char          *outassignname  = NULL;   /*  name of assignment output file */
2772   char          *outfilename    = NULL;   /* output file name */
2773   int            architecture   = 1;      /* 0 => hypercube, d => d-dimensional mesh */
2774   int            ndims_tot      = 0;      /* total number of cube dimensions to divide */
2775   int            mesh_dims[3];            /* dimensions of mesh of processors */
2776   double        *goal          = NULL;    /* desired set sizes for each set */
2777   int            global_method = 1;       /* global partitioning algorithm */
2778   int            local_method  = 1;       /* local partitioning algorithm */
2779   int            rqi_flag      = 0;       /* should I use RQI/Symmlq eigensolver? */
2780   int            vmax          = 200;     /* how many vertices to coarsen down to? */
2781   int            ndims         = 1;       /* number of eigenvectors (2^d sets) */
2782   double         eigtol        = 0.001;   /* tolerance on eigenvectors */
2783   long           seed          = 123636512; /* for random graph mutations */
2784   short int     *assignment;              /* Output partition */
2785   int            fd_stdout, fd_pipe[2];
2786   PetscInt      *points;
2787   PetscMPIInt    commSize;
2788   int            i, v, p;
2789   PetscErrorCode ierr;
2790 
2791   PetscFunctionBegin;
2792   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2793   ierr = MPI_Comm_size(comm, &commSize);CHKERRQ(ierr);
2794   if (!numVertices) {
2795     ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2796     ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2797     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2798     ierr = ISCreateGeneral(comm, 0, NULL, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2799     PetscFunctionReturn(0);
2800   }
2801   FREE_GRAPH = 0;                         /* Do not let Chaco free my memory */
2802   for (i = 0; i < start[numVertices]; ++i) ++adjacency[i];
2803 
2804   if (global_method == INERTIAL_METHOD) {
2805     /* manager.createCellCoordinates(nvtxs, &x, &y, &z); */
2806     SETERRQ(comm, PETSC_ERR_SUP, "Inertial partitioning not yet supported");
2807   }
2808   mesh_dims[0] = commSize;
2809   mesh_dims[1] = 1;
2810   mesh_dims[2] = 1;
2811   ierr = PetscMalloc(nvtxs * sizeof(short int), &assignment);CHKERRQ(ierr);
2812   /* Chaco outputs to stdout. We redirect this to a buffer. */
2813   /* TODO: check error codes for UNIX calls */
2814 #if defined(PETSC_HAVE_UNISTD_H)
2815   {
2816     int piperet;
2817     piperet = pipe(fd_pipe);
2818     if (piperet) SETERRQ(comm,PETSC_ERR_SYS,"Could not create pipe");
2819     fd_stdout = dup(1);
2820     close(1);
2821     dup2(fd_pipe[1], 1);
2822   }
2823 #endif
2824   ierr = interface(nvtxs, (int*) start, (int*) adjacency, vwgts, ewgts, x, y, z, outassignname, outfilename,
2825                    assignment, architecture, ndims_tot, mesh_dims, goal, global_method, local_method, rqi_flag,
2826                    vmax, ndims, eigtol, seed);
2827 #if defined(PETSC_HAVE_UNISTD_H)
2828   {
2829     char msgLog[10000];
2830     int  count;
2831 
2832     fflush(stdout);
2833     count = read(fd_pipe[0], msgLog, (10000-1)*sizeof(char));
2834     if (count < 0) count = 0;
2835     msgLog[count] = 0;
2836     close(1);
2837     dup2(fd_stdout, 1);
2838     close(fd_stdout);
2839     close(fd_pipe[0]);
2840     close(fd_pipe[1]);
2841     if (ierr) SETERRQ1(comm, PETSC_ERR_LIB, "Error in Chaco library: %s", msgLog);
2842   }
2843 #endif
2844   /* Convert to PetscSection+IS */
2845   ierr = PetscSectionCreate(comm, partSection);CHKERRQ(ierr);
2846   ierr = PetscSectionSetChart(*partSection, 0, commSize);CHKERRQ(ierr);
2847   for (v = 0; v < nvtxs; ++v) {
2848     ierr = PetscSectionAddDof(*partSection, assignment[v], 1);CHKERRQ(ierr);
2849   }
2850   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2851   ierr = PetscMalloc(nvtxs * sizeof(PetscInt), &points);CHKERRQ(ierr);
2852   for (p = 0, i = 0; p < commSize; ++p) {
2853     for (v = 0; v < nvtxs; ++v) {
2854       if (assignment[v] == p) points[i++] = v;
2855     }
2856   }
2857   if (i != nvtxs) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of points %D should be %D", i, nvtxs);
2858   ierr = ISCreateGeneral(comm, nvtxs, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2859   if (global_method == INERTIAL_METHOD) {
2860     /* manager.destroyCellCoordinates(nvtxs, &x, &y, &z); */
2861   }
2862   ierr = PetscFree(assignment);CHKERRQ(ierr);
2863   for (i = 0; i < start[numVertices]; ++i) --adjacency[i];
2864   PetscFunctionReturn(0);
2865 }
2866 #endif
2867 
2868 #if defined(PETSC_HAVE_PARMETIS)
2869 #undef __FUNCT__
2870 #define __FUNCT__ "DMPlexPartition_ParMetis"
2871 PetscErrorCode DMPlexPartition_ParMetis(DM dm, PetscInt numVertices, PetscInt start[], PetscInt adjacency[], PetscSection *partSection, IS *partition)
2872 {
2873   PetscFunctionBegin;
2874   SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "ParMetis not yet supported");
2875   PetscFunctionReturn(0);
2876 }
2877 #endif
2878 
2879 #undef __FUNCT__
2880 #define __FUNCT__ "DMPlexEnlargePartition"
2881 /* Expand the partition by BFS on the adjacency graph */
2882 PetscErrorCode DMPlexEnlargePartition(DM dm, const PetscInt start[], const PetscInt adjacency[], PetscSection origPartSection, IS origPartition, PetscSection *partSection, IS *partition)
2883 {
2884   PetscHashI      h;
2885   const PetscInt *points;
2886   PetscInt      **tmpPoints, *newPoints, totPoints = 0;
2887   PetscInt        pStart, pEnd, part, q;
2888   PetscErrorCode  ierr;
2889 
2890   PetscFunctionBegin;
2891   PetscHashICreate(h);
2892   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2893   ierr = PetscSectionGetChart(origPartSection, &pStart, &pEnd);CHKERRQ(ierr);
2894   ierr = PetscSectionSetChart(*partSection, pStart, pEnd);CHKERRQ(ierr);
2895   ierr = ISGetIndices(origPartition, &points);CHKERRQ(ierr);
2896   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt*), &tmpPoints);CHKERRQ(ierr);
2897   for (part = pStart; part < pEnd; ++part) {
2898     PetscInt numPoints, nP, numNewPoints, off, p, n = 0;
2899 
2900     PetscHashIClear(h);
2901     ierr = PetscSectionGetDof(origPartSection, part, &numPoints);CHKERRQ(ierr);
2902     ierr = PetscSectionGetOffset(origPartSection, part, &off);CHKERRQ(ierr);
2903     /* Add all existing points to h */
2904     for (p = 0; p < numPoints; ++p) {
2905       const PetscInt point = points[off+p];
2906       PetscHashIAdd(h, point, 1);
2907     }
2908     PetscHashISize(h, nP);
2909     if (nP != numPoints) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid partition has %d points, but only %d were unique", numPoints, nP);
2910     /* Add all points in next BFS level */
2911     /*   TODO We are brute forcing here, but could check the adjacency size to find the boundary */
2912     for (p = 0; p < numPoints; ++p) {
2913       const PetscInt point = points[off+p];
2914       PetscInt       s     = start[point], e = start[point+1], a;
2915 
2916       for (a = s; a < e; ++a) PetscHashIAdd(h, adjacency[a], 1);
2917     }
2918     PetscHashISize(h, numNewPoints);
2919     ierr = PetscSectionSetDof(*partSection, part, numNewPoints);CHKERRQ(ierr);
2920     ierr = PetscMalloc(numNewPoints * sizeof(PetscInt), &tmpPoints[part]);CHKERRQ(ierr);
2921     if (numNewPoints) PetscHashIGetKeys(h, n, tmpPoints[part]); /* Should not need this conditional */
2922     totPoints += numNewPoints;
2923   }
2924   ierr = ISRestoreIndices(origPartition, &points);CHKERRQ(ierr);
2925   PetscHashIDestroy(h);
2926   ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2927   ierr = PetscMalloc(totPoints * sizeof(PetscInt), &newPoints);CHKERRQ(ierr);
2928   for (part = pStart, q = 0; part < pEnd; ++part) {
2929     PetscInt numPoints, p;
2930 
2931     ierr = PetscSectionGetDof(*partSection, part, &numPoints);CHKERRQ(ierr);
2932     for (p = 0; p < numPoints; ++p, ++q) newPoints[q] = tmpPoints[part][p];
2933     ierr = PetscFree(tmpPoints[part]);CHKERRQ(ierr);
2934   }
2935   ierr = PetscFree(tmpPoints);CHKERRQ(ierr);
2936   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), totPoints, newPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2937   PetscFunctionReturn(0);
2938 }
2939 
2940 #undef __FUNCT__
2941 #define __FUNCT__ "DMPlexCreatePartition"
2942 /*
2943   DMPlexCreatePartition - Create a non-overlapping partition of the points at the given height
2944 
2945   Collective on DM
2946 
2947   Input Parameters:
2948   + dm - The DM
2949   . height - The height for points in the partition
2950   - enlarge - Expand each partition with neighbors
2951 
2952   Output Parameters:
2953   + partSection - The PetscSection giving the division of points by partition
2954   . partition - The list of points by partition
2955   . origPartSection - If enlarge is true, the PetscSection giving the division of points before enlarging by partition, otherwise NULL
2956   - origPartition - If enlarge is true, the list of points before enlarging by partition, otherwise NULL
2957 
2958   Level: developer
2959 
2960 .seealso DMPlexDistribute()
2961 */
2962 PetscErrorCode DMPlexCreatePartition(DM dm, PetscInt height, PetscBool enlarge, PetscSection *partSection, IS *partition, PetscSection *origPartSection, IS *origPartition)
2963 {
2964   PetscMPIInt    size;
2965   PetscErrorCode ierr;
2966 
2967   PetscFunctionBegin;
2968   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
2969 
2970   *origPartSection = NULL;
2971   *origPartition   = NULL;
2972   if (size == 1) {
2973     PetscInt *points;
2974     PetscInt  cStart, cEnd, c;
2975 
2976     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2977     ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), partSection);CHKERRQ(ierr);
2978     ierr = PetscSectionSetChart(*partSection, 0, size);CHKERRQ(ierr);
2979     ierr = PetscSectionSetDof(*partSection, 0, cEnd-cStart);CHKERRQ(ierr);
2980     ierr = PetscSectionSetUp(*partSection);CHKERRQ(ierr);
2981     ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscInt), &points);CHKERRQ(ierr);
2982     for (c = cStart; c < cEnd; ++c) points[c] = c;
2983     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), cEnd-cStart, points, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
2984     PetscFunctionReturn(0);
2985   }
2986   if (height == 0) {
2987     PetscInt  numVertices;
2988     PetscInt *start     = NULL;
2989     PetscInt *adjacency = NULL;
2990 
2991     ierr = DMPlexCreateNeighborCSR(dm, 0, &numVertices, &start, &adjacency);CHKERRQ(ierr);
2992     if (1) {
2993 #if defined(PETSC_HAVE_CHACO)
2994       ierr = DMPlexPartition_Chaco(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2995 #endif
2996     } else {
2997 #if defined(PETSC_HAVE_PARMETIS)
2998       ierr = DMPlexPartition_ParMetis(dm, numVertices, start, adjacency, partSection, partition);CHKERRQ(ierr);
2999 #endif
3000     }
3001     if (enlarge) {
3002       *origPartSection = *partSection;
3003       *origPartition   = *partition;
3004 
3005       ierr = DMPlexEnlargePartition(dm, start, adjacency, *origPartSection, *origPartition, partSection, partition);CHKERRQ(ierr);
3006     }
3007     ierr = PetscFree(start);CHKERRQ(ierr);
3008     ierr = PetscFree(adjacency);CHKERRQ(ierr);
3009 # if 0
3010   } else if (height == 1) {
3011     /* Build the dual graph for faces and partition the hypergraph */
3012     PetscInt numEdges;
3013 
3014     buildFaceCSRV(mesh, mesh->getFactory()->getNumbering(mesh, mesh->depth()-1), &numEdges, &start, &adjacency, GraphPartitioner::zeroBase());
3015     GraphPartitioner().partition(numEdges, start, adjacency, partition, manager);
3016     destroyCSR(numEdges, start, adjacency);
3017 #endif
3018   } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid partition height %D", height);
3019   PetscFunctionReturn(0);
3020 }
3021 
3022 #undef __FUNCT__
3023 #define __FUNCT__ "DMPlexCreatePartitionClosure"
3024 PetscErrorCode DMPlexCreatePartitionClosure(DM dm, PetscSection pointSection, IS pointPartition, PetscSection *section, IS *partition)
3025 {
3026   /* const PetscInt  height = 0; */
3027   const PetscInt *partArray;
3028   PetscInt       *allPoints, *partPoints = NULL;
3029   PetscInt        rStart, rEnd, rank, maxPartSize = 0, newSize;
3030   PetscErrorCode  ierr;
3031 
3032   PetscFunctionBegin;
3033   ierr = PetscSectionGetChart(pointSection, &rStart, &rEnd);CHKERRQ(ierr);
3034   ierr = ISGetIndices(pointPartition, &partArray);CHKERRQ(ierr);
3035   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
3036   ierr = PetscSectionSetChart(*section, rStart, rEnd);CHKERRQ(ierr);
3037   for (rank = rStart; rank < rEnd; ++rank) {
3038     PetscInt partSize = 0;
3039     PetscInt numPoints, offset, p;
3040 
3041     ierr = PetscSectionGetDof(pointSection, rank, &numPoints);CHKERRQ(ierr);
3042     ierr = PetscSectionGetOffset(pointSection, rank, &offset);CHKERRQ(ierr);
3043     for (p = 0; p < numPoints; ++p) {
3044       PetscInt  point   = partArray[offset+p], closureSize, c;
3045       PetscInt *closure = NULL;
3046 
3047       /* TODO Include support for height > 0 case */
3048       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3049       /* Merge into existing points */
3050       if (partSize+closureSize > maxPartSize) {
3051         PetscInt *tmpPoints;
3052 
3053         maxPartSize = PetscMax(partSize+closureSize, 2*maxPartSize);
3054         ierr = PetscMalloc(maxPartSize * sizeof(PetscInt), &tmpPoints);CHKERRQ(ierr);
3055         ierr = PetscMemcpy(tmpPoints, partPoints, partSize * sizeof(PetscInt));CHKERRQ(ierr);
3056         ierr = PetscFree(partPoints);CHKERRQ(ierr);
3057 
3058         partPoints = tmpPoints;
3059       }
3060       for (c = 0; c < closureSize; ++c) partPoints[partSize+c] = closure[c*2];
3061       partSize += closureSize;
3062 
3063       ierr = PetscSortRemoveDupsInt(&partSize, partPoints);CHKERRQ(ierr);
3064       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3065     }
3066     ierr = PetscSectionSetDof(*section, rank, partSize);CHKERRQ(ierr);
3067   }
3068   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3069   ierr = PetscSectionGetStorageSize(*section, &newSize);CHKERRQ(ierr);
3070   ierr = PetscMalloc(newSize * sizeof(PetscInt), &allPoints);CHKERRQ(ierr);
3071 
3072   for (rank = rStart; rank < rEnd; ++rank) {
3073     PetscInt partSize = 0, newOffset;
3074     PetscInt numPoints, offset, p;
3075 
3076     ierr = PetscSectionGetDof(pointSection, rank, &numPoints);CHKERRQ(ierr);
3077     ierr = PetscSectionGetOffset(pointSection, rank, &offset);CHKERRQ(ierr);
3078     for (p = 0; p < numPoints; ++p) {
3079       PetscInt  point   = partArray[offset+p], closureSize, c;
3080       PetscInt *closure = NULL;
3081 
3082       /* TODO Include support for height > 0 case */
3083       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3084       /* Merge into existing points */
3085       for (c = 0; c < closureSize; ++c) partPoints[partSize+c] = closure[c*2];
3086       partSize += closureSize;
3087 
3088       ierr = PetscSortRemoveDupsInt(&partSize, partPoints);CHKERRQ(ierr);
3089       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3090     }
3091     ierr = PetscSectionGetOffset(*section, rank, &newOffset);CHKERRQ(ierr);
3092     ierr = PetscMemcpy(&allPoints[newOffset], partPoints, partSize * sizeof(PetscInt));CHKERRQ(ierr);
3093   }
3094   ierr = ISRestoreIndices(pointPartition, &partArray);CHKERRQ(ierr);
3095   ierr = PetscFree(partPoints);CHKERRQ(ierr);
3096   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), newSize, allPoints, PETSC_OWN_POINTER, partition);CHKERRQ(ierr);
3097   PetscFunctionReturn(0);
3098 }
3099 
3100 #undef __FUNCT__
3101 #define __FUNCT__ "DMPlexDistributeField"
3102 /*
3103   Input Parameters:
3104 . originalSection
3105 , originalVec
3106 
3107   Output Parameters:
3108 . newSection
3109 . newVec
3110 */
3111 PetscErrorCode DMPlexDistributeField(DM dm, PetscSF pointSF, PetscSection originalSection, Vec originalVec, PetscSection newSection, Vec newVec)
3112 {
3113   PetscSF        fieldSF;
3114   PetscInt      *remoteOffsets, fieldSize;
3115   PetscScalar   *originalValues, *newValues;
3116   PetscErrorCode ierr;
3117 
3118   PetscFunctionBegin;
3119   ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
3120 
3121   ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
3122   ierr = VecSetSizes(newVec, fieldSize, PETSC_DETERMINE);CHKERRQ(ierr);
3123   ierr = VecSetFromOptions(newVec);CHKERRQ(ierr);
3124 
3125   ierr = VecGetArray(originalVec, &originalValues);CHKERRQ(ierr);
3126   ierr = VecGetArray(newVec, &newValues);CHKERRQ(ierr);
3127   ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
3128   ierr = PetscSFBcastBegin(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3129   ierr = PetscSFBcastEnd(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
3130   ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
3131   ierr = VecRestoreArray(newVec, &newValues);CHKERRQ(ierr);
3132   ierr = VecRestoreArray(originalVec, &originalValues);CHKERRQ(ierr);
3133   PetscFunctionReturn(0);
3134 }
3135 
3136 #undef __FUNCT__
3137 #define __FUNCT__ "DMPlexDistribute"
3138 /*@C
3139   DMPlexDistribute - Distributes the mesh and any associated sections.
3140 
3141   Not Collective
3142 
3143   Input Parameter:
3144 + dm  - The original DMPlex object
3145 . partitioner - The partitioning package, or NULL for the default
3146 - overlap - The overlap of partitions, 0 is the default
3147 
3148   Output Parameter:
3149 . parallelMesh - The distributed DMPlex object, or NULL
3150 
3151   Note: If the mesh was not distributed, the return value is NULL
3152 
3153   Level: intermediate
3154 
3155 .keywords: mesh, elements
3156 .seealso: DMPlexCreate(), DMPlexDistributeByFace()
3157 @*/
3158 PetscErrorCode DMPlexDistribute(DM dm, const char partitioner[], PetscInt overlap, DM *dmParallel)
3159 {
3160   DM_Plex               *mesh   = (DM_Plex*) dm->data, *pmesh;
3161   MPI_Comm               comm;
3162   const PetscInt         height = 0;
3163   PetscInt               dim, numRemoteRanks;
3164   IS                     origCellPart,        cellPart,        part;
3165   PetscSection           origCellPartSection, cellPartSection, partSection;
3166   PetscSFNode           *remoteRanks;
3167   PetscSF                partSF, pointSF, coneSF;
3168   ISLocalToGlobalMapping renumbering;
3169   PetscSection           originalConeSection, newConeSection;
3170   PetscInt              *remoteOffsets;
3171   PetscInt              *cones, *newCones, newConesSize;
3172   PetscBool              flg;
3173   PetscMPIInt            rank, numProcs, p;
3174   PetscErrorCode         ierr;
3175 
3176   PetscFunctionBegin;
3177   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3178   PetscValidPointer(dmParallel,4);
3179 
3180   ierr = PetscLogEventBegin(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3181   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3182   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3183   ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
3184 
3185   *dmParallel = NULL;
3186   if (numProcs == 1) PetscFunctionReturn(0);
3187 
3188   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
3189   /* Create cell partition - We need to rewrite to use IS, use the MatPartition stuff */
3190   if (overlap > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Overlap > 1 not yet implemented");
3191   ierr = DMPlexCreatePartition(dm, height, overlap > 0 ? PETSC_TRUE : PETSC_FALSE, &cellPartSection, &cellPart, &origCellPartSection, &origCellPart);CHKERRQ(ierr);
3192   /* Create SF assuming a serial partition for all processes: Could check for IS length here */
3193   if (!rank) numRemoteRanks = numProcs;
3194   else       numRemoteRanks = 0;
3195   ierr = PetscMalloc(numRemoteRanks * sizeof(PetscSFNode), &remoteRanks);CHKERRQ(ierr);
3196   for (p = 0; p < numRemoteRanks; ++p) {
3197     remoteRanks[p].rank  = p;
3198     remoteRanks[p].index = 0;
3199   }
3200   ierr = PetscSFCreate(comm, &partSF);CHKERRQ(ierr);
3201   ierr = PetscSFSetGraph(partSF, 1, numRemoteRanks, NULL, PETSC_OWN_POINTER, remoteRanks, PETSC_OWN_POINTER);CHKERRQ(ierr);
3202   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-partition_view", &flg);CHKERRQ(ierr);
3203   if (flg) {
3204     ierr = PetscPrintf(comm, "Cell Partition:\n");CHKERRQ(ierr);
3205     ierr = PetscSectionView(cellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3206     ierr = ISView(cellPart, NULL);CHKERRQ(ierr);
3207     if (origCellPart) {
3208       ierr = PetscPrintf(comm, "Original Cell Partition:\n");CHKERRQ(ierr);
3209       ierr = PetscSectionView(origCellPartSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3210       ierr = ISView(origCellPart, NULL);CHKERRQ(ierr);
3211     }
3212     ierr = PetscSFView(partSF, NULL);CHKERRQ(ierr);
3213   }
3214   /* Close the partition over the mesh */
3215   ierr = DMPlexCreatePartitionClosure(dm, cellPartSection, cellPart, &partSection, &part);CHKERRQ(ierr);
3216   ierr = ISDestroy(&cellPart);CHKERRQ(ierr);
3217   ierr = PetscSectionDestroy(&cellPartSection);CHKERRQ(ierr);
3218   /* Create new mesh */
3219   ierr  = DMPlexCreate(comm, dmParallel);CHKERRQ(ierr);
3220   ierr  = DMPlexSetDimension(*dmParallel, dim);CHKERRQ(ierr);
3221   ierr  = PetscObjectSetName((PetscObject) *dmParallel, "Parallel Mesh");CHKERRQ(ierr);
3222   pmesh = (DM_Plex*) (*dmParallel)->data;
3223   /* Distribute sieve points and the global point numbering (replaces creating remote bases) */
3224   ierr = PetscSFConvertPartition(partSF, partSection, part, &renumbering, &pointSF);CHKERRQ(ierr);
3225   if (flg) {
3226     ierr = PetscPrintf(comm, "Point Partition:\n");CHKERRQ(ierr);
3227     ierr = PetscSectionView(partSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3228     ierr = ISView(part, NULL);CHKERRQ(ierr);
3229     ierr = PetscSFView(pointSF, NULL);CHKERRQ(ierr);
3230     ierr = PetscPrintf(comm, "Point Renumbering after partition:\n");CHKERRQ(ierr);
3231     ierr = ISLocalToGlobalMappingView(renumbering, NULL);CHKERRQ(ierr);
3232   }
3233   /* Distribute cone section */
3234   ierr = DMPlexGetConeSection(dm, &originalConeSection);CHKERRQ(ierr);
3235   ierr = DMPlexGetConeSection(*dmParallel, &newConeSection);CHKERRQ(ierr);
3236   ierr = PetscSFDistributeSection(pointSF, originalConeSection, &remoteOffsets, newConeSection);CHKERRQ(ierr);
3237   ierr = DMSetUp(*dmParallel);CHKERRQ(ierr);
3238   {
3239     PetscInt pStart, pEnd, p;
3240 
3241     ierr = PetscSectionGetChart(newConeSection, &pStart, &pEnd);CHKERRQ(ierr);
3242     for (p = pStart; p < pEnd; ++p) {
3243       PetscInt coneSize;
3244       ierr               = PetscSectionGetDof(newConeSection, p, &coneSize);CHKERRQ(ierr);
3245       pmesh->maxConeSize = PetscMax(pmesh->maxConeSize, coneSize);
3246     }
3247   }
3248   /* Communicate and renumber cones */
3249   ierr = PetscSFCreateSectionSF(pointSF, originalConeSection, remoteOffsets, newConeSection, &coneSF);CHKERRQ(ierr);
3250   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
3251   ierr = DMPlexGetCones(*dmParallel, &newCones);CHKERRQ(ierr);
3252   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3253   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3254   ierr = PetscSectionGetStorageSize(newConeSection, &newConesSize);CHKERRQ(ierr);
3255   ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newConesSize, newCones, NULL, newCones);CHKERRQ(ierr);
3256   ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-cones_view", &flg);CHKERRQ(ierr);
3257   if (flg) {
3258     ierr = PetscPrintf(comm, "Serial Cone Section:\n");CHKERRQ(ierr);
3259     ierr = PetscSectionView(originalConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3260     ierr = PetscPrintf(comm, "Parallel Cone Section:\n");CHKERRQ(ierr);
3261     ierr = PetscSectionView(newConeSection, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
3262     ierr = PetscSFView(coneSF, NULL);CHKERRQ(ierr);
3263   }
3264   ierr = DMPlexGetConeOrientations(dm, &cones);CHKERRQ(ierr);
3265   ierr = DMPlexGetConeOrientations(*dmParallel, &newCones);CHKERRQ(ierr);
3266   ierr = PetscSFBcastBegin(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3267   ierr = PetscSFBcastEnd(coneSF, MPIU_INT, cones, newCones);CHKERRQ(ierr);
3268   ierr = PetscSFDestroy(&coneSF);CHKERRQ(ierr);
3269   /* Create supports and stratify sieve */
3270   {
3271     PetscInt pStart, pEnd;
3272 
3273     ierr = PetscSectionGetChart(pmesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
3274     ierr = PetscSectionSetChart(pmesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
3275   }
3276   ierr = DMPlexSymmetrize(*dmParallel);CHKERRQ(ierr);
3277   ierr = DMPlexStratify(*dmParallel);CHKERRQ(ierr);
3278   /* Distribute Coordinates */
3279   {
3280     PetscSection originalCoordSection, newCoordSection;
3281     Vec          originalCoordinates, newCoordinates;
3282     const char  *name;
3283 
3284     ierr = DMPlexGetCoordinateSection(dm, &originalCoordSection);CHKERRQ(ierr);
3285     ierr = DMPlexGetCoordinateSection(*dmParallel, &newCoordSection);CHKERRQ(ierr);
3286     ierr = DMGetCoordinatesLocal(dm, &originalCoordinates);CHKERRQ(ierr);
3287     ierr = VecCreate(comm, &newCoordinates);CHKERRQ(ierr);
3288     ierr = PetscObjectGetName((PetscObject) originalCoordinates, &name);CHKERRQ(ierr);
3289     ierr = PetscObjectSetName((PetscObject) newCoordinates, name);CHKERRQ(ierr);
3290 
3291     ierr = DMPlexDistributeField(dm, pointSF, originalCoordSection, originalCoordinates, newCoordSection, newCoordinates);CHKERRQ(ierr);
3292     ierr = DMSetCoordinatesLocal(*dmParallel, newCoordinates);CHKERRQ(ierr);
3293     ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr);
3294   }
3295   /* Distribute labels */
3296   {
3297     DMLabel  next      = mesh->labels, newNext = pmesh->labels;
3298     PetscInt numLabels = 0, l;
3299 
3300     /* Bcast number of labels */
3301     while (next) {
3302       ++numLabels; next = next->next;
3303     }
3304     ierr = MPI_Bcast(&numLabels, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3305     next = mesh->labels;
3306     for (l = 0; l < numLabels; ++l) {
3307       DMLabel         newLabel;
3308       const PetscInt *partArray;
3309       char           *name;
3310       PetscInt       *stratumSizes = NULL, *points = NULL;
3311       PetscMPIInt    *sendcnts     = NULL, *offsets = NULL, *displs = NULL;
3312       PetscInt        nameSize, s, p;
3313       PetscBool       isdepth;
3314       size_t          len = 0;
3315 
3316       /* Bcast name (could filter for no points) */
3317       if (!rank) {ierr = PetscStrlen(next->name, &len);CHKERRQ(ierr);}
3318       nameSize = len;
3319       ierr     = MPI_Bcast(&nameSize, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3320       ierr     = PetscMalloc(nameSize+1, &name);CHKERRQ(ierr);
3321       if (!rank) {ierr = PetscMemcpy(name, next->name, nameSize+1);CHKERRQ(ierr);}
3322       ierr = MPI_Bcast(name, nameSize+1, MPI_CHAR, 0, comm);CHKERRQ(ierr);
3323       ierr = PetscStrcmp(name, "depth", &isdepth);CHKERRQ(ierr);
3324       if (isdepth) {ierr = PetscFree(name);CHKERRQ(ierr); continue;}
3325       ierr           = PetscNew(struct _n_DMLabel, &newLabel);CHKERRQ(ierr);
3326       newLabel->name = name;
3327       /* Bcast numStrata (could filter for no points in stratum) */
3328       if (!rank) newLabel->numStrata = next->numStrata;
3329       ierr = MPI_Bcast(&newLabel->numStrata, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
3330       ierr = PetscMalloc3(newLabel->numStrata,PetscInt,&newLabel->stratumValues,
3331                           newLabel->numStrata,PetscInt,&newLabel->stratumSizes,
3332                           newLabel->numStrata+1,PetscInt,&newLabel->stratumOffsets);CHKERRQ(ierr);
3333       /* Bcast stratumValues (could filter for no points in stratum) */
3334       if (!rank) {ierr = PetscMemcpy(newLabel->stratumValues, next->stratumValues, next->numStrata * sizeof(PetscInt));CHKERRQ(ierr);}
3335       ierr = MPI_Bcast(newLabel->stratumValues, newLabel->numStrata, MPIU_INT, 0, comm);CHKERRQ(ierr);
3336       /* Find size on each process and Scatter */
3337       if (!rank) {
3338         ierr = ISGetIndices(part, &partArray);CHKERRQ(ierr);
3339         ierr = PetscMalloc(numProcs*next->numStrata * sizeof(PetscInt), &stratumSizes);CHKERRQ(ierr);
3340         ierr = PetscMemzero(stratumSizes, numProcs*next->numStrata * sizeof(PetscInt));CHKERRQ(ierr);
3341         for (s = 0; s < next->numStrata; ++s) {
3342           for (p = next->stratumOffsets[s]; p < next->stratumOffsets[s]+next->stratumSizes[s]; ++p) {
3343             const PetscInt point = next->points[p];
3344             PetscInt       proc;
3345 
3346             for (proc = 0; proc < numProcs; ++proc) {
3347               PetscInt dof, off, pPart;
3348 
3349               ierr = PetscSectionGetDof(partSection, proc, &dof);CHKERRQ(ierr);
3350               ierr = PetscSectionGetOffset(partSection, proc, &off);CHKERRQ(ierr);
3351               for (pPart = off; pPart < off+dof; ++pPart) {
3352                 if (partArray[pPart] == point) {
3353                   ++stratumSizes[proc*next->numStrata+s];
3354                   break;
3355                 }
3356               }
3357             }
3358           }
3359         }
3360         ierr = ISRestoreIndices(part, &partArray);CHKERRQ(ierr);
3361       }
3362       ierr = MPI_Scatter(stratumSizes, newLabel->numStrata, MPIU_INT, newLabel->stratumSizes, newLabel->numStrata, MPIU_INT, 0, comm);CHKERRQ(ierr);
3363       /* Calculate stratumOffsets */
3364       newLabel->stratumOffsets[0] = 0;
3365       for (s = 0; s < newLabel->numStrata; ++s) {
3366         newLabel->stratumOffsets[s+1] = newLabel->stratumSizes[s] + newLabel->stratumOffsets[s];
3367       }
3368       /* Pack points and Scatter */
3369       if (!rank) {
3370         ierr = PetscMalloc3(numProcs,PetscMPIInt,&sendcnts,numProcs,PetscMPIInt,&offsets,numProcs+1,PetscMPIInt,&displs);CHKERRQ(ierr);
3371         displs[0] = 0;
3372         for (p = 0; p < numProcs; ++p) {
3373           sendcnts[p] = 0;
3374           for (s = 0; s < next->numStrata; ++s) {
3375             sendcnts[p] += stratumSizes[p*next->numStrata+s];
3376           }
3377           offsets[p]  = displs[p];
3378           displs[p+1] = displs[p] + sendcnts[p];
3379         }
3380         ierr = PetscMalloc(displs[numProcs] * sizeof(PetscInt), &points);CHKERRQ(ierr);
3381         for (s = 0; s < next->numStrata; ++s) {
3382           for (p = next->stratumOffsets[s]; p < next->stratumOffsets[s]+next->stratumSizes[s]; ++p) {
3383             const PetscInt point = next->points[p];
3384             PetscInt       proc;
3385 
3386             for (proc = 0; proc < numProcs; ++proc) {
3387               PetscInt dof, off, pPart;
3388 
3389               ierr = PetscSectionGetDof(partSection, proc, &dof);CHKERRQ(ierr);
3390               ierr = PetscSectionGetOffset(partSection, proc, &off);CHKERRQ(ierr);
3391               for (pPart = off; pPart < off+dof; ++pPart) {
3392                 if (partArray[pPart] == point) {
3393                   points[offsets[proc]++] = point;
3394                   break;
3395                 }
3396               }
3397             }
3398           }
3399         }
3400       }
3401       ierr = PetscMalloc(newLabel->stratumOffsets[newLabel->numStrata] * sizeof(PetscInt), &newLabel->points);CHKERRQ(ierr);
3402       ierr = MPI_Scatterv(points, sendcnts, displs, MPIU_INT, newLabel->points, newLabel->stratumOffsets[newLabel->numStrata], MPIU_INT, 0, comm);CHKERRQ(ierr);
3403       ierr = PetscFree(points);CHKERRQ(ierr);
3404       ierr = PetscFree3(sendcnts,offsets,displs);CHKERRQ(ierr);
3405       ierr = PetscFree(stratumSizes);CHKERRQ(ierr);
3406       /* Renumber points */
3407       ierr = ISGlobalToLocalMappingApply(renumbering, IS_GTOLM_MASK, newLabel->stratumOffsets[newLabel->numStrata], newLabel->points, NULL, newLabel->points);CHKERRQ(ierr);
3408       /* Sort points */
3409       for (s = 0; s < newLabel->numStrata; ++s) {
3410         ierr = PetscSortInt(newLabel->stratumSizes[s], &newLabel->points[newLabel->stratumOffsets[s]]);CHKERRQ(ierr);
3411       }
3412       /* Insert into list */
3413       if (newNext) newNext->next = newLabel;
3414       else pmesh->labels = newLabel;
3415       newNext = newLabel;
3416       if (!rank) next = next->next;
3417     }
3418   }
3419   /* Cleanup Partition */
3420   ierr = ISLocalToGlobalMappingDestroy(&renumbering);CHKERRQ(ierr);
3421   ierr = PetscSFDestroy(&partSF);CHKERRQ(ierr);
3422   ierr = PetscSectionDestroy(&partSection);CHKERRQ(ierr);
3423   ierr = ISDestroy(&part);CHKERRQ(ierr);
3424   /* Create point SF for parallel mesh */
3425   {
3426     const PetscInt *leaves;
3427     PetscSFNode    *remotePoints, *rowners, *lowners;
3428     PetscInt        numRoots, numLeaves, numGhostPoints = 0, p, gp, *ghostPoints;
3429     PetscInt        pStart, pEnd;
3430 
3431     ierr = DMPlexGetChart(*dmParallel, &pStart, &pEnd);CHKERRQ(ierr);
3432     ierr = PetscSFGetGraph(pointSF, &numRoots, &numLeaves, &leaves, NULL);CHKERRQ(ierr);
3433     ierr = PetscMalloc2(numRoots,PetscSFNode,&rowners,numLeaves,PetscSFNode,&lowners);CHKERRQ(ierr);
3434     for (p=0; p<numRoots; p++) {
3435       rowners[p].rank  = -1;
3436       rowners[p].index = -1;
3437     }
3438     if (origCellPart) {
3439       /* Make sure cells in the original partition are not assigned to other procs */
3440       const PetscInt *origCells;
3441 
3442       ierr = ISGetIndices(origCellPart, &origCells);CHKERRQ(ierr);
3443       for (p = 0; p < numProcs; ++p) {
3444         PetscInt dof, off, d;
3445 
3446         ierr = PetscSectionGetDof(origCellPartSection, p, &dof);CHKERRQ(ierr);
3447         ierr = PetscSectionGetOffset(origCellPartSection, p, &off);CHKERRQ(ierr);
3448         for (d = off; d < off+dof; ++d) {
3449           rowners[origCells[d]].rank = p;
3450         }
3451       }
3452       ierr = ISRestoreIndices(origCellPart, &origCells);CHKERRQ(ierr);
3453     }
3454     ierr = ISDestroy(&origCellPart);CHKERRQ(ierr);
3455     ierr = PetscSectionDestroy(&origCellPartSection);CHKERRQ(ierr);
3456 
3457     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3458     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3459     for (p = 0; p < numLeaves; ++p) {
3460       if (lowners[p].rank < 0 || lowners[p].rank == rank) { /* Either put in a bid or we know we own it */
3461         lowners[p].rank  = rank;
3462         lowners[p].index = leaves ? leaves[p] : p;
3463       } else if (lowners[p].rank >= 0) { /* Point already claimed so flag so that MAXLOC does not listen to us */
3464         lowners[p].rank  = -2;
3465         lowners[p].index = -2;
3466       }
3467     }
3468     for (p=0; p<numRoots; p++) { /* Root must not participate in the rediction, flag so that MAXLOC does not use */
3469       rowners[p].rank  = -3;
3470       rowners[p].index = -3;
3471     }
3472     ierr = PetscSFReduceBegin(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3473     ierr = PetscSFReduceEnd(pointSF, MPIU_2INT, lowners, rowners, MPI_MAXLOC);CHKERRQ(ierr);
3474     ierr = PetscSFBcastBegin(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3475     ierr = PetscSFBcastEnd(pointSF, MPIU_2INT, rowners, lowners);CHKERRQ(ierr);
3476     for (p = 0; p < numLeaves; ++p) {
3477       if (lowners[p].rank < 0 || lowners[p].index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cell partition corrupt: point not claimed");
3478       if (lowners[p].rank != rank) ++numGhostPoints;
3479     }
3480     ierr = PetscMalloc(numGhostPoints * sizeof(PetscInt),    &ghostPoints);CHKERRQ(ierr);
3481     ierr = PetscMalloc(numGhostPoints * sizeof(PetscSFNode), &remotePoints);CHKERRQ(ierr);
3482     for (p = 0, gp = 0; p < numLeaves; ++p) {
3483       if (lowners[p].rank != rank) {
3484         ghostPoints[gp]        = leaves ? leaves[p] : p;
3485         remotePoints[gp].rank  = lowners[p].rank;
3486         remotePoints[gp].index = lowners[p].index;
3487         ++gp;
3488       }
3489     }
3490     ierr = PetscFree2(rowners,lowners);CHKERRQ(ierr);
3491     ierr = PetscSFSetGraph((*dmParallel)->sf, pEnd - pStart, numGhostPoints, ghostPoints, PETSC_OWN_POINTER, remotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
3492     ierr = PetscSFSetFromOptions((*dmParallel)->sf);CHKERRQ(ierr);
3493   }
3494   /* Cleanup */
3495   ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr);
3496   ierr = DMSetFromOptions(*dmParallel);CHKERRQ(ierr);
3497   ierr = PetscLogEventEnd(DMPLEX_Distribute,dm,0,0,0);CHKERRQ(ierr);
3498   PetscFunctionReturn(0);
3499 }
3500 
3501 #if defined(PETSC_HAVE_TRIANGLE)
3502 #include <triangle.h>
3503 
3504 #undef __FUNCT__
3505 #define __FUNCT__ "InitInput_Triangle"
3506 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3507 {
3508   PetscFunctionBegin;
3509   inputCtx->numberofpoints             = 0;
3510   inputCtx->numberofpointattributes    = 0;
3511   inputCtx->pointlist                  = NULL;
3512   inputCtx->pointattributelist         = NULL;
3513   inputCtx->pointmarkerlist            = NULL;
3514   inputCtx->numberofsegments           = 0;
3515   inputCtx->segmentlist                = NULL;
3516   inputCtx->segmentmarkerlist          = NULL;
3517   inputCtx->numberoftriangleattributes = 0;
3518   inputCtx->trianglelist               = NULL;
3519   inputCtx->numberofholes              = 0;
3520   inputCtx->holelist                   = NULL;
3521   inputCtx->numberofregions            = 0;
3522   inputCtx->regionlist                 = NULL;
3523   PetscFunctionReturn(0);
3524 }
3525 
3526 #undef __FUNCT__
3527 #define __FUNCT__ "InitOutput_Triangle"
3528 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3529 {
3530   PetscFunctionBegin;
3531   outputCtx->numberofpoints        = 0;
3532   outputCtx->pointlist             = NULL;
3533   outputCtx->pointattributelist    = NULL;
3534   outputCtx->pointmarkerlist       = NULL;
3535   outputCtx->numberoftriangles     = 0;
3536   outputCtx->trianglelist          = NULL;
3537   outputCtx->triangleattributelist = NULL;
3538   outputCtx->neighborlist          = NULL;
3539   outputCtx->segmentlist           = NULL;
3540   outputCtx->segmentmarkerlist     = NULL;
3541   outputCtx->numberofedges         = 0;
3542   outputCtx->edgelist              = NULL;
3543   outputCtx->edgemarkerlist        = NULL;
3544   PetscFunctionReturn(0);
3545 }
3546 
3547 #undef __FUNCT__
3548 #define __FUNCT__ "FiniOutput_Triangle"
3549 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3550 {
3551   PetscFunctionBegin;
3552   free(outputCtx->pointmarkerlist);
3553   free(outputCtx->edgelist);
3554   free(outputCtx->edgemarkerlist);
3555   free(outputCtx->trianglelist);
3556   free(outputCtx->neighborlist);
3557   PetscFunctionReturn(0);
3558 }
3559 
3560 #undef __FUNCT__
3561 #define __FUNCT__ "DMPlexGenerate_Triangle"
3562 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3563 {
3564   MPI_Comm             comm;
3565   PetscInt             dim              = 2;
3566   const PetscBool      createConvexHull = PETSC_FALSE;
3567   const PetscBool      constrained      = PETSC_FALSE;
3568   struct triangulateio in;
3569   struct triangulateio out;
3570   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3571   PetscMPIInt          rank;
3572   PetscErrorCode       ierr;
3573 
3574   PetscFunctionBegin;
3575   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3576   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3577   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3578   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3579   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3580 
3581   in.numberofpoints = vEnd - vStart;
3582   if (in.numberofpoints > 0) {
3583     PetscSection coordSection;
3584     Vec          coordinates;
3585     PetscScalar *array;
3586 
3587     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3588     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3589     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3590     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3591     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3592     for (v = vStart; v < vEnd; ++v) {
3593       const PetscInt idx = v - vStart;
3594       PetscInt       off, d;
3595 
3596       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3597       for (d = 0; d < dim; ++d) {
3598         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3599       }
3600       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3601     }
3602     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3603   }
3604   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3605   in.numberofsegments = eEnd - eStart;
3606   if (in.numberofsegments > 0) {
3607     ierr = PetscMalloc(in.numberofsegments*2 * sizeof(int), &in.segmentlist);CHKERRQ(ierr);
3608     ierr = PetscMalloc(in.numberofsegments   * sizeof(int), &in.segmentmarkerlist);CHKERRQ(ierr);
3609     for (e = eStart; e < eEnd; ++e) {
3610       const PetscInt  idx = e - eStart;
3611       const PetscInt *cone;
3612 
3613       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3614 
3615       in.segmentlist[idx*2+0] = cone[0] - vStart;
3616       in.segmentlist[idx*2+1] = cone[1] - vStart;
3617 
3618       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3619     }
3620   }
3621 #if 0 /* Do not currently support holes */
3622   PetscReal *holeCoords;
3623   PetscInt   h, d;
3624 
3625   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3626   if (in.numberofholes > 0) {
3627     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3628     for (h = 0; h < in.numberofholes; ++h) {
3629       for (d = 0; d < dim; ++d) {
3630         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3631       }
3632     }
3633   }
3634 #endif
3635   if (!rank) {
3636     char args[32];
3637 
3638     /* Take away 'Q' for verbose output */
3639     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3640     if (createConvexHull) {
3641       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3642     }
3643     if (constrained) {
3644       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3645     }
3646     triangulate(args, &in, &out, NULL);
3647   }
3648   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3649   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3650   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3651   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3652   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3653 
3654   {
3655     const PetscInt numCorners  = 3;
3656     const PetscInt numCells    = out.numberoftriangles;
3657     const PetscInt numVertices = out.numberofpoints;
3658     const int     *cells      = out.trianglelist;
3659     const double  *meshCoords = out.pointlist;
3660 
3661     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3662     /* Set labels */
3663     for (v = 0; v < numVertices; ++v) {
3664       if (out.pointmarkerlist[v]) {
3665         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3666       }
3667     }
3668     if (interpolate) {
3669       for (e = 0; e < out.numberofedges; e++) {
3670         if (out.edgemarkerlist[e]) {
3671           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3672           const PetscInt *edges;
3673           PetscInt        numEdges;
3674 
3675           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3676           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3677           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3678           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3679         }
3680       }
3681     }
3682     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3683   }
3684 #if 0 /* Do not currently support holes */
3685   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3686 #endif
3687   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3688   PetscFunctionReturn(0);
3689 }
3690 
3691 #undef __FUNCT__
3692 #define __FUNCT__ "DMPlexRefine_Triangle"
3693 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3694 {
3695   MPI_Comm             comm;
3696   PetscInt             dim  = 2;
3697   struct triangulateio in;
3698   struct triangulateio out;
3699   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3700   PetscMPIInt          rank;
3701   PetscErrorCode       ierr;
3702 
3703   PetscFunctionBegin;
3704   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3705   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3706   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3707   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3708   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3709   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3710   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3711 
3712   in.numberofpoints = vEnd - vStart;
3713   if (in.numberofpoints > 0) {
3714     PetscSection coordSection;
3715     Vec          coordinates;
3716     PetscScalar *array;
3717 
3718     ierr = PetscMalloc(in.numberofpoints*dim * sizeof(double), &in.pointlist);CHKERRQ(ierr);
3719     ierr = PetscMalloc(in.numberofpoints * sizeof(int), &in.pointmarkerlist);CHKERRQ(ierr);
3720     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3721     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3722     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3723     for (v = vStart; v < vEnd; ++v) {
3724       const PetscInt idx = v - vStart;
3725       PetscInt       off, d;
3726 
3727       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3728       for (d = 0; d < dim; ++d) {
3729         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3730       }
3731       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3732     }
3733     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3734   }
3735   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3736 
3737   in.numberofcorners   = 3;
3738   in.numberoftriangles = cEnd - cStart;
3739 
3740   in.trianglearealist  = (double*) maxVolumes;
3741   if (in.numberoftriangles > 0) {
3742     ierr = PetscMalloc(in.numberoftriangles*in.numberofcorners * sizeof(int), &in.trianglelist);CHKERRQ(ierr);
3743     for (c = cStart; c < cEnd; ++c) {
3744       const PetscInt idx      = c - cStart;
3745       PetscInt      *closure = NULL;
3746       PetscInt       closureSize;
3747 
3748       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3749       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3750       for (v = 0; v < 3; ++v) {
3751         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3752       }
3753       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3754     }
3755   }
3756   /* TODO: Segment markers are missing on input */
3757 #if 0 /* Do not currently support holes */
3758   PetscReal *holeCoords;
3759   PetscInt   h, d;
3760 
3761   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3762   if (in.numberofholes > 0) {
3763     ierr = PetscMalloc(in.numberofholes*dim * sizeof(double), &in.holelist);CHKERRQ(ierr);
3764     for (h = 0; h < in.numberofholes; ++h) {
3765       for (d = 0; d < dim; ++d) {
3766         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3767       }
3768     }
3769   }
3770 #endif
3771   if (!rank) {
3772     char args[32];
3773 
3774     /* Take away 'Q' for verbose output */
3775     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3776     triangulate(args, &in, &out, NULL);
3777   }
3778   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3779   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3780   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3781   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3782   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3783 
3784   {
3785     const PetscInt numCorners  = 3;
3786     const PetscInt numCells    = out.numberoftriangles;
3787     const PetscInt numVertices = out.numberofpoints;
3788     const int     *cells      = out.trianglelist;
3789     const double  *meshCoords = out.pointlist;
3790     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3791 
3792     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3793     /* Set labels */
3794     for (v = 0; v < numVertices; ++v) {
3795       if (out.pointmarkerlist[v]) {
3796         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3797       }
3798     }
3799     if (interpolate) {
3800       PetscInt e;
3801 
3802       for (e = 0; e < out.numberofedges; e++) {
3803         if (out.edgemarkerlist[e]) {
3804           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3805           const PetscInt *edges;
3806           PetscInt        numEdges;
3807 
3808           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3809           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3810           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3811           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3812         }
3813       }
3814     }
3815     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3816   }
3817 #if 0 /* Do not currently support holes */
3818   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3819 #endif
3820   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3821   PetscFunctionReturn(0);
3822 }
3823 #endif
3824 
3825 #if defined(PETSC_HAVE_TETGEN)
3826 #include <tetgen.h>
3827 #undef __FUNCT__
3828 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3829 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3830 {
3831   MPI_Comm       comm;
3832   const PetscInt dim  = 3;
3833   ::tetgenio     in;
3834   ::tetgenio     out;
3835   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3836   PetscMPIInt    rank;
3837   PetscErrorCode ierr;
3838 
3839   PetscFunctionBegin;
3840   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3841   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3842   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3843   in.numberofpoints = vEnd - vStart;
3844   if (in.numberofpoints > 0) {
3845     PetscSection coordSection;
3846     Vec          coordinates;
3847     PetscScalar *array;
3848 
3849     in.pointlist       = new double[in.numberofpoints*dim];
3850     in.pointmarkerlist = new int[in.numberofpoints];
3851 
3852     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3853     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3854     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3855     for (v = vStart; v < vEnd; ++v) {
3856       const PetscInt idx = v - vStart;
3857       PetscInt       off, d;
3858 
3859       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3860       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3861       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3862     }
3863     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3864   }
3865   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3866 
3867   in.numberoffacets = fEnd - fStart;
3868   if (in.numberoffacets > 0) {
3869     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3870     in.facetmarkerlist = new int[in.numberoffacets];
3871     for (f = fStart; f < fEnd; ++f) {
3872       const PetscInt idx     = f - fStart;
3873       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3874 
3875       in.facetlist[idx].numberofpolygons = 1;
3876       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3877       in.facetlist[idx].numberofholes    = 0;
3878       in.facetlist[idx].holelist         = NULL;
3879 
3880       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3881       for (p = 0; p < numPoints*2; p += 2) {
3882         const PetscInt point = points[p];
3883         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3884       }
3885 
3886       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3887       poly->numberofvertices = numVertices;
3888       poly->vertexlist       = new int[poly->numberofvertices];
3889       for (v = 0; v < numVertices; ++v) {
3890         const PetscInt vIdx = points[v] - vStart;
3891         poly->vertexlist[v] = vIdx;
3892       }
3893       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3894       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3895     }
3896   }
3897   if (!rank) {
3898     char args[32];
3899 
3900     /* Take away 'Q' for verbose output */
3901     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3902     ::tetrahedralize(args, &in, &out);
3903   }
3904   {
3905     const PetscInt numCorners  = 4;
3906     const PetscInt numCells    = out.numberoftetrahedra;
3907     const PetscInt numVertices = out.numberofpoints;
3908     const int     *cells      = out.tetrahedronlist;
3909     const double  *meshCoords = out.pointlist;
3910 
3911     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3912     /* Set labels */
3913     for (v = 0; v < numVertices; ++v) {
3914       if (out.pointmarkerlist[v]) {
3915         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3916       }
3917     }
3918     if (interpolate) {
3919       PetscInt e;
3920 
3921       for (e = 0; e < out.numberofedges; e++) {
3922         if (out.edgemarkerlist[e]) {
3923           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3924           const PetscInt *edges;
3925           PetscInt        numEdges;
3926 
3927           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3928           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3929           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3930           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3931         }
3932       }
3933       for (f = 0; f < out.numberoftrifaces; f++) {
3934         if (out.trifacemarkerlist[f]) {
3935           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3936           const PetscInt *faces;
3937           PetscInt        numFaces;
3938 
3939           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3940           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3941           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3942           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3943         }
3944       }
3945     }
3946     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3947   }
3948   PetscFunctionReturn(0);
3949 }
3950 
3951 #undef __FUNCT__
3952 #define __FUNCT__ "DMPlexRefine_Tetgen"
3953 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3954 {
3955   MPI_Comm       comm;
3956   const PetscInt dim  = 3;
3957   ::tetgenio     in;
3958   ::tetgenio     out;
3959   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3960   PetscMPIInt    rank;
3961   PetscErrorCode ierr;
3962 
3963   PetscFunctionBegin;
3964   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3965   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3966   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3967   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3968   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3969 
3970   in.numberofpoints = vEnd - vStart;
3971   if (in.numberofpoints > 0) {
3972     PetscSection coordSection;
3973     Vec          coordinates;
3974     PetscScalar *array;
3975 
3976     in.pointlist       = new double[in.numberofpoints*dim];
3977     in.pointmarkerlist = new int[in.numberofpoints];
3978 
3979     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3980     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3981     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3982     for (v = vStart; v < vEnd; ++v) {
3983       const PetscInt idx = v - vStart;
3984       PetscInt       off, d;
3985 
3986       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3987       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3988       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3989     }
3990     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3991   }
3992   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3993 
3994   in.numberofcorners       = 4;
3995   in.numberoftetrahedra    = cEnd - cStart;
3996   in.tetrahedronvolumelist = (double*) maxVolumes;
3997   if (in.numberoftetrahedra > 0) {
3998     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3999     for (c = cStart; c < cEnd; ++c) {
4000       const PetscInt idx      = c - cStart;
4001       PetscInt      *closure = NULL;
4002       PetscInt       closureSize;
4003 
4004       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4005       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4006       for (v = 0; v < 4; ++v) {
4007         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4008       }
4009       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4010     }
4011   }
4012   /* TODO: Put in boundary faces with markers */
4013   if (!rank) {
4014     char args[32];
4015 
4016     /* Take away 'Q' for verbose output */
4017     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
4018     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
4019     ::tetrahedralize(args, &in, &out);
4020   }
4021   in.tetrahedronvolumelist = NULL;
4022 
4023   {
4024     const PetscInt numCorners  = 4;
4025     const PetscInt numCells    = out.numberoftetrahedra;
4026     const PetscInt numVertices = out.numberofpoints;
4027     const int     *cells      = out.tetrahedronlist;
4028     const double  *meshCoords = out.pointlist;
4029     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4030 
4031     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4032     /* Set labels */
4033     for (v = 0; v < numVertices; ++v) {
4034       if (out.pointmarkerlist[v]) {
4035         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
4036       }
4037     }
4038     if (interpolate) {
4039       PetscInt e, f;
4040 
4041       for (e = 0; e < out.numberofedges; e++) {
4042         if (out.edgemarkerlist[e]) {
4043           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
4044           const PetscInt *edges;
4045           PetscInt        numEdges;
4046 
4047           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4048           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4049           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
4050           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4051         }
4052       }
4053       for (f = 0; f < out.numberoftrifaces; f++) {
4054         if (out.trifacemarkerlist[f]) {
4055           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
4056           const PetscInt *faces;
4057           PetscInt        numFaces;
4058 
4059           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4060           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4061           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
4062           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4063         }
4064       }
4065     }
4066     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4067   }
4068   PetscFunctionReturn(0);
4069 }
4070 #endif
4071 
4072 #if defined(PETSC_HAVE_CTETGEN)
4073 #include "ctetgen.h"
4074 
4075 #undef __FUNCT__
4076 #define __FUNCT__ "DMPlexGenerate_CTetgen"
4077 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
4078 {
4079   MPI_Comm       comm;
4080   const PetscInt dim  = 3;
4081   PLC           *in, *out;
4082   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
4083   PetscMPIInt    rank;
4084   PetscErrorCode ierr;
4085 
4086   PetscFunctionBegin;
4087   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
4088   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4089   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4090   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
4091   ierr = PLCCreate(&in);CHKERRQ(ierr);
4092   ierr = PLCCreate(&out);CHKERRQ(ierr);
4093 
4094   in->numberofpoints = vEnd - vStart;
4095   if (in->numberofpoints > 0) {
4096     PetscSection coordSection;
4097     Vec          coordinates;
4098     PetscScalar *array;
4099 
4100     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
4101     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
4102     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
4103     ierr = DMPlexGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
4104     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4105     for (v = vStart; v < vEnd; ++v) {
4106       const PetscInt idx = v - vStart;
4107       PetscInt       off, d, m;
4108 
4109       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4110       for (d = 0; d < dim; ++d) {
4111         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4112       }
4113       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
4114 
4115       in->pointmarkerlist[idx] = (int) m;
4116     }
4117     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4118   }
4119   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
4120 
4121   in->numberoffacets = fEnd - fStart;
4122   if (in->numberoffacets > 0) {
4123     ierr = PetscMalloc(in->numberoffacets * sizeof(facet), &in->facetlist);CHKERRQ(ierr);
4124     ierr = PetscMalloc(in->numberoffacets * sizeof(int),   &in->facetmarkerlist);CHKERRQ(ierr);
4125     for (f = fStart; f < fEnd; ++f) {
4126       const PetscInt idx     = f - fStart;
4127       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
4128       polygon       *poly;
4129 
4130       in->facetlist[idx].numberofpolygons = 1;
4131 
4132       ierr = PetscMalloc(in->facetlist[idx].numberofpolygons * sizeof(polygon), &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
4133 
4134       in->facetlist[idx].numberofholes    = 0;
4135       in->facetlist[idx].holelist         = NULL;
4136 
4137       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4138       for (p = 0; p < numPoints*2; p += 2) {
4139         const PetscInt point = points[p];
4140         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
4141       }
4142 
4143       poly                   = in->facetlist[idx].polygonlist;
4144       poly->numberofvertices = numVertices;
4145       ierr                   = PetscMalloc(poly->numberofvertices * sizeof(int), &poly->vertexlist);CHKERRQ(ierr);
4146       for (v = 0; v < numVertices; ++v) {
4147         const PetscInt vIdx = points[v] - vStart;
4148         poly->vertexlist[v] = vIdx;
4149       }
4150       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
4151       in->facetmarkerlist[idx] = (int) m;
4152       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4153     }
4154   }
4155   if (!rank) {
4156     TetGenOpts t;
4157 
4158     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4159     t.in        = boundary; /* Should go away */
4160     t.plc       = 1;
4161     t.quality   = 1;
4162     t.edgesout  = 1;
4163     t.zeroindex = 1;
4164     t.quiet     = 1;
4165     t.verbose   = verbose;
4166     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
4167     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4168   }
4169   {
4170     const PetscInt numCorners  = 4;
4171     const PetscInt numCells    = out->numberoftetrahedra;
4172     const PetscInt numVertices = out->numberofpoints;
4173     const int     *cells      = out->tetrahedronlist;
4174     const double  *meshCoords = out->pointlist;
4175 
4176     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
4177     /* Set labels */
4178     for (v = 0; v < numVertices; ++v) {
4179       if (out->pointmarkerlist[v]) {
4180         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4181       }
4182     }
4183     if (interpolate) {
4184       PetscInt e;
4185 
4186       for (e = 0; e < out->numberofedges; e++) {
4187         if (out->edgemarkerlist[e]) {
4188           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4189           const PetscInt *edges;
4190           PetscInt        numEdges;
4191 
4192           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4193           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4194           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4195           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4196         }
4197       }
4198       for (f = 0; f < out->numberoftrifaces; f++) {
4199         if (out->trifacemarkerlist[f]) {
4200           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4201           const PetscInt *faces;
4202           PetscInt        numFaces;
4203 
4204           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4205           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4206           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4207           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4208         }
4209       }
4210     }
4211     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
4212   }
4213 
4214   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4215   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4216   PetscFunctionReturn(0);
4217 }
4218 
4219 #undef __FUNCT__
4220 #define __FUNCT__ "DMPlexRefine_CTetgen"
4221 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
4222 {
4223   MPI_Comm       comm;
4224   const PetscInt dim  = 3;
4225   PLC           *in, *out;
4226   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
4227   PetscMPIInt    rank;
4228   PetscErrorCode ierr;
4229 
4230   PetscFunctionBegin;
4231   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
4232   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
4233   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
4234   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4235   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
4236   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4237   ierr = PLCCreate(&in);CHKERRQ(ierr);
4238   ierr = PLCCreate(&out);CHKERRQ(ierr);
4239 
4240   in->numberofpoints = vEnd - vStart;
4241   if (in->numberofpoints > 0) {
4242     PetscSection coordSection;
4243     Vec          coordinates;
4244     PetscScalar *array;
4245 
4246     ierr = PetscMalloc(in->numberofpoints*dim * sizeof(PetscReal), &in->pointlist);CHKERRQ(ierr);
4247     ierr = PetscMalloc(in->numberofpoints     * sizeof(int),       &in->pointmarkerlist);CHKERRQ(ierr);
4248     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4249     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4250     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
4251     for (v = vStart; v < vEnd; ++v) {
4252       const PetscInt idx = v - vStart;
4253       PetscInt       off, d, m;
4254 
4255       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4256       for (d = 0; d < dim; ++d) {
4257         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
4258       }
4259       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
4260 
4261       in->pointmarkerlist[idx] = (int) m;
4262     }
4263     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4264   }
4265   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4266 
4267   in->numberofcorners       = 4;
4268   in->numberoftetrahedra    = cEnd - cStart;
4269   in->tetrahedronvolumelist = maxVolumes;
4270   if (in->numberoftetrahedra > 0) {
4271     ierr = PetscMalloc(in->numberoftetrahedra*in->numberofcorners * sizeof(int), &in->tetrahedronlist);CHKERRQ(ierr);
4272     for (c = cStart; c < cEnd; ++c) {
4273       const PetscInt idx      = c - cStart;
4274       PetscInt      *closure = NULL;
4275       PetscInt       closureSize;
4276 
4277       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4278       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4279       for (v = 0; v < 4; ++v) {
4280         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4281       }
4282       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4283     }
4284   }
4285   if (!rank) {
4286     TetGenOpts t;
4287 
4288     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4289 
4290     t.in        = dm; /* Should go away */
4291     t.refine    = 1;
4292     t.varvolume = 1;
4293     t.quality   = 1;
4294     t.edgesout  = 1;
4295     t.zeroindex = 1;
4296     t.quiet     = 1;
4297     t.verbose   = verbose; /* Change this */
4298 
4299     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4300     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4301   }
4302   {
4303     const PetscInt numCorners  = 4;
4304     const PetscInt numCells    = out->numberoftetrahedra;
4305     const PetscInt numVertices = out->numberofpoints;
4306     const int     *cells       = out->tetrahedronlist;
4307     const double  *meshCoords  = out->pointlist;
4308     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4309 
4310     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4311     /* Set labels */
4312     for (v = 0; v < numVertices; ++v) {
4313       if (out->pointmarkerlist[v]) {
4314         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4315       }
4316     }
4317     if (interpolate) {
4318       PetscInt e, f;
4319 
4320       for (e = 0; e < out->numberofedges; e++) {
4321         if (out->edgemarkerlist[e]) {
4322           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4323           const PetscInt *edges;
4324           PetscInt        numEdges;
4325 
4326           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4327           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4328           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4329           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4330         }
4331       }
4332       for (f = 0; f < out->numberoftrifaces; f++) {
4333         if (out->trifacemarkerlist[f]) {
4334           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4335           const PetscInt *faces;
4336           PetscInt        numFaces;
4337 
4338           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4339           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4340           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4341           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4342         }
4343       }
4344     }
4345     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4346   }
4347   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4348   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4349   PetscFunctionReturn(0);
4350 }
4351 #endif
4352 
4353 #undef __FUNCT__
4354 #define __FUNCT__ "DMPlexGenerate"
4355 /*@C
4356   DMPlexGenerate - Generates a mesh.
4357 
4358   Not Collective
4359 
4360   Input Parameters:
4361 + boundary - The DMPlex boundary object
4362 . name - The mesh generation package name
4363 - interpolate - Flag to create intermediate mesh elements
4364 
4365   Output Parameter:
4366 . mesh - The DMPlex object
4367 
4368   Level: intermediate
4369 
4370 .keywords: mesh, elements
4371 .seealso: DMPlexCreate(), DMRefine()
4372 @*/
4373 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4374 {
4375   PetscInt       dim;
4376   char           genname[1024];
4377   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4378   PetscErrorCode ierr;
4379 
4380   PetscFunctionBegin;
4381   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4382   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4383   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4384   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4385   if (flg) name = genname;
4386   if (name) {
4387     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4388     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4389     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4390   }
4391   switch (dim) {
4392   case 1:
4393     if (!name || isTriangle) {
4394 #if defined(PETSC_HAVE_TRIANGLE)
4395       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4396 #else
4397       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4398 #endif
4399     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4400     break;
4401   case 2:
4402     if (!name || isCTetgen) {
4403 #if defined(PETSC_HAVE_CTETGEN)
4404       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4405 #else
4406       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4407 #endif
4408     } else if (isTetgen) {
4409 #if defined(PETSC_HAVE_TETGEN)
4410       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4411 #else
4412       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4413 #endif
4414     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4415     break;
4416   default:
4417     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4418   }
4419   PetscFunctionReturn(0);
4420 }
4421 
4422 typedef PetscInt CellRefiner;
4423 
4424 #undef __FUNCT__
4425 #define __FUNCT__ "GetDepthStart_Private"
4426 PETSC_STATIC_INLINE PetscErrorCode GetDepthStart_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cStart, PetscInt *fStart, PetscInt *eStart, PetscInt *vStart)
4427 {
4428   PetscFunctionBegin;
4429   if (cStart) *cStart = 0;
4430   if (vStart) *vStart = depthSize[depth];
4431   if (fStart) *fStart = depthSize[depth] + depthSize[0];
4432   if (eStart) *eStart = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4433   PetscFunctionReturn(0);
4434 }
4435 
4436 #undef __FUNCT__
4437 #define __FUNCT__ "GetDepthEnd_Private"
4438 PETSC_STATIC_INLINE PetscErrorCode GetDepthEnd_Private(PetscInt depth, PetscInt depthSize[], PetscInt *cEnd, PetscInt *fEnd, PetscInt *eEnd, PetscInt *vEnd)
4439 {
4440   PetscFunctionBegin;
4441   if (cEnd) *cEnd = depthSize[depth];
4442   if (vEnd) *vEnd = depthSize[depth] + depthSize[0];
4443   if (fEnd) *fEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1];
4444   if (eEnd) *eEnd = depthSize[depth] + depthSize[0] + depthSize[depth-1] + depthSize[1];
4445   PetscFunctionReturn(0);
4446 }
4447 
4448 #undef __FUNCT__
4449 #define __FUNCT__ "CellRefinerGetSizes"
4450 PetscErrorCode CellRefinerGetSizes(CellRefiner refiner, DM dm, PetscInt depthSize[])
4451 {
4452   PetscInt       cStart, cEnd, cMax, vStart, vEnd, vMax, fStart, fEnd, fMax, eStart, eEnd, eMax;
4453   PetscErrorCode ierr;
4454 
4455   PetscFunctionBegin;
4456   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4457   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4458   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4459   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4460   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4461   switch (refiner) {
4462   case 1:
4463     /* Simplicial 2D */
4464     depthSize[0] = vEnd - vStart + fEnd - fStart;         /* Add a vertex on every face */
4465     depthSize[1] = 2*(fEnd - fStart) + 3*(cEnd - cStart); /* Every face is split into 2 faces and 3 faces are added for each cell */
4466     depthSize[2] = 4*(cEnd - cStart);                     /* Every cell split into 4 cells */
4467     break;
4468   case 3:
4469     /* Hybrid 2D */
4470     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4471     cMax = PetscMin(cEnd, cMax);
4472     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4473     fMax         = PetscMin(fEnd, fMax);
4474     depthSize[0] = vEnd - vStart + fMax - fStart;                                         /* Add a vertex on every face, but not hybrid faces */
4475     depthSize[1] = 2*(fMax - fStart) + 3*(cMax - cStart) + (fEnd - fMax) + (cEnd - cMax); /* Every interior face is split into 2 faces, 3 faces are added for each interior cell, and one in each hybrid cell */
4476     depthSize[2] = 4*(cMax - cStart) + 2*(cEnd - cMax);                                   /* Interior cells split into 4 cells, Hybrid cells split into 2 cells */
4477     break;
4478   case 2:
4479     /* Hex 2D */
4480     depthSize[0] = vEnd - vStart + cEnd - cStart + fEnd - fStart; /* Add a vertex on every face and cell */
4481     depthSize[1] = 2*(fEnd - fStart) + 4*(cEnd - cStart);         /* Every face is split into 2 faces and 4 faces are added for each cell */
4482     depthSize[2] = 4*(cEnd - cStart);                             /* Every cell split into 4 cells */
4483     break;
4484   default:
4485     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4486   }
4487   PetscFunctionReturn(0);
4488 }
4489 
4490 #undef __FUNCT__
4491 #define __FUNCT__ "CellRefinerSetConeSizes"
4492 PetscErrorCode CellRefinerSetConeSizes(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4493 {
4494   PetscInt       depth, cStart, cStartNew, cEnd, cMax, c, vStart, vStartNew, vEnd, vMax, v, fStart, fStartNew, fEnd, fMax, f, eStart, eStartNew, eEnd, eMax, r;
4495   PetscErrorCode ierr;
4496 
4497   PetscFunctionBegin;
4498   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4499   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4500   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4501   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4502   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4503   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4504   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4505   switch (refiner) {
4506   case 1:
4507     /* Simplicial 2D */
4508     /* All cells have 3 faces */
4509     for (c = cStart; c < cEnd; ++c) {
4510       for (r = 0; r < 4; ++r) {
4511         const PetscInt newp = (c - cStart)*4 + r;
4512 
4513         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4514       }
4515     }
4516     /* Split faces have 2 vertices and the same cells as the parent */
4517     for (f = fStart; f < fEnd; ++f) {
4518       for (r = 0; r < 2; ++r) {
4519         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4520         PetscInt       size;
4521 
4522         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4523         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4524         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4525       }
4526     }
4527     /* Interior faces have 2 vertices and 2 cells */
4528     for (c = cStart; c < cEnd; ++c) {
4529       for (r = 0; r < 3; ++r) {
4530         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4531 
4532         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4533         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4534       }
4535     }
4536     /* Old vertices have identical supports */
4537     for (v = vStart; v < vEnd; ++v) {
4538       const PetscInt newp = vStartNew + (v - vStart);
4539       PetscInt       size;
4540 
4541       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4542       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4543     }
4544     /* Face vertices have 2 + cells*2 supports */
4545     for (f = fStart; f < fEnd; ++f) {
4546       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4547       PetscInt       size;
4548 
4549       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4550       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size*2);CHKERRQ(ierr);
4551     }
4552     break;
4553   case 2:
4554     /* Hex 2D */
4555     /* All cells have 4 faces */
4556     for (c = cStart; c < cEnd; ++c) {
4557       for (r = 0; r < 4; ++r) {
4558         const PetscInt newp = (c - cStart)*4 + r;
4559 
4560         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4561       }
4562     }
4563     /* Split faces have 2 vertices and the same cells as the parent */
4564     for (f = fStart; f < fEnd; ++f) {
4565       for (r = 0; r < 2; ++r) {
4566         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4567         PetscInt       size;
4568 
4569         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4570         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4571         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4572       }
4573     }
4574     /* Interior faces have 2 vertices and 2 cells */
4575     for (c = cStart; c < cEnd; ++c) {
4576       for (r = 0; r < 4; ++r) {
4577         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
4578 
4579         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4580         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4581       }
4582     }
4583     /* Old vertices have identical supports */
4584     for (v = vStart; v < vEnd; ++v) {
4585       const PetscInt newp = vStartNew + (v - vStart);
4586       PetscInt       size;
4587 
4588       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4589       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4590     }
4591     /* Face vertices have 2 + cells supports */
4592     for (f = fStart; f < fEnd; ++f) {
4593       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4594       PetscInt       size;
4595 
4596       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4597       ierr = DMPlexSetSupportSize(rdm, newp, 2 + size);CHKERRQ(ierr);
4598     }
4599     /* Cell vertices have 4 supports */
4600     for (c = cStart; c < cEnd; ++c) {
4601       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
4602 
4603       ierr = DMPlexSetSupportSize(rdm, newp, 4);CHKERRQ(ierr);
4604     }
4605     break;
4606   case 3:
4607     /* Hybrid 2D */
4608     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
4609     cMax = PetscMin(cEnd, cMax);
4610     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
4611     fMax = PetscMin(fEnd, fMax);
4612     ierr = DMPlexSetHybridBounds(rdm, cStartNew + (cMax - cStart)*4, fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
4613     /* Interior cells have 3 faces */
4614     for (c = cStart; c < cMax; ++c) {
4615       for (r = 0; r < 4; ++r) {
4616         const PetscInt newp = cStartNew + (c - cStart)*4 + r;
4617 
4618         ierr = DMPlexSetConeSize(rdm, newp, 3);CHKERRQ(ierr);
4619       }
4620     }
4621     /* Hybrid cells have 4 faces */
4622     for (c = cMax; c < cEnd; ++c) {
4623       for (r = 0; r < 2; ++r) {
4624         const PetscInt newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2 + r;
4625 
4626         ierr = DMPlexSetConeSize(rdm, newp, 4);CHKERRQ(ierr);
4627       }
4628     }
4629     /* Interior split faces have 2 vertices and the same cells as the parent */
4630     for (f = fStart; f < fMax; ++f) {
4631       for (r = 0; r < 2; ++r) {
4632         const PetscInt newp = fStartNew + (f - fStart)*2 + r;
4633         PetscInt       size;
4634 
4635         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4636         ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4637         ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4638       }
4639     }
4640     /* Interior cell faces have 2 vertices and 2 cells */
4641     for (c = cStart; c < cMax; ++c) {
4642       for (r = 0; r < 3; ++r) {
4643         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
4644 
4645         ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4646         ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4647       }
4648     }
4649     /* Hybrid faces have 2 vertices and the same cells */
4650     for (f = fMax; f < fEnd; ++f) {
4651       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
4652       PetscInt       size;
4653 
4654       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4655       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4656       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4657     }
4658     /* Hybrid cell faces have 2 vertices and 2 cells */
4659     for (c = cMax; c < cEnd; ++c) {
4660       const PetscInt newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
4661 
4662       ierr = DMPlexSetConeSize(rdm, newp, 2);CHKERRQ(ierr);
4663       ierr = DMPlexSetSupportSize(rdm, newp, 2);CHKERRQ(ierr);
4664     }
4665     /* Old vertices have identical supports */
4666     for (v = vStart; v < vEnd; ++v) {
4667       const PetscInt newp = vStartNew + (v - vStart);
4668       PetscInt       size;
4669 
4670       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4671       ierr = DMPlexSetSupportSize(rdm, newp, size);CHKERRQ(ierr);
4672     }
4673     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
4674     for (f = fStart; f < fMax; ++f) {
4675       const PetscInt newp = vStartNew + (vEnd - vStart) + (f - fStart);
4676       const PetscInt *support;
4677       PetscInt       size, newSize = 2, s;
4678 
4679       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4680       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4681       for (s = 0; s < size; ++s) {
4682         if (support[s] >= cMax) newSize += 1;
4683         else newSize += 2;
4684       }
4685       ierr = DMPlexSetSupportSize(rdm, newp, newSize);CHKERRQ(ierr);
4686     }
4687     break;
4688   default:
4689     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
4690   }
4691   PetscFunctionReturn(0);
4692 }
4693 
4694 #undef __FUNCT__
4695 #define __FUNCT__ "CellRefinerSetCones"
4696 PetscErrorCode CellRefinerSetCones(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
4697 {
4698   PetscInt       depth, cStart, cEnd, cMax, cStartNew, cEndNew, c, vStart, vEnd, vMax, vStartNew, vEndNew, v, fStart, fEnd, fMax, fStartNew, fEndNew, f, eStart, eEnd, eMax, eStartNew, eEndNew, r, p;
4699   PetscInt       maxSupportSize, *supportRef;
4700   PetscErrorCode ierr;
4701 
4702   PetscFunctionBegin;
4703   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4704   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4705   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
4706   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4707   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4708   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
4709   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
4710   ierr = GetDepthEnd_Private(depth, depthSize, &cEndNew, &fEndNew, &eEndNew, &vEndNew);CHKERRQ(ierr);
4711   switch (refiner) {
4712   case 1:
4713     /* Simplicial 2D */
4714     /*
4715      2
4716      |\
4717      | \
4718      |  \
4719      |   \
4720      | C  \
4721      |     \
4722      |      \
4723      2---1---1
4724      |\  D  / \
4725      | 2   0   \
4726      |A \ /  B  \
4727      0---0-------1
4728      */
4729     /* All cells have 3 faces */
4730     for (c = cStart; c < cEnd; ++c) {
4731       const PetscInt  newp = cStartNew + (c - cStart)*4;
4732       const PetscInt *cone, *ornt;
4733       PetscInt        coneNew[3], orntNew[3];
4734 
4735       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4736       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4737       /* A triangle */
4738       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4739       orntNew[0] = ornt[0];
4740       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4741       orntNew[1] = -2;
4742       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4743       orntNew[2] = ornt[2];
4744       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4745       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4746 #if 1
4747       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4748       for (p = 0; p < 3; ++p) {
4749         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4750       }
4751 #endif
4752       /* B triangle */
4753       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4754       orntNew[0] = ornt[0];
4755       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4756       orntNew[1] = ornt[1];
4757       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4758       orntNew[2] = -2;
4759       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4760       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4761 #if 1
4762       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4763       for (p = 0; p < 3; ++p) {
4764         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4765       }
4766 #endif
4767       /* C triangle */
4768       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4769       orntNew[0] = -2;
4770       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4771       orntNew[1] = ornt[1];
4772       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4773       orntNew[2] = ornt[2];
4774       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4775       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4776 #if 1
4777       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
4778       for (p = 0; p < 3; ++p) {
4779         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4780       }
4781 #endif
4782       /* D triangle */
4783       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 0;
4784       orntNew[0] = 0;
4785       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 1;
4786       orntNew[1] = 0;
4787       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*3 + 2;
4788       orntNew[2] = 0;
4789       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
4790       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
4791 #if 1
4792       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
4793       for (p = 0; p < 3; ++p) {
4794         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4795       }
4796 #endif
4797     }
4798     /* Split faces have 2 vertices and the same cells as the parent */
4799     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
4800     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
4801     for (f = fStart; f < fEnd; ++f) {
4802       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
4803 
4804       for (r = 0; r < 2; ++r) {
4805         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
4806         const PetscInt *cone, *support;
4807         PetscInt        coneNew[2], coneSize, c, supportSize, s;
4808 
4809         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
4810         coneNew[0]       = vStartNew + (cone[0] - vStart);
4811         coneNew[1]       = vStartNew + (cone[1] - vStart);
4812         coneNew[(r+1)%2] = newv;
4813         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4814 #if 1
4815         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4816         for (p = 0; p < 2; ++p) {
4817           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4818         }
4819 #endif
4820         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
4821         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4822         for (s = 0; s < supportSize; ++s) {
4823           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
4824           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4825           for (c = 0; c < coneSize; ++c) {
4826             if (cone[c] == f) break;
4827           }
4828           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
4829         }
4830         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4831 #if 1
4832         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4833         for (p = 0; p < supportSize; ++p) {
4834           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
4835         }
4836 #endif
4837       }
4838     }
4839     /* Interior faces have 2 vertices and 2 cells */
4840     for (c = cStart; c < cEnd; ++c) {
4841       const PetscInt *cone;
4842 
4843       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4844       for (r = 0; r < 3; ++r) {
4845         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*3 + r;
4846         PetscInt       coneNew[2];
4847         PetscInt       supportNew[2];
4848 
4849         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
4850         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
4851         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
4852 #if 1
4853         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4854         for (p = 0; p < 2; ++p) {
4855           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
4856         }
4857 #endif
4858         supportNew[0] = (c - cStart)*4 + (r+1)%3;
4859         supportNew[1] = (c - cStart)*4 + 3;
4860         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
4861 #if 1
4862         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
4863         for (p = 0; p < 2; ++p) {
4864           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
4865         }
4866 #endif
4867       }
4868     }
4869     /* Old vertices have identical supports */
4870     for (v = vStart; v < vEnd; ++v) {
4871       const PetscInt  newp = vStartNew + (v - vStart);
4872       const PetscInt *support, *cone;
4873       PetscInt        size, s;
4874 
4875       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
4876       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
4877       for (s = 0; s < size; ++s) {
4878         PetscInt r = 0;
4879 
4880         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4881         if (cone[1] == v) r = 1;
4882         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
4883       }
4884       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4885 #if 1
4886       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4887       for (p = 0; p < size; ++p) {
4888         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4889       }
4890 #endif
4891     }
4892     /* Face vertices have 2 + cells*2 supports */
4893     for (f = fStart; f < fEnd; ++f) {
4894       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
4895       const PetscInt *cone, *support;
4896       PetscInt        size, s;
4897 
4898       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
4899       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
4900       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
4901       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
4902       for (s = 0; s < size; ++s) {
4903         PetscInt r = 0;
4904 
4905         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
4906         if      (cone[1] == f) r = 1;
4907         else if (cone[2] == f) r = 2;
4908         supportRef[2+s*2+0] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
4909         supportRef[2+s*2+1] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*3 + r;
4910       }
4911       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
4912 #if 1
4913       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
4914       for (p = 0; p < 2+size*2; ++p) {
4915         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
4916       }
4917 #endif
4918     }
4919     ierr = PetscFree(supportRef);CHKERRQ(ierr);
4920     break;
4921   case 2:
4922     /* Hex 2D */
4923     /*
4924      3---------2---------2
4925      |         |         |
4926      |    D    2    C    |
4927      |         |         |
4928      3----3----0----1----1
4929      |         |         |
4930      |    A    0    B    |
4931      |         |         |
4932      0---------0---------1
4933      */
4934     /* All cells have 4 faces */
4935     for (c = cStart; c < cEnd; ++c) {
4936       const PetscInt  newp = (c - cStart)*4;
4937       const PetscInt *cone, *ornt;
4938       PetscInt        coneNew[4], orntNew[4];
4939 
4940       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
4941       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
4942       /* A quad */
4943       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
4944       orntNew[0] = ornt[0];
4945       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4946       orntNew[1] = 0;
4947       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4948       orntNew[2] = -2;
4949       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 0 : 1);
4950       orntNew[3] = ornt[3];
4951       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
4952       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
4953 #if 1
4954       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
4955       for (p = 0; p < 4; ++p) {
4956         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4957       }
4958 #endif
4959       /* B quad */
4960       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
4961       orntNew[0] = ornt[0];
4962       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
4963       orntNew[1] = ornt[1];
4964       coneNew[2] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4965       orntNew[2] = 0;
4966       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 0;
4967       orntNew[3] = -2;
4968       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
4969       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
4970 #if 1
4971       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
4972       for (p = 0; p < 4; ++p) {
4973         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4974       }
4975 #endif
4976       /* C quad */
4977       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 1;
4978       orntNew[0] = -2;
4979       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
4980       orntNew[1] = ornt[1];
4981       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
4982       orntNew[2] = ornt[2];
4983       coneNew[3] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4984       orntNew[3] = 0;
4985       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
4986       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
4987 #if 1
4988       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
4989       for (p = 0; p < 4; ++p) {
4990         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
4991       }
4992 #endif
4993       /* D quad */
4994       coneNew[0] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 3;
4995       orntNew[0] = 0;
4996       coneNew[1] = fStartNew + (fEnd    - fStart)*2 + (c - cStart)*4 + 2;
4997       orntNew[1] = -2;
4998       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
4999       orntNew[2] = ornt[2];
5000       coneNew[3] = fStartNew + (cone[3] - fStart)*2 + (ornt[3] < 0 ? 1 : 0);
5001       orntNew[3] = ornt[3];
5002       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
5003       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
5004 #if 1
5005       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
5006       for (p = 0; p < 4; ++p) {
5007         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5008       }
5009 #endif
5010     }
5011     /* Split faces have 2 vertices and the same cells as the parent */
5012     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
5013     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
5014     for (f = fStart; f < fEnd; ++f) {
5015       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
5016 
5017       for (r = 0; r < 2; ++r) {
5018         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
5019         const PetscInt *cone, *support;
5020         PetscInt        coneNew[2], coneSize, c, supportSize, s;
5021 
5022         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5023         coneNew[0]       = vStartNew + (cone[0] - vStart);
5024         coneNew[1]       = vStartNew + (cone[1] - vStart);
5025         coneNew[(r+1)%2] = newv;
5026         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5027 #if 1
5028         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5029         for (p = 0; p < 2; ++p) {
5030           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5031         }
5032 #endif
5033         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
5034         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5035         for (s = 0; s < supportSize; ++s) {
5036           ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5037           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5038           for (c = 0; c < coneSize; ++c) {
5039             if (cone[c] == f) break;
5040           }
5041           supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%4;
5042         }
5043         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5044 #if 1
5045         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5046         for (p = 0; p < supportSize; ++p) {
5047           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
5048         }
5049 #endif
5050       }
5051     }
5052     /* Interior faces have 2 vertices and 2 cells */
5053     for (c = cStart; c < cEnd; ++c) {
5054       const PetscInt *cone;
5055       PetscInt        coneNew[2], supportNew[2];
5056 
5057       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5058       for (r = 0; r < 4; ++r) {
5059         const PetscInt newp = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
5060 
5061         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r] - fStart);
5062         coneNew[1] = vStartNew + (vEnd - vStart) + (fEnd    - fStart) + (c - cStart);
5063         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5064 #if 1
5065         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5066         for (p = 0; p < 2; ++p) {
5067           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5068         }
5069 #endif
5070         supportNew[0] = (c - cStart)*4 + r;
5071         supportNew[1] = (c - cStart)*4 + (r+1)%4;
5072         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5073 #if 1
5074         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5075         for (p = 0; p < 2; ++p) {
5076           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5077         }
5078 #endif
5079       }
5080     }
5081     /* Old vertices have identical supports */
5082     for (v = vStart; v < vEnd; ++v) {
5083       const PetscInt  newp = vStartNew + (v - vStart);
5084       const PetscInt *support, *cone;
5085       PetscInt        size, s;
5086 
5087       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
5088       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
5089       for (s = 0; s < size; ++s) {
5090         PetscInt r = 0;
5091 
5092         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5093         if (cone[1] == v) r = 1;
5094         supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
5095       }
5096       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5097 #if 1
5098       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5099       for (p = 0; p < size; ++p) {
5100         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5101       }
5102 #endif
5103     }
5104     /* Face vertices have 2 + cells supports */
5105     for (f = fStart; f < fEnd; ++f) {
5106       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
5107       const PetscInt *cone, *support;
5108       PetscInt        size, s;
5109 
5110       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5111       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5112       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
5113       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
5114       for (s = 0; s < size; ++s) {
5115         PetscInt r = 0;
5116 
5117         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5118         if      (cone[1] == f) r = 1;
5119         else if (cone[2] == f) r = 2;
5120         else if (cone[3] == f) r = 3;
5121         supportRef[2+s] = fStartNew + (fEnd - fStart)*2 + (support[s] - cStart)*4 + r;
5122       }
5123       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5124 #if 1
5125       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5126       for (p = 0; p < 2+size; ++p) {
5127         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5128       }
5129 #endif
5130     }
5131     /* Cell vertices have 4 supports */
5132     for (c = cStart; c < cEnd; ++c) {
5133       const PetscInt newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
5134       PetscInt       supportNew[4];
5135 
5136       for (r = 0; r < 4; ++r) {
5137         supportNew[r] = fStartNew + (fEnd - fStart)*2 + (c - cStart)*4 + r;
5138       }
5139       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5140     }
5141     break;
5142   case 3:
5143     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5144     cMax = PetscMin(cEnd, cMax);
5145     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5146     fMax = PetscMin(fEnd, fMax);
5147     /* Interior cells have 3 faces */
5148     for (c = cStart; c < cMax; ++c) {
5149       const PetscInt  newp = cStartNew + (c - cStart)*4;
5150       const PetscInt *cone, *ornt;
5151       PetscInt        coneNew[3], orntNew[3];
5152 
5153       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5154       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5155       /* A triangle */
5156       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
5157       orntNew[0] = ornt[0];
5158       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
5159       orntNew[1] = -2;
5160       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 0 : 1);
5161       orntNew[2] = ornt[2];
5162       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
5163       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
5164 #if 1
5165       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
5166       for (p = 0; p < 3; ++p) {
5167         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5168       }
5169 #endif
5170       /* B triangle */
5171       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
5172       orntNew[0] = ornt[0];
5173       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
5174       orntNew[1] = ornt[1];
5175       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
5176       orntNew[2] = -2;
5177       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
5178       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
5179 #if 1
5180       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
5181       for (p = 0; p < 3; ++p) {
5182         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5183       }
5184 #endif
5185       /* C triangle */
5186       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
5187       orntNew[0] = -2;
5188       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
5189       orntNew[1] = ornt[1];
5190       coneNew[2] = fStartNew + (cone[2] - fStart)*2 + (ornt[2] < 0 ? 1 : 0);
5191       orntNew[2] = ornt[2];
5192       ierr       = DMPlexSetCone(rdm, newp+2, coneNew);CHKERRQ(ierr);
5193       ierr       = DMPlexSetConeOrientation(rdm, newp+2, orntNew);CHKERRQ(ierr);
5194 #if 1
5195       if ((newp+2 < cStartNew) || (newp+2 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+2, cStartNew, cEndNew);
5196       for (p = 0; p < 3; ++p) {
5197         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5198       }
5199 #endif
5200       /* D triangle */
5201       coneNew[0] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 0;
5202       orntNew[0] = 0;
5203       coneNew[1] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 1;
5204       orntNew[1] = 0;
5205       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (c - cStart)*3 + 2;
5206       orntNew[2] = 0;
5207       ierr       = DMPlexSetCone(rdm, newp+3, coneNew);CHKERRQ(ierr);
5208       ierr       = DMPlexSetConeOrientation(rdm, newp+3, orntNew);CHKERRQ(ierr);
5209 #if 1
5210       if ((newp+3 < cStartNew) || (newp+3 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+3, cStartNew, cEndNew);
5211       for (p = 0; p < 3; ++p) {
5212         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5213       }
5214 #endif
5215     }
5216     /*
5217      2----3----3
5218      |         |
5219      |    B    |
5220      |         |
5221      0----4--- 1
5222      |         |
5223      |    A    |
5224      |         |
5225      0----2----1
5226      */
5227     /* Hybrid cells have 4 faces */
5228     for (c = cMax; c < cEnd; ++c) {
5229       const PetscInt  newp = cStartNew + (cMax - cStart)*4 + (c - cMax)*2;
5230       const PetscInt *cone, *ornt;
5231       PetscInt        coneNew[4], orntNew[4];
5232 
5233       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5234       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5235       /* A quad */
5236       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 1 : 0);
5237       orntNew[0] = ornt[0];
5238       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 1 : 0);
5239       orntNew[1] = ornt[1];
5240       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[2] - fMax);
5241       orntNew[2] = 0;
5242       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
5243       orntNew[3] = 0;
5244       ierr       = DMPlexSetCone(rdm, newp+0, coneNew);CHKERRQ(ierr);
5245       ierr       = DMPlexSetConeOrientation(rdm, newp+0, orntNew);CHKERRQ(ierr);
5246 #if 1
5247       if ((newp+0 < cStartNew) || (newp+0 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+0, cStartNew, cEndNew);
5248       for (p = 0; p < 4; ++p) {
5249         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5250       }
5251 #endif
5252       /* B quad */
5253       coneNew[0] = fStartNew + (cone[0] - fStart)*2 + (ornt[0] < 0 ? 0 : 1);
5254       orntNew[0] = ornt[0];
5255       coneNew[1] = fStartNew + (cone[1] - fStart)*2 + (ornt[1] < 0 ? 0 : 1);
5256       orntNew[1] = ornt[1];
5257       coneNew[2] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (fEnd    - fMax) + (c - cMax);
5258       orntNew[2] = 0;
5259       coneNew[3] = fStartNew + (fMax    - fStart)*2 + (cMax - cStart)*3 + (cone[3] - fMax);
5260       orntNew[3] = 0;
5261       ierr       = DMPlexSetCone(rdm, newp+1, coneNew);CHKERRQ(ierr);
5262       ierr       = DMPlexSetConeOrientation(rdm, newp+1, orntNew);CHKERRQ(ierr);
5263 #if 1
5264       if ((newp+1 < cStartNew) || (newp+1 >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", newp+1, cStartNew, cEndNew);
5265       for (p = 0; p < 4; ++p) {
5266         if ((coneNew[p] < fStartNew) || (coneNew[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", coneNew[p], fStartNew, fEndNew);
5267       }
5268 #endif
5269     }
5270     /* Interior split faces have 2 vertices and the same cells as the parent */
5271     ierr = DMPlexGetMaxSizes(dm, NULL, &maxSupportSize);CHKERRQ(ierr);
5272     ierr = PetscMalloc((2 + maxSupportSize*2) * sizeof(PetscInt), &supportRef);CHKERRQ(ierr);
5273     for (f = fStart; f < fMax; ++f) {
5274       const PetscInt newv = vStartNew + (vEnd - vStart) + (f - fStart);
5275 
5276       for (r = 0; r < 2; ++r) {
5277         const PetscInt  newp = fStartNew + (f - fStart)*2 + r;
5278         const PetscInt *cone, *support;
5279         PetscInt        coneNew[2], coneSize, c, supportSize, s;
5280 
5281         ierr             = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5282         coneNew[0]       = vStartNew + (cone[0] - vStart);
5283         coneNew[1]       = vStartNew + (cone[1] - vStart);
5284         coneNew[(r+1)%2] = newv;
5285         ierr             = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5286 #if 1
5287         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5288         for (p = 0; p < 2; ++p) {
5289           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5290         }
5291 #endif
5292         ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
5293         ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5294         for (s = 0; s < supportSize; ++s) {
5295           if (support[s] >= cMax) {
5296             supportRef[s] = cStartNew + (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
5297           } else {
5298             ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5299             ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5300             for (c = 0; c < coneSize; ++c) {
5301               if (cone[c] == f) break;
5302             }
5303             supportRef[s] = cStartNew + (support[s] - cStart)*4 + (c+r)%3;
5304           }
5305         }
5306         ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5307 #if 1
5308         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5309         for (p = 0; p < supportSize; ++p) {
5310           if ((supportRef[p] < cStartNew) || (supportRef[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportRef[p], cStartNew, cEndNew);
5311         }
5312 #endif
5313       }
5314     }
5315     /* Interior cell faces have 2 vertices and 2 cells */
5316     for (c = cStart; c < cMax; ++c) {
5317       const PetscInt *cone;
5318 
5319       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5320       for (r = 0; r < 3; ++r) {
5321         const PetscInt newp = fStartNew + (fMax - fStart)*2 + (c - cStart)*3 + r;
5322         PetscInt       coneNew[2];
5323         PetscInt       supportNew[2];
5324 
5325         coneNew[0] = vStartNew + (vEnd - vStart) + (cone[r]       - fStart);
5326         coneNew[1] = vStartNew + (vEnd - vStart) + (cone[(r+1)%3] - fStart);
5327         ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5328 #if 1
5329         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5330         for (p = 0; p < 2; ++p) {
5331           if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5332         }
5333 #endif
5334         supportNew[0] = (c - cStart)*4 + (r+1)%3;
5335         supportNew[1] = (c - cStart)*4 + 3;
5336         ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5337 #if 1
5338         if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5339         for (p = 0; p < 2; ++p) {
5340           if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5341         }
5342 #endif
5343       }
5344     }
5345     /* Interior hybrid faces have 2 vertices and the same cells */
5346     for (f = fMax; f < fEnd; ++f) {
5347       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (f - fMax);
5348       const PetscInt *cone;
5349       const PetscInt *support;
5350       PetscInt        coneNew[2];
5351       PetscInt        supportNew[2];
5352       PetscInt        size, s, r;
5353 
5354       ierr       = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5355       coneNew[0] = vStartNew + (cone[0] - vStart);
5356       coneNew[1] = vStartNew + (cone[1] - vStart);
5357       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5358 #if 1
5359       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5360       for (p = 0; p < 2; ++p) {
5361         if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5362       }
5363 #endif
5364       ierr = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5365       ierr = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5366       for (s = 0; s < size; ++s) {
5367         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5368         for (r = 0; r < 2; ++r) {
5369           if (cone[r+2] == f) break;
5370         }
5371         supportNew[s] = (cMax - cStart)*4 + (support[s] - cMax)*2 + r;
5372       }
5373       ierr = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5374 #if 1
5375       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5376       for (p = 0; p < size; ++p) {
5377         if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5378       }
5379 #endif
5380     }
5381     /* Cell hybrid faces have 2 vertices and 2 cells */
5382     for (c = cMax; c < cEnd; ++c) {
5383       const PetscInt  newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (c - cMax);
5384       const PetscInt *cone;
5385       PetscInt        coneNew[2];
5386       PetscInt        supportNew[2];
5387 
5388       ierr       = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5389       coneNew[0] = vStartNew + (vEnd - vStart) + (cone[0] - fStart);
5390       coneNew[1] = vStartNew + (vEnd - vStart) + (cone[1] - fStart);
5391       ierr       = DMPlexSetCone(rdm, newp, coneNew);CHKERRQ(ierr);
5392 #if 1
5393       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5394       for (p = 0; p < 2; ++p) {
5395         if ((coneNew[p] < vStartNew) || (coneNew[p] >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", coneNew[p], vStartNew, vEndNew);
5396       }
5397 #endif
5398       supportNew[0] = (cMax - cStart)*4 + (c - cMax)*2 + 0;
5399       supportNew[1] = (cMax - cStart)*4 + (c - cMax)*2 + 1;
5400       ierr          = DMPlexSetSupport(rdm, newp, supportNew);CHKERRQ(ierr);
5401 #if 1
5402       if ((newp < fStartNew) || (newp >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", newp, fStartNew, fEndNew);
5403       for (p = 0; p < 2; ++p) {
5404         if ((supportNew[p] < cStartNew) || (supportNew[p] >= cEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a cell [%d, %d)", supportNew[p], cStartNew, cEndNew);
5405       }
5406 #endif
5407     }
5408     /* Old vertices have identical supports */
5409     for (v = vStart; v < vEnd; ++v) {
5410       const PetscInt  newp = vStartNew + (v - vStart);
5411       const PetscInt *support, *cone;
5412       PetscInt        size, s;
5413 
5414       ierr = DMPlexGetSupportSize(dm, v, &size);CHKERRQ(ierr);
5415       ierr = DMPlexGetSupport(dm, v, &support);CHKERRQ(ierr);
5416       for (s = 0; s < size; ++s) {
5417         if (support[s] >= fMax) {
5418           supportRef[s] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (support[s] - fMax);
5419         } else {
5420           PetscInt r = 0;
5421 
5422           ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5423           if (cone[1] == v) r = 1;
5424           supportRef[s] = fStartNew + (support[s] - fStart)*2 + r;
5425         }
5426       }
5427       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5428 #if 1
5429       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5430       for (p = 0; p < size; ++p) {
5431         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5432       }
5433 #endif
5434     }
5435     /* Face vertices have 2 + (2 interior, 1 hybrid) supports */
5436     for (f = fStart; f < fMax; ++f) {
5437       const PetscInt  newp = vStartNew + (vEnd - vStart) + (f - fStart);
5438       const PetscInt *cone, *support;
5439       PetscInt        size, newSize = 2, s;
5440 
5441       ierr          = DMPlexGetSupportSize(dm, f, &size);CHKERRQ(ierr);
5442       ierr          = DMPlexGetSupport(dm, f, &support);CHKERRQ(ierr);
5443       supportRef[0] = fStartNew + (f - fStart)*2 + 0;
5444       supportRef[1] = fStartNew + (f - fStart)*2 + 1;
5445       for (s = 0; s < size; ++s) {
5446         PetscInt r = 0;
5447 
5448         ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5449         if (support[s] >= cMax) {
5450           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (fEnd - fMax) + (support[s] - cMax);
5451 
5452           newSize += 1;
5453         } else {
5454           if      (cone[1] == f) r = 1;
5455           else if (cone[2] == f) r = 2;
5456           supportRef[newSize+0] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + (r+2)%3;
5457           supportRef[newSize+1] = fStartNew + (fMax - fStart)*2 + (support[s] - cStart)*3 + r;
5458 
5459           newSize += 2;
5460         }
5461       }
5462       ierr = DMPlexSetSupport(rdm, newp, supportRef);CHKERRQ(ierr);
5463 #if 1
5464       if ((newp < vStartNew) || (newp >= vEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a vertex [%d, %d)", newp, vStartNew, vEndNew);
5465       for (p = 0; p < newSize; ++p) {
5466         if ((supportRef[p] < fStartNew) || (supportRef[p] >= fEndNew)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d is not a face [%d, %d)", supportRef[p], fStartNew, fEndNew);
5467       }
5468 #endif
5469     }
5470     ierr = PetscFree(supportRef);CHKERRQ(ierr);
5471     break;
5472   default:
5473     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5474   }
5475   PetscFunctionReturn(0);
5476 }
5477 
5478 #undef __FUNCT__
5479 #define __FUNCT__ "CellRefinerSetCoordinates"
5480 PetscErrorCode CellRefinerSetCoordinates(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5481 {
5482   PetscSection   coordSection, coordSectionNew;
5483   Vec            coordinates, coordinatesNew;
5484   PetscScalar   *coords, *coordsNew;
5485   PetscInt       dim, depth, coordSizeNew, cStart, cEnd, c, vStart, vStartNew, vEnd, v, fStart, fEnd, fMax, f;
5486   PetscErrorCode ierr;
5487 
5488   PetscFunctionBegin;
5489   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5490   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5491   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5492   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5493   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5494   ierr = DMPlexGetHybridBounds(dm, NULL, &fMax, NULL, NULL);CHKERRQ(ierr);
5495   ierr = GetDepthStart_Private(depth, depthSize, NULL, NULL, NULL, &vStartNew);CHKERRQ(ierr);
5496   ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
5497   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &coordSectionNew);CHKERRQ(ierr);
5498   ierr = PetscSectionSetNumFields(coordSectionNew, 1);CHKERRQ(ierr);
5499   ierr = PetscSectionSetFieldComponents(coordSectionNew, 0, dim);CHKERRQ(ierr);
5500   ierr = PetscSectionSetChart(coordSectionNew, vStartNew, vStartNew+depthSize[0]);CHKERRQ(ierr);
5501   if (fMax < 0) fMax = fEnd;
5502   switch (refiner) {
5503   case 1:
5504   case 2:
5505   case 3:
5506     /* Simplicial and Hex 2D */
5507     /* All vertices have the dim coordinates */
5508     for (v = vStartNew; v < vStartNew+depthSize[0]; ++v) {
5509       ierr = PetscSectionSetDof(coordSectionNew, v, dim);CHKERRQ(ierr);
5510       ierr = PetscSectionSetFieldDof(coordSectionNew, v, 0, dim);CHKERRQ(ierr);
5511     }
5512     ierr = PetscSectionSetUp(coordSectionNew);CHKERRQ(ierr);
5513     ierr = DMPlexSetCoordinateSection(rdm, coordSectionNew);CHKERRQ(ierr);
5514     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
5515     ierr = PetscSectionGetStorageSize(coordSectionNew, &coordSizeNew);CHKERRQ(ierr);
5516     ierr = VecCreate(PetscObjectComm((PetscObject)dm), &coordinatesNew);CHKERRQ(ierr);
5517     ierr = PetscObjectSetName((PetscObject) coordinatesNew, "coordinates");CHKERRQ(ierr);
5518     ierr = VecSetSizes(coordinatesNew, coordSizeNew, PETSC_DETERMINE);CHKERRQ(ierr);
5519     ierr = VecSetFromOptions(coordinatesNew);CHKERRQ(ierr);
5520     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
5521     ierr = VecGetArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5522     /* Old vertices have the same coordinates */
5523     for (v = vStart; v < vEnd; ++v) {
5524       const PetscInt newv = vStartNew + (v - vStart);
5525       PetscInt       off, offnew, d;
5526 
5527       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
5528       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5529       for (d = 0; d < dim; ++d) {
5530         coordsNew[offnew+d] = coords[off+d];
5531       }
5532     }
5533     /* Face vertices have the average of endpoint coordinates */
5534     for (f = fStart; f < fMax; ++f) {
5535       const PetscInt  newv = vStartNew + (vEnd - vStart) + (f - fStart);
5536       const PetscInt *cone;
5537       PetscInt        coneSize, offA, offB, offnew, d;
5538 
5539       ierr = DMPlexGetConeSize(dm, f, &coneSize);CHKERRQ(ierr);
5540       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Face %d cone should have two vertices, not %d", f, coneSize);
5541       ierr = DMPlexGetCone(dm, f, &cone);CHKERRQ(ierr);
5542       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5543       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5544       ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5545       for (d = 0; d < dim; ++d) {
5546         coordsNew[offnew+d] = 0.5*(coords[offA+d] + coords[offB+d]);
5547       }
5548     }
5549     /* Just Hex 2D */
5550     if (refiner == 2) {
5551       /* Cell vertices have the average of corner coordinates */
5552       for (c = cStart; c < cEnd; ++c) {
5553         const PetscInt newv = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (c - cStart);
5554         PetscInt      *cone = NULL;
5555         PetscInt       closureSize, coneSize = 0, offA, offB, offC, offD, offnew, p, d;
5556 
5557         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5558         for (p = 0; p < closureSize*2; p += 2) {
5559           const PetscInt point = cone[p];
5560           if ((point >= vStart) && (point < vEnd)) cone[coneSize++] = point;
5561         }
5562         if (coneSize != 4) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Quad %d cone should have four vertices, not %d", c, coneSize);
5563         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
5564         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
5565         ierr = PetscSectionGetOffset(coordSection, cone[2], &offC);CHKERRQ(ierr);
5566         ierr = PetscSectionGetOffset(coordSection, cone[3], &offD);CHKERRQ(ierr);
5567         ierr = PetscSectionGetOffset(coordSectionNew, newv, &offnew);CHKERRQ(ierr);
5568         for (d = 0; d < dim; ++d) {
5569           coordsNew[offnew+d] = 0.25*(coords[offA+d] + coords[offB+d] + coords[offC+d] + coords[offD+d]);
5570         }
5571         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &cone);CHKERRQ(ierr);
5572       }
5573     }
5574     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
5575     ierr = VecRestoreArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
5576     ierr = DMSetCoordinatesLocal(rdm, coordinatesNew);CHKERRQ(ierr);
5577     ierr = VecDestroy(&coordinatesNew);CHKERRQ(ierr);
5578     ierr = PetscSectionDestroy(&coordSectionNew);CHKERRQ(ierr);
5579     break;
5580   default:
5581     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5582   }
5583   PetscFunctionReturn(0);
5584 }
5585 
5586 #undef __FUNCT__
5587 #define __FUNCT__ "DMPlexCreateProcessSF"
5588 PetscErrorCode DMPlexCreateProcessSF(DM dm, PetscSF sfPoint, IS *processRanks, PetscSF *sfProcess)
5589 {
5590   PetscInt           numRoots, numLeaves, l;
5591   const PetscInt    *localPoints;
5592   const PetscSFNode *remotePoints;
5593   PetscInt          *localPointsNew;
5594   PetscSFNode       *remotePointsNew;
5595   PetscInt          *ranks, *ranksNew;
5596   PetscErrorCode     ierr;
5597 
5598   PetscFunctionBegin;
5599   ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5600   ierr = PetscMalloc(numLeaves * sizeof(PetscInt), &ranks);CHKERRQ(ierr);
5601   for (l = 0; l < numLeaves; ++l) {
5602     ranks[l] = remotePoints[l].rank;
5603   }
5604   ierr = PetscSortRemoveDupsInt(&numLeaves, ranks);CHKERRQ(ierr);
5605   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &ranksNew);CHKERRQ(ierr);
5606   ierr = PetscMalloc(numLeaves * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5607   ierr = PetscMalloc(numLeaves * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5608   for (l = 0; l < numLeaves; ++l) {
5609     ranksNew[l]              = ranks[l];
5610     localPointsNew[l]        = l;
5611     remotePointsNew[l].index = 0;
5612     remotePointsNew[l].rank  = ranksNew[l];
5613   }
5614   ierr = PetscFree(ranks);CHKERRQ(ierr);
5615   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), numLeaves, ranksNew, PETSC_OWN_POINTER, processRanks);CHKERRQ(ierr);
5616   ierr = PetscSFCreate(PetscObjectComm((PetscObject)dm), sfProcess);CHKERRQ(ierr);
5617   ierr = PetscSFSetFromOptions(*sfProcess);CHKERRQ(ierr);
5618   ierr = PetscSFSetGraph(*sfProcess, 1, numLeaves, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5619   PetscFunctionReturn(0);
5620 }
5621 
5622 #undef __FUNCT__
5623 #define __FUNCT__ "CellRefinerCreateSF"
5624 PetscErrorCode CellRefinerCreateSF(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5625 {
5626   PetscSF            sf, sfNew, sfProcess;
5627   IS                 processRanks;
5628   MPI_Datatype       depthType;
5629   PetscInt           numRoots, numLeaves, numLeavesNew = 0, l, m;
5630   const PetscInt    *localPoints, *neighbors;
5631   const PetscSFNode *remotePoints;
5632   PetscInt          *localPointsNew;
5633   PetscSFNode       *remotePointsNew;
5634   PetscInt          *depthSizeOld, *rdepthSize, *rdepthSizeOld, *rdepthMaxOld, *rvStart, *rvStartNew, *reStart, *reStartNew, *rfStart, *rfStartNew, *rcStart, *rcStartNew;
5635   PetscInt           depth, numNeighbors, pStartNew, pEndNew, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eStartNew, eEnd, eMax, r, n;
5636   PetscErrorCode     ierr;
5637 
5638   PetscFunctionBegin;
5639   ierr = DMPlexGetChart(rdm, &pStartNew, &pEndNew);CHKERRQ(ierr);
5640   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5641   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5642   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5643   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5644   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5645   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5646   ierr = GetDepthStart_Private(depth, depthSize, &cStartNew, &fStartNew, &eStartNew, &vStartNew);CHKERRQ(ierr);
5647   switch (refiner) {
5648   case 3:
5649     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5650     cMax = PetscMin(cEnd, cMax);
5651     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5652     fMax = PetscMin(fEnd, fMax);
5653   }
5654   ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
5655   ierr = DMGetPointSF(rdm, &sfNew);CHKERRQ(ierr);
5656   /* Caculate size of new SF */
5657   ierr = PetscSFGetGraph(sf, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
5658   if (numRoots < 0) PetscFunctionReturn(0);
5659   for (l = 0; l < numLeaves; ++l) {
5660     const PetscInt p = localPoints[l];
5661 
5662     switch (refiner) {
5663     case 1:
5664       /* Simplicial 2D */
5665       if ((p >= vStart) && (p < vEnd)) {
5666         /* Old vertices stay the same */
5667         ++numLeavesNew;
5668       } else if ((p >= fStart) && (p < fEnd)) {
5669         /* Old faces add new faces and vertex */
5670         numLeavesNew += 1 + 2;
5671       } else if ((p >= cStart) && (p < cEnd)) {
5672         /* Old cells add new cells and interior faces */
5673         numLeavesNew += 4 + 3;
5674       }
5675       break;
5676     case 2:
5677       /* Hex 2D */
5678       if ((p >= vStart) && (p < vEnd)) {
5679         /* Old vertices stay the same */
5680         ++numLeavesNew;
5681       } else if ((p >= fStart) && (p < fEnd)) {
5682         /* Old faces add new faces and vertex */
5683         numLeavesNew += 1 + 2;
5684       } else if ((p >= cStart) && (p < cEnd)) {
5685         /* Old cells add new cells and interior faces */
5686         numLeavesNew += 4 + 4;
5687       }
5688       break;
5689     default:
5690       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5691     }
5692   }
5693   /* Communicate depthSizes for each remote rank */
5694   ierr = DMPlexCreateProcessSF(dm, sf, &processRanks, &sfProcess);CHKERRQ(ierr);
5695   ierr = ISGetLocalSize(processRanks, &numNeighbors);CHKERRQ(ierr);
5696   ierr = PetscMalloc5((depth+1)*numNeighbors,PetscInt,&rdepthSize,numNeighbors,PetscInt,&rvStartNew,numNeighbors,PetscInt,&reStartNew,numNeighbors,PetscInt,&rfStartNew,numNeighbors,PetscInt,&rcStartNew);CHKERRQ(ierr);
5697   ierr = PetscMalloc7(depth+1,PetscInt,&depthSizeOld,(depth+1)*numNeighbors,PetscInt,&rdepthSizeOld,(depth+1)*numNeighbors,PetscInt,&rdepthMaxOld,numNeighbors,PetscInt,&rvStart,numNeighbors,PetscInt,&reStart,numNeighbors,PetscInt,&rfStart,numNeighbors,PetscInt,&rcStart);CHKERRQ(ierr);
5698   ierr = MPI_Type_contiguous(depth+1, MPIU_INT, &depthType);CHKERRQ(ierr);
5699   ierr = MPI_Type_commit(&depthType);CHKERRQ(ierr);
5700   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5701   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSize, rdepthSize);CHKERRQ(ierr);
5702   for (n = 0; n < numNeighbors; ++n) {
5703     ierr = GetDepthStart_Private(depth, &rdepthSize[n*(depth+1)], &rcStartNew[n], &rfStartNew[n], &reStartNew[n], &rvStartNew[n]);CHKERRQ(ierr);
5704   }
5705   depthSizeOld[depth]   = cMax;
5706   depthSizeOld[0]       = vMax;
5707   depthSizeOld[depth-1] = fMax;
5708   depthSizeOld[1]       = eMax;
5709 
5710   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5711   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthMaxOld);CHKERRQ(ierr);
5712 
5713   depthSizeOld[depth]   = cEnd - cStart;
5714   depthSizeOld[0]       = vEnd - vStart;
5715   depthSizeOld[depth-1] = fEnd - fStart;
5716   depthSizeOld[1]       = eEnd - eStart;
5717 
5718   ierr = PetscSFBcastBegin(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5719   ierr = PetscSFBcastEnd(sfProcess, depthType, depthSizeOld, rdepthSizeOld);CHKERRQ(ierr);
5720   for (n = 0; n < numNeighbors; ++n) {
5721     ierr = GetDepthStart_Private(depth, &rdepthSizeOld[n*(depth+1)], &rcStart[n], &rfStart[n], &reStart[n], &rvStart[n]);CHKERRQ(ierr);
5722   }
5723   ierr = MPI_Type_free(&depthType);CHKERRQ(ierr);
5724   ierr = PetscSFDestroy(&sfProcess);CHKERRQ(ierr);
5725   /* Calculate new point SF */
5726   ierr = PetscMalloc(numLeavesNew * sizeof(PetscInt),    &localPointsNew);CHKERRQ(ierr);
5727   ierr = PetscMalloc(numLeavesNew * sizeof(PetscSFNode), &remotePointsNew);CHKERRQ(ierr);
5728   ierr = ISGetIndices(processRanks, &neighbors);CHKERRQ(ierr);
5729   for (l = 0, m = 0; l < numLeaves; ++l) {
5730     PetscInt    p     = localPoints[l];
5731     PetscInt    rp    = remotePoints[l].index, n;
5732     PetscMPIInt rrank = remotePoints[l].rank;
5733 
5734     ierr = PetscFindInt(rrank, numNeighbors, neighbors, &n);CHKERRQ(ierr);
5735     if (n < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Could not locate remote rank %d", rrank);
5736     switch (refiner) {
5737     case 1:
5738       /* Simplicial 2D */
5739       if ((p >= vStart) && (p < vEnd)) {
5740         /* Old vertices stay the same */
5741         localPointsNew[m]        = vStartNew     + (p  - vStart);
5742         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5743         remotePointsNew[m].rank  = rrank;
5744         ++m;
5745       } else if ((p >= fStart) && (p < fEnd)) {
5746         /* Old faces add new faces and vertex */
5747         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5748         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5749         remotePointsNew[m].rank  = rrank;
5750         ++m;
5751         for (r = 0; r < 2; ++r, ++m) {
5752           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5753           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5754           remotePointsNew[m].rank  = rrank;
5755         }
5756       } else if ((p >= cStart) && (p < cEnd)) {
5757         /* Old cells add new cells and interior faces */
5758         for (r = 0; r < 4; ++r, ++m) {
5759           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5760           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5761           remotePointsNew[m].rank  = rrank;
5762         }
5763         for (r = 0; r < 3; ++r, ++m) {
5764           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*3     + r;
5765           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*3 + r;
5766           remotePointsNew[m].rank  = rrank;
5767         }
5768       }
5769       break;
5770     case 2:
5771       /* Hex 2D */
5772       if ((p >= vStart) && (p < vEnd)) {
5773         /* Old vertices stay the same */
5774         localPointsNew[m]        = vStartNew     + (p  - vStart);
5775         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5776         remotePointsNew[m].rank  = rrank;
5777         ++m;
5778       } else if ((p >= fStart) && (p < fEnd)) {
5779         /* Old faces add new faces and vertex */
5780         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5781         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5782         remotePointsNew[m].rank  = rrank;
5783         ++m;
5784         for (r = 0; r < 2; ++r, ++m) {
5785           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5786           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5787           remotePointsNew[m].rank  = rrank;
5788         }
5789       } else if ((p >= cStart) && (p < cEnd)) {
5790         /* Old cells add new cells and interior faces */
5791         for (r = 0; r < 4; ++r, ++m) {
5792           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5793           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5794           remotePointsNew[m].rank  = rrank;
5795         }
5796         for (r = 0; r < 4; ++r, ++m) {
5797           localPointsNew[m]        = fStartNew     + (fEnd - fStart)*2                    + (p  - cStart)*4     + r;
5798           remotePointsNew[m].index = rfStartNew[n] + rdepthSizeOld[n*(depth+1)+depth-1]*2 + (rp - rcStart[n])*4 + r;
5799           remotePointsNew[m].rank  = rrank;
5800         }
5801       }
5802       break;
5803     case 3:
5804       /* Hybrid simplicial 2D */
5805       if ((p >= vStart) && (p < vEnd)) {
5806         /* Old vertices stay the same */
5807         localPointsNew[m]        = vStartNew     + (p  - vStart);
5808         remotePointsNew[m].index = rvStartNew[n] + (rp - rvStart[n]);
5809         remotePointsNew[m].rank  = rrank;
5810         ++m;
5811       } else if ((p >= fStart) && (p < fMax)) {
5812         /* Old interior faces add new faces and vertex */
5813         localPointsNew[m]        = vStartNew     + (vEnd - vStart)              + (p  - fStart);
5814         remotePointsNew[m].index = rvStartNew[n] + rdepthSizeOld[n*(depth+1)+0] + (rp - rfStart[n]);
5815         remotePointsNew[m].rank  = rrank;
5816         ++m;
5817         for (r = 0; r < 2; ++r, ++m) {
5818           localPointsNew[m]        = fStartNew     + (p  - fStart)*2     + r;
5819           remotePointsNew[m].index = rfStartNew[n] + (rp - rfStart[n])*2 + r;
5820           remotePointsNew[m].rank  = rrank;
5821         }
5822       } else if ((p >= fMax) && (p < fEnd)) {
5823         /* Old hybrid faces stay the same */
5824         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - fMax);
5825         remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rdepthMaxOld[n*(depth+1)+depth-1]);
5826         remotePointsNew[m].rank  = rrank;
5827         ++m;
5828       } else if ((p >= cStart) && (p < cMax)) {
5829         /* Old interior cells add new cells and interior faces */
5830         for (r = 0; r < 4; ++r, ++m) {
5831           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5832           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5833           remotePointsNew[m].rank  = rrank;
5834         }
5835         for (r = 0; r < 3; ++r, ++m) {
5836           localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (p  - cStart)*3     + r;
5837           remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rp - rcStart[n])*3 + r;
5838           remotePointsNew[m].rank  = rrank;
5839         }
5840       } else if ((p >= cStart) && (p < cMax)) {
5841         /* Old hybrid cells add new cells and hybrid face */
5842         for (r = 0; r < 2; ++r, ++m) {
5843           localPointsNew[m]        = cStartNew     + (p  - cStart)*4     + r;
5844           remotePointsNew[m].index = rcStartNew[n] + (rp - rcStart[n])*4 + r;
5845           remotePointsNew[m].rank  = rrank;
5846         }
5847         localPointsNew[m]        = fStartNew     + (fMax                              - fStart)*2     + (cMax                            - cStart)*3     + (p  - cMax);
5848         remotePointsNew[m].index = rfStartNew[n] + (rdepthMaxOld[n*(depth+1)+depth-1] - rfStart[n])*2 + (rdepthMaxOld[n*(depth+1)+depth] - rcStart[n])*3 + (rp - rdepthMaxOld[n*(depth+1)+depth]);
5849         remotePointsNew[m].rank  = rrank;
5850         ++m;
5851       }
5852       break;
5853     default:
5854       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
5855     }
5856   }
5857   ierr = ISRestoreIndices(processRanks, &neighbors);CHKERRQ(ierr);
5858   ierr = ISDestroy(&processRanks);CHKERRQ(ierr);
5859   ierr = PetscSFSetGraph(sfNew, pEndNew-pStartNew, numLeavesNew, localPointsNew, PETSC_OWN_POINTER, remotePointsNew, PETSC_OWN_POINTER);CHKERRQ(ierr);
5860   ierr = PetscFree5(rdepthSize,rvStartNew,reStartNew,rfStartNew,rcStartNew);CHKERRQ(ierr);
5861   ierr = PetscFree6(depthSizeOld,rdepthSizeOld,rvStart,reStart,rfStart,rcStart);CHKERRQ(ierr);
5862   PetscFunctionReturn(0);
5863 }
5864 
5865 #undef __FUNCT__
5866 #define __FUNCT__ "CellRefinerCreateLabels"
5867 PetscErrorCode CellRefinerCreateLabels(CellRefiner refiner, DM dm, PetscInt depthSize[], DM rdm)
5868 {
5869   PetscInt       numLabels, l;
5870   PetscInt       newp, cStart, cStartNew, cEnd, cMax, vStart, vStartNew, vEnd, vMax, fStart, fStartNew, fEnd, fMax, eStart, eEnd, eMax, r;
5871   PetscErrorCode ierr;
5872 
5873   PetscFunctionBegin;
5874   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5875   ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
5876   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5877   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
5878 
5879   cStartNew = 0;
5880   vStartNew = depthSize[2];
5881   fStartNew = depthSize[2] + depthSize[0];
5882 
5883   ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
5884   ierr = DMPlexGetHybridBounds(dm, &cMax, &fMax, &eMax, &vMax);CHKERRQ(ierr);
5885   switch (refiner) {
5886   case 3:
5887     if (cMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No cell maximum specified in hybrid mesh");
5888     cMax = PetscMin(cEnd, cMax);
5889     if (fMax < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "No face maximum specified in hybrid mesh");
5890     fMax = PetscMin(fEnd, fMax);
5891   }
5892   for (l = 0; l < numLabels; ++l) {
5893     DMLabel         label, labelNew;
5894     const char     *lname;
5895     PetscBool       isDepth;
5896     IS              valueIS;
5897     const PetscInt *values;
5898     PetscInt        numValues, val;
5899 
5900     ierr = DMPlexGetLabelName(dm, l, &lname);CHKERRQ(ierr);
5901     ierr = PetscStrcmp(lname, "depth", &isDepth);CHKERRQ(ierr);
5902     if (isDepth) continue;
5903     ierr = DMPlexCreateLabel(rdm, lname);CHKERRQ(ierr);
5904     ierr = DMPlexGetLabel(dm, lname, &label);CHKERRQ(ierr);
5905     ierr = DMPlexGetLabel(rdm, lname, &labelNew);CHKERRQ(ierr);
5906     ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
5907     ierr = ISGetLocalSize(valueIS, &numValues);CHKERRQ(ierr);
5908     ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
5909     for (val = 0; val < numValues; ++val) {
5910       IS              pointIS;
5911       const PetscInt *points;
5912       PetscInt        numPoints, n;
5913 
5914       ierr = DMLabelGetStratumIS(label, values[val], &pointIS);CHKERRQ(ierr);
5915       ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
5916       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
5917       for (n = 0; n < numPoints; ++n) {
5918         const PetscInt p = points[n];
5919         switch (refiner) {
5920         case 1:
5921           /* Simplicial 2D */
5922           if ((p >= vStart) && (p < vEnd)) {
5923             /* Old vertices stay the same */
5924             newp = vStartNew + (p - vStart);
5925             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5926           } else if ((p >= fStart) && (p < fEnd)) {
5927             /* Old faces add new faces and vertex */
5928             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5929             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5930             for (r = 0; r < 2; ++r) {
5931               newp = fStartNew + (p - fStart)*2 + r;
5932               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5933             }
5934           } else if ((p >= cStart) && (p < cEnd)) {
5935             /* Old cells add new cells and interior faces */
5936             for (r = 0; r < 4; ++r) {
5937               newp = cStartNew + (p - cStart)*4 + r;
5938               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5939             }
5940             for (r = 0; r < 3; ++r) {
5941               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
5942               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5943             }
5944           }
5945           break;
5946         case 2:
5947           /* Hex 2D */
5948           if ((p >= vStart) && (p < vEnd)) {
5949             /* Old vertices stay the same */
5950             newp = vStartNew + (p - vStart);
5951             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5952           } else if ((p >= fStart) && (p < fEnd)) {
5953             /* Old faces add new faces and vertex */
5954             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5955             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5956             for (r = 0; r < 2; ++r) {
5957               newp = fStartNew + (p - fStart)*2 + r;
5958               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5959             }
5960           } else if ((p >= cStart) && (p < cEnd)) {
5961             /* Old cells add new cells and interior faces and vertex */
5962             for (r = 0; r < 4; ++r) {
5963               newp = cStartNew + (p - cStart)*4 + r;
5964               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5965             }
5966             for (r = 0; r < 4; ++r) {
5967               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*4 + r;
5968               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5969             }
5970             newp = vStartNew + (vEnd - vStart) + (fEnd - fStart) + (p - cStart);
5971             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5972           }
5973           break;
5974         case 3:
5975           /* Hybrid simplicial 2D */
5976           if ((p >= vStart) && (p < vEnd)) {
5977             /* Old vertices stay the same */
5978             newp = vStartNew + (p - vStart);
5979             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5980           } else if ((p >= fStart) && (p < fMax)) {
5981             /* Old interior faces add new faces and vertex */
5982             newp = vStartNew + (vEnd - vStart) + (p - fStart);
5983             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5984             for (r = 0; r < 2; ++r) {
5985               newp = fStartNew + (p - fStart)*2 + r;
5986               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5987             }
5988           } else if ((p >= fMax) && (p < fEnd)) {
5989             /* Old hybrid faces stay the same */
5990             newp = fStartNew + (fMax - fStart)*2 + (p - fMax);
5991             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5992           } else if ((p >= cStart) && (p < cMax)) {
5993             /* Old interior cells add new cells and interior faces */
5994             for (r = 0; r < 4; ++r) {
5995               newp = cStartNew + (p - cStart)*4 + r;
5996               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
5997             }
5998             for (r = 0; r < 3; ++r) {
5999               newp = fStartNew + (fEnd - fStart)*2 + (p - cStart)*3 + r;
6000               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
6001             }
6002           } else if ((p >= cMax) && (p < cEnd)) {
6003             /* Old hybrid cells add new cells and hybrid face */
6004             for (r = 0; r < 2; ++r) {
6005               newp = cStartNew + (cMax - cStart)*4 + (p - cMax)*2 + r;
6006               ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
6007             }
6008             newp = fStartNew + (fMax - fStart)*2 + (cMax - cStart)*3 + (p - cMax);
6009             ierr = DMLabelSetValue(labelNew, newp, values[val]);CHKERRQ(ierr);
6010           }
6011           break;
6012         default:
6013           SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown cell refiner %d", refiner);
6014         }
6015       }
6016       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
6017       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
6018     }
6019     ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
6020     ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
6021     if (0) {
6022       ierr = PetscViewerASCIISynchronizedAllow(PETSC_VIEWER_STDOUT_WORLD, PETSC_TRUE);CHKERRQ(ierr);
6023       ierr = DMLabelView(labelNew, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
6024       ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
6025     }
6026   }
6027   PetscFunctionReturn(0);
6028 }
6029 
6030 #undef __FUNCT__
6031 #define __FUNCT__ "DMPlexRefine_Uniform"
6032 /* This will only work for interpolated meshes */
6033 PetscErrorCode DMPlexRefine_Uniform(DM dm, CellRefiner cellRefiner, DM *dmRefined)
6034 {
6035   DM             rdm;
6036   PetscInt      *depthSize;
6037   PetscInt       dim, depth = 0, d, pStart = 0, pEnd = 0;
6038   PetscErrorCode ierr;
6039 
6040   PetscFunctionBegin;
6041   ierr = DMCreate(PetscObjectComm((PetscObject)dm), &rdm);CHKERRQ(ierr);
6042   ierr = DMSetType(rdm, DMPLEX);CHKERRQ(ierr);
6043   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6044   ierr = DMPlexSetDimension(rdm, dim);CHKERRQ(ierr);
6045   /* Calculate number of new points of each depth */
6046   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6047   ierr = PetscMalloc((depth+1) * sizeof(PetscInt), &depthSize);CHKERRQ(ierr);
6048   ierr = PetscMemzero(depthSize, (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
6049   ierr = CellRefinerGetSizes(cellRefiner, dm, depthSize);CHKERRQ(ierr);
6050   /* Step 1: Set chart */
6051   for (d = 0; d <= depth; ++d) pEnd += depthSize[d];
6052   ierr = DMPlexSetChart(rdm, pStart, pEnd);CHKERRQ(ierr);
6053   /* Step 2: Set cone/support sizes */
6054   ierr = CellRefinerSetConeSizes(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
6055   /* Step 3: Setup refined DM */
6056   ierr = DMSetUp(rdm);CHKERRQ(ierr);
6057   /* Step 4: Set cones and supports */
6058   ierr = CellRefinerSetCones(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
6059   /* Step 5: Stratify */
6060   ierr = DMPlexStratify(rdm);CHKERRQ(ierr);
6061   /* Step 6: Set coordinates for vertices */
6062   ierr = CellRefinerSetCoordinates(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
6063   /* Step 7: Create pointSF */
6064   ierr = CellRefinerCreateSF(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
6065   /* Step 8: Create labels */
6066   ierr = CellRefinerCreateLabels(cellRefiner, dm, depthSize, rdm);CHKERRQ(ierr);
6067   ierr = PetscFree(depthSize);CHKERRQ(ierr);
6068 
6069   *dmRefined = rdm;
6070   PetscFunctionReturn(0);
6071 }
6072 
6073 #undef __FUNCT__
6074 #define __FUNCT__ "DMPlexSetRefinementUniform"
6075 PetscErrorCode DMPlexSetRefinementUniform(DM dm, PetscBool refinementUniform)
6076 {
6077   DM_Plex *mesh = (DM_Plex*) dm->data;
6078 
6079   PetscFunctionBegin;
6080   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6081   mesh->refinementUniform = refinementUniform;
6082   PetscFunctionReturn(0);
6083 }
6084 
6085 #undef __FUNCT__
6086 #define __FUNCT__ "DMPlexGetRefinementUniform"
6087 PetscErrorCode DMPlexGetRefinementUniform(DM dm, PetscBool *refinementUniform)
6088 {
6089   DM_Plex *mesh = (DM_Plex*) dm->data;
6090 
6091   PetscFunctionBegin;
6092   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6093   PetscValidPointer(refinementUniform,  2);
6094   *refinementUniform = mesh->refinementUniform;
6095   PetscFunctionReturn(0);
6096 }
6097 
6098 #undef __FUNCT__
6099 #define __FUNCT__ "DMPlexSetRefinementLimit"
6100 PetscErrorCode DMPlexSetRefinementLimit(DM dm, PetscReal refinementLimit)
6101 {
6102   DM_Plex *mesh = (DM_Plex*) dm->data;
6103 
6104   PetscFunctionBegin;
6105   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6106   mesh->refinementLimit = refinementLimit;
6107   PetscFunctionReturn(0);
6108 }
6109 
6110 #undef __FUNCT__
6111 #define __FUNCT__ "DMPlexGetRefinementLimit"
6112 PetscErrorCode DMPlexGetRefinementLimit(DM dm, PetscReal *refinementLimit)
6113 {
6114   DM_Plex *mesh = (DM_Plex*) dm->data;
6115 
6116   PetscFunctionBegin;
6117   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6118   PetscValidPointer(refinementLimit,  2);
6119   /* if (mesh->refinementLimit < 0) = getMaxVolume()/2.0; */
6120   *refinementLimit = mesh->refinementLimit;
6121   PetscFunctionReturn(0);
6122 }
6123 
6124 #undef __FUNCT__
6125 #define __FUNCT__ "DMPlexGetCellRefiner_Private"
6126 PetscErrorCode DMPlexGetCellRefiner_Private(DM dm, CellRefiner *cellRefiner)
6127 {
6128   PetscInt       dim, cStart, coneSize, cMax;
6129   PetscErrorCode ierr;
6130 
6131   PetscFunctionBegin;
6132   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6133   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
6134   ierr = DMPlexGetConeSize(dm, cStart, &coneSize);CHKERRQ(ierr);
6135   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6136   switch (dim) {
6137   case 2:
6138     switch (coneSize) {
6139     case 3:
6140       if (cMax >= 0) *cellRefiner = 3; /* Hybrid */
6141       else *cellRefiner = 1; /* Triangular */
6142       break;
6143     case 4:
6144       if (cMax >= 0) *cellRefiner = 4; /* Hybrid */
6145       else *cellRefiner = 2; /* Quadrilateral */
6146       break;
6147     default:
6148       SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown coneSize %d in dimension %d for cell refiner", coneSize, dim);
6149     }
6150     break;
6151   default:
6152     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown dimension %d for cell refiner", dim);
6153   }
6154   PetscFunctionReturn(0);
6155 }
6156 
6157 #undef __FUNCT__
6158 #define __FUNCT__ "DMRefine_Plex"
6159 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
6160 {
6161   PetscReal      refinementLimit;
6162   PetscInt       dim, cStart, cEnd;
6163   char           genname[1024], *name = NULL;
6164   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
6165   PetscErrorCode ierr;
6166 
6167   PetscFunctionBegin;
6168   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
6169   if (isUniform) {
6170     CellRefiner cellRefiner;
6171 
6172     ierr = DMPlexGetCellRefiner_Private(dm, &cellRefiner);CHKERRQ(ierr);
6173     ierr = DMPlexRefine_Uniform(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
6174     PetscFunctionReturn(0);
6175   }
6176   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
6177   if (refinementLimit == 0.0) PetscFunctionReturn(0);
6178   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6179   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6180   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
6181   if (flg) name = genname;
6182   if (name) {
6183     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
6184     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
6185     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
6186   }
6187   switch (dim) {
6188   case 2:
6189     if (!name || isTriangle) {
6190 #if defined(PETSC_HAVE_TRIANGLE)
6191       double  *maxVolumes;
6192       PetscInt c;
6193 
6194       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
6195       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
6196       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
6197 #else
6198       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
6199 #endif
6200     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
6201     break;
6202   case 3:
6203     if (!name || isCTetgen) {
6204 #if defined(PETSC_HAVE_CTETGEN)
6205       PetscReal *maxVolumes;
6206       PetscInt   c;
6207 
6208       ierr = PetscMalloc((cEnd - cStart) * sizeof(PetscReal), &maxVolumes);CHKERRQ(ierr);
6209       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
6210       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
6211 #else
6212       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
6213 #endif
6214     } else if (isTetgen) {
6215 #if defined(PETSC_HAVE_TETGEN)
6216       double  *maxVolumes;
6217       PetscInt c;
6218 
6219       ierr = PetscMalloc((cEnd - cStart) * sizeof(double), &maxVolumes);CHKERRQ(ierr);
6220       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
6221       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
6222 #else
6223       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
6224 #endif
6225     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
6226     break;
6227   default:
6228     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
6229   }
6230   PetscFunctionReturn(0);
6231 }
6232 
6233 #undef __FUNCT__
6234 #define __FUNCT__ "DMPlexGetDepth"
6235 /*@
6236   DMPlexGetDepth - get the number of strata
6237 
6238   Not Collective
6239 
6240   Input Parameters:
6241 . dm           - The DMPlex object
6242 
6243   Output Parameters:
6244 . depth - number of strata
6245 
6246   Level: developer
6247 
6248   Notes:
6249   DMPlexGetHeightStratum(dm,0,..) should return the same points as DMPlexGetDepthStratum(dm,depth,..).
6250 
6251 .keywords: mesh, points
6252 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
6253 @*/
6254 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
6255 {
6256   PetscInt       d;
6257   PetscErrorCode ierr;
6258 
6259   PetscFunctionBegin;
6260   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6261   PetscValidPointer(depth, 2);
6262   ierr   = DMPlexGetLabelSize(dm, "depth", &d);CHKERRQ(ierr);
6263   *depth = d-1;
6264   PetscFunctionReturn(0);
6265 }
6266 
6267 #undef __FUNCT__
6268 #define __FUNCT__ "DMPlexGetDepthStratum"
6269 /*@
6270   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
6271 
6272   Not Collective
6273 
6274   Input Parameters:
6275 + dm           - The DMPlex object
6276 - stratumValue - The requested depth
6277 
6278   Output Parameters:
6279 + start - The first point at this depth
6280 - end   - One beyond the last point at this depth
6281 
6282   Level: developer
6283 
6284 .keywords: mesh, points
6285 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
6286 @*/
6287 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6288 {
6289   DM_Plex       *mesh = (DM_Plex*) dm->data;
6290   DMLabel        next  = mesh->labels;
6291   PetscBool      flg   = PETSC_FALSE;
6292   PetscInt       depth;
6293   PetscErrorCode ierr;
6294 
6295   PetscFunctionBegin;
6296   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6297   if (stratumValue < 0) {
6298     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6299     PetscFunctionReturn(0);
6300   } else {
6301     PetscInt pStart, pEnd;
6302 
6303     if (start) *start = 0;
6304     if (end)   *end   = 0;
6305     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6306     if (pStart == pEnd) PetscFunctionReturn(0);
6307   }
6308   ierr = DMPlexHasLabel(dm, "depth", &flg);CHKERRQ(ierr);
6309   if (!flg) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6310   /* We should have a generic GetLabel() and a Label class */
6311   while (next) {
6312     ierr = PetscStrcmp("depth", next->name, &flg);CHKERRQ(ierr);
6313     if (flg) break;
6314     next = next->next;
6315   }
6316   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6317   depth = stratumValue;
6318   if ((depth < 0) || (depth >= next->numStrata)) {
6319     if (start) *start = 0;
6320     if (end)   *end   = 0;
6321   } else {
6322     if (start) *start = next->points[next->stratumOffsets[depth]];
6323     if (end)   *end   = next->points[next->stratumOffsets[depth]+next->stratumSizes[depth]-1]+1;
6324   }
6325   PetscFunctionReturn(0);
6326 }
6327 
6328 #undef __FUNCT__
6329 #define __FUNCT__ "DMPlexGetHeightStratum"
6330 /*@
6331   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
6332 
6333   Not Collective
6334 
6335   Input Parameters:
6336 + dm           - The DMPlex object
6337 - stratumValue - The requested height
6338 
6339   Output Parameters:
6340 + start - The first point at this height
6341 - end   - One beyond the last point at this height
6342 
6343   Level: developer
6344 
6345 .keywords: mesh, points
6346 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
6347 @*/
6348 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
6349 {
6350   DM_Plex       *mesh = (DM_Plex*) dm->data;
6351   DMLabel        next  = mesh->labels;
6352   PetscBool      flg   = PETSC_FALSE;
6353   PetscInt       depth;
6354   PetscErrorCode ierr;
6355 
6356   PetscFunctionBegin;
6357   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6358   if (stratumValue < 0) {
6359     ierr = DMPlexGetChart(dm, start, end);CHKERRQ(ierr);
6360   } else {
6361     PetscInt pStart, pEnd;
6362 
6363     if (start) *start = 0;
6364     if (end)   *end   = 0;
6365     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6366     if (pStart == pEnd) PetscFunctionReturn(0);
6367   }
6368   ierr = DMPlexHasLabel(dm, "depth", &flg);CHKERRQ(ierr);
6369   if (!flg) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
6370   /* We should have a generic GetLabel() and a Label class */
6371   while (next) {
6372     ierr = PetscStrcmp("depth", next->name, &flg);CHKERRQ(ierr);
6373     if (flg) break;
6374     next = next->next;
6375   }
6376   /* Strata are sorted and contiguous -- In addition, depth/height is either full or 1-level */
6377   depth = next->stratumValues[next->numStrata-1] - stratumValue;
6378   if ((depth < 0) || (depth >= next->numStrata)) {
6379     if (start) *start = 0;
6380     if (end)   *end   = 0;
6381   } else {
6382     if (start) *start = next->points[next->stratumOffsets[depth]];
6383     if (end)   *end   = next->points[next->stratumOffsets[depth]+next->stratumSizes[depth]-1]+1;
6384   }
6385   PetscFunctionReturn(0);
6386 }
6387 
6388 #undef __FUNCT__
6389 #define __FUNCT__ "DMPlexCreateSectionInitial"
6390 /* Set the number of dof on each point and separate by fields */
6391 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
6392 {
6393   PetscInt      *numDofTot;
6394   PetscInt       pStart = 0, pEnd = 0;
6395   PetscInt       p, d, f;
6396   PetscErrorCode ierr;
6397 
6398   PetscFunctionBegin;
6399   ierr = PetscMalloc((dim+1) * sizeof(PetscInt), &numDofTot);CHKERRQ(ierr);
6400   for (d = 0; d <= dim; ++d) {
6401     numDofTot[d] = 0;
6402     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
6403   }
6404   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
6405   if (numFields > 0) {
6406     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
6407     if (numComp) {
6408       for (f = 0; f < numFields; ++f) {
6409         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
6410       }
6411     }
6412   }
6413   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6414   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
6415   for (d = 0; d <= dim; ++d) {
6416     ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
6417     for (p = pStart; p < pEnd; ++p) {
6418       for (f = 0; f < numFields; ++f) {
6419         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
6420       }
6421       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
6422     }
6423   }
6424   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
6425   PetscFunctionReturn(0);
6426 }
6427 
6428 #undef __FUNCT__
6429 #define __FUNCT__ "DMPlexCreateSectionBCDof"
6430 /* Set the number of dof on each point and separate by fields
6431    If constDof is PETSC_DETERMINE, constrain every dof on the point
6432 */
6433 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
6434 {
6435   PetscInt       numFields;
6436   PetscInt       bc;
6437   PetscErrorCode ierr;
6438 
6439   PetscFunctionBegin;
6440   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6441   for (bc = 0; bc < numBC; ++bc) {
6442     PetscInt        field = 0;
6443     const PetscInt *idx;
6444     PetscInt        n, i;
6445 
6446     if (numFields) field = bcField[bc];
6447     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
6448     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6449     for (i = 0; i < n; ++i) {
6450       const PetscInt p        = idx[i];
6451       PetscInt       numConst = constDof;
6452 
6453       /* Constrain every dof on the point */
6454       if (numConst < 0) {
6455         if (numFields) {
6456           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
6457         } else {
6458           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
6459         }
6460       }
6461       if (numFields) {
6462         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
6463       }
6464       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
6465     }
6466     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
6467   }
6468   PetscFunctionReturn(0);
6469 }
6470 
6471 #undef __FUNCT__
6472 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
6473 /* Set the constrained indices on each point and separate by fields */
6474 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
6475 {
6476   PetscInt      *maxConstraints;
6477   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
6478   PetscErrorCode ierr;
6479 
6480   PetscFunctionBegin;
6481   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6482   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6483   ierr = PetscMalloc((numFields+1) * sizeof(PetscInt), &maxConstraints);CHKERRQ(ierr);
6484   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
6485   for (p = pStart; p < pEnd; ++p) {
6486     PetscInt cdof;
6487 
6488     if (numFields) {
6489       for (f = 0; f < numFields; ++f) {
6490         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
6491         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
6492       }
6493     } else {
6494       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6495       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
6496     }
6497   }
6498   for (f = 0; f < numFields; ++f) {
6499     maxConstraints[numFields] += maxConstraints[f];
6500   }
6501   if (maxConstraints[numFields]) {
6502     PetscInt *indices;
6503 
6504     ierr = PetscMalloc(maxConstraints[numFields] * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6505     for (p = pStart; p < pEnd; ++p) {
6506       PetscInt cdof, d;
6507 
6508       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6509       if (cdof) {
6510         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
6511         if (numFields) {
6512           PetscInt numConst = 0, foff = 0;
6513 
6514           for (f = 0; f < numFields; ++f) {
6515             PetscInt cfdof, fdof;
6516 
6517             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6518             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
6519             /* Change constraint numbering from absolute local dof number to field relative local dof number */
6520             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
6521             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
6522             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
6523             numConst += cfdof;
6524             foff     += fdof;
6525           }
6526           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6527         } else {
6528           for (d = 0; d < cdof; ++d) indices[d] = d;
6529         }
6530         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6531       }
6532     }
6533     ierr = PetscFree(indices);CHKERRQ(ierr);
6534   }
6535   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
6536   PetscFunctionReturn(0);
6537 }
6538 
6539 #undef __FUNCT__
6540 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
6541 /* Set the constrained field indices on each point */
6542 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
6543 {
6544   const PetscInt *points, *indices;
6545   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
6546   PetscErrorCode  ierr;
6547 
6548   PetscFunctionBegin;
6549   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6550   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
6551 
6552   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
6553   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
6554   if (!constraintIndices) {
6555     PetscInt *idx, i;
6556 
6557     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6558     ierr = PetscMalloc(maxDof * sizeof(PetscInt), &idx);CHKERRQ(ierr);
6559     for (i = 0; i < maxDof; ++i) idx[i] = i;
6560     for (p = 0; p < numPoints; ++p) {
6561       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
6562     }
6563     ierr = PetscFree(idx);CHKERRQ(ierr);
6564   } else {
6565     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
6566     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
6567     for (p = 0; p < numPoints; ++p) {
6568       PetscInt fcdof;
6569 
6570       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
6571       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);
6572       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
6573     }
6574     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
6575   }
6576   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
6577   PetscFunctionReturn(0);
6578 }
6579 
6580 #undef __FUNCT__
6581 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
6582 /* Set the constrained indices on each point and separate by fields */
6583 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
6584 {
6585   PetscInt      *indices;
6586   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
6587   PetscErrorCode ierr;
6588 
6589   PetscFunctionBegin;
6590   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6591   ierr = PetscMalloc(maxDof * sizeof(PetscInt), &indices);CHKERRQ(ierr);
6592   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6593   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
6594   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6595   for (p = pStart; p < pEnd; ++p) {
6596     PetscInt cdof, d;
6597 
6598     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
6599     if (cdof) {
6600       PetscInt numConst = 0, foff = 0;
6601 
6602       for (f = 0; f < numFields; ++f) {
6603         const PetscInt *fcind;
6604         PetscInt        fdof, fcdof;
6605 
6606         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
6607         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
6608         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
6609         /* Change constraint numbering from field relative local dof number to absolute local dof number */
6610         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
6611         foff     += fdof;
6612         numConst += fcdof;
6613       }
6614       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
6615       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
6616     }
6617   }
6618   ierr = PetscFree(indices);CHKERRQ(ierr);
6619   PetscFunctionReturn(0);
6620 }
6621 
6622 #undef __FUNCT__
6623 #define __FUNCT__ "DMPlexCreateSection"
6624 /*@C
6625   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
6626 
6627   Not Collective
6628 
6629   Input Parameters:
6630 + dm        - The DMPlex object
6631 . dim       - The spatial dimension of the problem
6632 . numFields - The number of fields in the problem
6633 . numComp   - An array of size numFields that holds the number of components for each field
6634 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
6635 . numBC     - The number of boundary conditions
6636 . bcField   - An array of size numBC giving the field number for each boundry condition
6637 - bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
6638 
6639   Output Parameter:
6640 . section - The PetscSection object
6641 
6642   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
6643   nubmer of dof for field 0 on each edge.
6644 
6645   Level: developer
6646 
6647   Fortran Notes:
6648   A Fortran 90 version is available as DMPlexCreateSectionF90()
6649 
6650 .keywords: mesh, elements
6651 .seealso: DMPlexCreate(), PetscSectionCreate()
6652 @*/
6653 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscSection *section)
6654 {
6655   PetscErrorCode ierr;
6656 
6657   PetscFunctionBegin;
6658   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
6659   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
6660   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
6661   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
6662   {
6663     PetscBool view = PETSC_FALSE;
6664 
6665     ierr = PetscOptionsHasName(((PetscObject) dm)->prefix, "-section_view", &view);CHKERRQ(ierr);
6666     if (view) {ierr = PetscSectionView(*section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
6667   }
6668   PetscFunctionReturn(0);
6669 }
6670 
6671 #undef __FUNCT__
6672 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
6673 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
6674 {
6675   PetscSection   section;
6676   PetscErrorCode ierr;
6677 
6678   PetscFunctionBegin;
6679   ierr = DMPlexClone(dm, cdm);CHKERRQ(ierr);
6680   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6681   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
6682   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6683   PetscFunctionReturn(0);
6684 }
6685 
6686 #undef __FUNCT__
6687 #define __FUNCT__ "DMPlexGetCoordinateSection"
6688 /*@
6689   DMPlexGetCoordinateSection - Retrieve the layout of coordinate values over the mesh.
6690 
6691   Not Collective
6692 
6693   Input Parameter:
6694 . dm - The DMPlex object
6695 
6696   Output Parameter:
6697 . section - The PetscSection object
6698 
6699   Level: intermediate
6700 
6701 .keywords: mesh, coordinates
6702 .seealso: DMGetCoordinateDM(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6703 @*/
6704 PetscErrorCode DMPlexGetCoordinateSection(DM dm, PetscSection *section)
6705 {
6706   DM             cdm;
6707   PetscErrorCode ierr;
6708 
6709   PetscFunctionBegin;
6710   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6711   PetscValidPointer(section, 2);
6712   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6713   ierr = DMGetDefaultSection(cdm, section);CHKERRQ(ierr);
6714   PetscFunctionReturn(0);
6715 }
6716 
6717 #undef __FUNCT__
6718 #define __FUNCT__ "DMPlexSetCoordinateSection"
6719 /*@
6720   DMPlexSetCoordinateSection - Set the layout of coordinate values over the mesh.
6721 
6722   Not Collective
6723 
6724   Input Parameters:
6725 + dm      - The DMPlex object
6726 - section - The PetscSection object
6727 
6728   Level: intermediate
6729 
6730 .keywords: mesh, coordinates
6731 .seealso: DMPlexGetCoordinateSection(), DMPlexGetDefaultSection(), DMPlexSetDefaultSection()
6732 @*/
6733 PetscErrorCode DMPlexSetCoordinateSection(DM dm, PetscSection section)
6734 {
6735   DM             cdm;
6736   PetscErrorCode ierr;
6737 
6738   PetscFunctionBegin;
6739   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
6740   PetscValidHeaderSpecific(section,PETSC_SECTION_CLASSID,2);
6741   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
6742   ierr = DMSetDefaultSection(cdm, section);CHKERRQ(ierr);
6743   PetscFunctionReturn(0);
6744 }
6745 
6746 #undef __FUNCT__
6747 #define __FUNCT__ "DMPlexGetConeSection"
6748 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
6749 {
6750   DM_Plex *mesh = (DM_Plex*) dm->data;
6751 
6752   PetscFunctionBegin;
6753   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6754   if (section) *section = mesh->coneSection;
6755   PetscFunctionReturn(0);
6756 }
6757 
6758 #undef __FUNCT__
6759 #define __FUNCT__ "DMPlexGetCones"
6760 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
6761 {
6762   DM_Plex *mesh = (DM_Plex*) dm->data;
6763 
6764   PetscFunctionBegin;
6765   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6766   if (cones) *cones = mesh->cones;
6767   PetscFunctionReturn(0);
6768 }
6769 
6770 #undef __FUNCT__
6771 #define __FUNCT__ "DMPlexGetConeOrientations"
6772 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
6773 {
6774   DM_Plex *mesh = (DM_Plex*) dm->data;
6775 
6776   PetscFunctionBegin;
6777   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6778   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
6779   PetscFunctionReturn(0);
6780 }
6781 
6782 /******************************** FEM Support **********************************/
6783 
6784 #undef __FUNCT__
6785 #define __FUNCT__ "DMPlexVecGetClosure"
6786 /*@C
6787   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
6788 
6789   Not collective
6790 
6791   Input Parameters:
6792 + dm - The DM
6793 . section - The section describing the layout in v, or NULL to use the default section
6794 . v - The local vector
6795 - point - The sieve point in the DM
6796 
6797   Output Parameters:
6798 + csize - The number of values in the closure, or NULL
6799 - values - The array of values, which is a borrowed array and should not be freed
6800 
6801   Fortran Notes:
6802   Since it returns an array, this routine is only available in Fortran 90, and you must
6803   include petsc.h90 in your code.
6804 
6805   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6806 
6807   Level: intermediate
6808 
6809 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6810 @*/
6811 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6812 {
6813   PetscScalar   *array, *vArray;
6814   PetscInt      *points = NULL;
6815   PetscInt       offsets[32];
6816   PetscInt       numFields, size, numPoints, pStart, pEnd, p, q, f;
6817   PetscErrorCode ierr;
6818 
6819   PetscFunctionBegin;
6820   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6821   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
6822   if (!section) {
6823     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
6824   }
6825   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6826   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6827   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6828   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6829   /* Compress out points not in the section */
6830   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
6831   for (p = 0, q = 0; p < numPoints*2; p += 2) {
6832     if ((points[p] >= pStart) && (points[p] < pEnd)) {
6833       points[q*2]   = points[p];
6834       points[q*2+1] = points[p+1];
6835       ++q;
6836     }
6837   }
6838   numPoints = q;
6839   for (p = 0, size = 0; p < numPoints*2; p += 2) {
6840     PetscInt dof, fdof;
6841 
6842     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6843     for (f = 0; f < numFields; ++f) {
6844       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6845       offsets[f+1] += fdof;
6846     }
6847     size += dof;
6848   }
6849   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
6850   if (numFields && offsets[numFields] != size) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], size);
6851   ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
6852   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
6853   for (p = 0; p < numPoints*2; p += 2) {
6854     PetscInt     o = points[p+1];
6855     PetscInt     dof, off, d;
6856     PetscScalar *varr;
6857 
6858     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6859     ierr = PetscSectionGetOffset(section, points[p], &off);CHKERRQ(ierr);
6860     varr = &vArray[off];
6861     if (numFields) {
6862       PetscInt fdof, foff, fcomp, f, c;
6863 
6864       for (f = 0, foff = 0; f < numFields; ++f) {
6865         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6866         if (o >= 0) {
6867           for (d = 0; d < fdof; ++d, ++offsets[f]) {
6868             array[offsets[f]] = varr[foff+d];
6869           }
6870         } else {
6871           ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6872           for (d = fdof/fcomp-1; d >= 0; --d) {
6873             for (c = 0; c < fcomp; ++c, ++offsets[f]) {
6874               array[offsets[f]] = varr[foff+d*fcomp+c];
6875             }
6876           }
6877         }
6878         foff += fdof;
6879       }
6880     } else {
6881       if (o >= 0) {
6882         for (d = 0; d < dof; ++d, ++offsets[0]) {
6883           array[offsets[0]] = varr[d];
6884         }
6885       } else {
6886         for (d = dof-1; d >= 0; --d, ++offsets[0]) {
6887           array[offsets[0]] = varr[d];
6888         }
6889       }
6890     }
6891   }
6892   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
6893   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
6894   if (csize) *csize = size;
6895   *values = array;
6896   PetscFunctionReturn(0);
6897 }
6898 
6899 #undef __FUNCT__
6900 #define __FUNCT__ "DMPlexVecRestoreClosure"
6901 /*@C
6902   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
6903 
6904   Not collective
6905 
6906   Input Parameters:
6907 + dm - The DM
6908 . section - The section describing the layout in v, or NULL to use the default section
6909 . v - The local vector
6910 . point - The sieve point in the DM
6911 . csize - The number of values in the closure, or NULL
6912 - values - The array of values, which is a borrowed array and should not be freed
6913 
6914   Fortran Notes:
6915   Since it returns an array, this routine is only available in Fortran 90, and you must
6916   include petsc.h90 in your code.
6917 
6918   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
6919 
6920   Level: intermediate
6921 
6922 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
6923 @*/
6924 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
6925 {
6926   PetscInt       size = 0;
6927   PetscErrorCode ierr;
6928 
6929   PetscFunctionBegin;
6930   /* Should work without recalculating size */
6931   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
6932   PetscFunctionReturn(0);
6933 }
6934 
6935 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
6936 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
6937 
6938 #undef __FUNCT__
6939 #define __FUNCT__ "updatePoint_private"
6940 PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6941 {
6942   PetscInt        cdof;   /* The number of constraints on this point */
6943   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
6944   PetscScalar    *a;
6945   PetscInt        off, cind = 0, k;
6946   PetscErrorCode  ierr;
6947 
6948   PetscFunctionBegin;
6949   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
6950   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6951   a    = &array[off];
6952   if (!cdof || setBC) {
6953     if (orientation >= 0) {
6954       for (k = 0; k < dof; ++k) {
6955         fuse(&a[k], values[k]);
6956       }
6957     } else {
6958       for (k = 0; k < dof; ++k) {
6959         fuse(&a[k], values[dof-k-1]);
6960       }
6961     }
6962   } else {
6963     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
6964     if (orientation >= 0) {
6965       for (k = 0; k < dof; ++k) {
6966         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6967         fuse(&a[k], values[k]);
6968       }
6969     } else {
6970       for (k = 0; k < dof; ++k) {
6971         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
6972         fuse(&a[k], values[dof-k-1]);
6973       }
6974     }
6975   }
6976   PetscFunctionReturn(0);
6977 }
6978 
6979 #undef __FUNCT__
6980 #define __FUNCT__ "updatePointFields_private"
6981 PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, PetscInt foffs[], void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, PetscInt orientation, const PetscScalar values[], PetscScalar array[])
6982 {
6983   PetscScalar   *a;
6984   PetscInt       numFields, off, foff, f;
6985   PetscErrorCode ierr;
6986 
6987   PetscFunctionBegin;
6988   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
6989   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
6990   a    = &array[off];
6991   for (f = 0, foff = 0; f < numFields; ++f) {
6992     PetscInt        fdof, fcomp, fcdof;
6993     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
6994     PetscInt        cind = 0, k, c;
6995 
6996     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
6997     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
6998     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
6999     if (!fcdof || setBC) {
7000       if (orientation >= 0) {
7001         for (k = 0; k < fdof; ++k) {
7002           fuse(&a[foff+k], values[foffs[f]+k]);
7003         }
7004       } else {
7005         for (k = fdof/fcomp-1; k >= 0; --k) {
7006           for (c = 0; c < fcomp; ++c) {
7007             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
7008           }
7009         }
7010       }
7011     } else {
7012       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
7013       if (orientation >= 0) {
7014         for (k = 0; k < fdof; ++k) {
7015           if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
7016           fuse(&a[foff+k], values[foffs[f]+k]);
7017         }
7018       } else {
7019         for (k = fdof/fcomp-1; k >= 0; --k) {
7020           for (c = 0; c < fcomp; ++c) {
7021             if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
7022             fuse(&a[foff+(fdof/fcomp-1-k)*fcomp+c], values[foffs[f]+k*fcomp+c]);
7023           }
7024         }
7025       }
7026     }
7027     foff     += fdof;
7028     foffs[f] += fdof;
7029   }
7030   PetscFunctionReturn(0);
7031 }
7032 
7033 #undef __FUNCT__
7034 #define __FUNCT__ "DMPlexVecSetClosure"
7035 /*@C
7036   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
7037 
7038   Not collective
7039 
7040   Input Parameters:
7041 + dm - The DM
7042 . section - The section describing the layout in v, or NULL to use the default sectionw
7043 . v - The local vector
7044 . point - The sieve point in the DM
7045 . values - The array of values, which is a borrowed array and should not be freed
7046 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
7047 
7048   Fortran Notes:
7049   Since it returns an array, this routine is only available in Fortran 90, and you must
7050   include petsc.h90 in your code.
7051 
7052   Level: intermediate
7053 
7054 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
7055 @*/
7056 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
7057 {
7058   PetscScalar   *array;
7059   PetscInt      *points = NULL;
7060   PetscInt       offsets[32];
7061   PetscInt       numFields, numPoints, off, dof, pStart, pEnd, p, q, f;
7062   PetscErrorCode ierr;
7063 
7064   PetscFunctionBegin;
7065   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7066   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
7067   if (!section) {
7068     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7069   }
7070   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7071   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
7072   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
7073   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7074   /* Compress out points not in the section */
7075   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
7076   for (p = 0, q = 0; p < numPoints*2; p += 2) {
7077     if ((points[p] >= pStart) && (points[p] < pEnd)) {
7078       points[q*2]   = points[p];
7079       points[q*2+1] = points[p+1];
7080       ++q;
7081     }
7082   }
7083   numPoints = q;
7084   for (p = 0; p < numPoints*2; p += 2) {
7085     PetscInt fdof;
7086 
7087     for (f = 0; f < numFields; ++f) {
7088       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
7089       offsets[f+1] += fdof;
7090     }
7091   }
7092   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
7093   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
7094   if (numFields) {
7095     switch (mode) {
7096     case INSERT_VALUES:
7097       for (p = 0; p < numPoints*2; p += 2) {
7098         PetscInt o = points[p+1];
7099         updatePointFields_private(section, points[p], offsets, insert, PETSC_FALSE, o, values, array);
7100       } break;
7101     case INSERT_ALL_VALUES:
7102       for (p = 0; p < numPoints*2; p += 2) {
7103         PetscInt o = points[p+1];
7104         updatePointFields_private(section, points[p], offsets, insert, PETSC_TRUE,  o, values, array);
7105       } break;
7106     case ADD_VALUES:
7107       for (p = 0; p < numPoints*2; p += 2) {
7108         PetscInt o = points[p+1];
7109         updatePointFields_private(section, points[p], offsets, add,    PETSC_FALSE, o, values, array);
7110       } break;
7111     case ADD_ALL_VALUES:
7112       for (p = 0; p < numPoints*2; p += 2) {
7113         PetscInt o = points[p+1];
7114         updatePointFields_private(section, points[p], offsets, add,    PETSC_TRUE,  o, values, array);
7115       } break;
7116     default:
7117       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
7118     }
7119   } else {
7120     switch (mode) {
7121     case INSERT_VALUES:
7122       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7123         PetscInt o = points[p+1];
7124         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7125         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
7126       } break;
7127     case INSERT_ALL_VALUES:
7128       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7129         PetscInt o = points[p+1];
7130         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7131         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
7132       } break;
7133     case ADD_VALUES:
7134       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7135         PetscInt o = points[p+1];
7136         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7137         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
7138       } break;
7139     case ADD_ALL_VALUES:
7140       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
7141         PetscInt o = points[p+1];
7142         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7143         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
7144       } break;
7145     default:
7146       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
7147     }
7148   }
7149   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7150   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
7151   PetscFunctionReturn(0);
7152 }
7153 
7154 #undef __FUNCT__
7155 #define __FUNCT__ "DMPlexPrintMatSetValues"
7156 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numIndices, const PetscInt indices[], const PetscScalar values[])
7157 {
7158   PetscMPIInt    rank;
7159   PetscInt       i, j;
7160   PetscErrorCode ierr;
7161 
7162   PetscFunctionBegin;
7163   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
7164   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
7165   for (i = 0; i < numIndices; i++) {
7166     ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat indices[%D] = %D\n", rank, i, indices[i]);CHKERRQ(ierr);
7167   }
7168   for (i = 0; i < numIndices; i++) {
7169     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
7170     for (j = 0; j < numIndices; j++) {
7171 #if defined(PETSC_USE_COMPLEX)
7172       ierr = PetscViewerASCIIPrintf(viewer, " (%G,%G)", PetscRealPart(values[i*numIndices+j]), PetscImaginaryPart(values[i*numIndices+j]));CHKERRQ(ierr);
7173 #else
7174       ierr = PetscViewerASCIIPrintf(viewer, " %G", values[i*numIndices+j]);CHKERRQ(ierr);
7175 #endif
7176     }
7177     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
7178   }
7179   PetscFunctionReturn(0);
7180 }
7181 
7182 #undef __FUNCT__
7183 #define __FUNCT__ "indicesPoint_private"
7184 /* . off - The global offset of this point */
7185 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
7186 {
7187   PetscInt        dof;    /* The number of unknowns on this point */
7188   PetscInt        cdof;   /* The number of constraints on this point */
7189   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
7190   PetscInt        cind = 0, k;
7191   PetscErrorCode  ierr;
7192 
7193   PetscFunctionBegin;
7194   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
7195   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
7196   if (!cdof || setBC) {
7197     if (orientation >= 0) {
7198       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
7199     } else {
7200       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
7201     }
7202   } else {
7203     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
7204     if (orientation >= 0) {
7205       for (k = 0; k < dof; ++k) {
7206         if ((cind < cdof) && (k == cdofs[cind])) {
7207           /* Insert check for returning constrained indices */
7208           indices[*loff+k] = -(off+k+1);
7209           ++cind;
7210         } else {
7211           indices[*loff+k] = off+k-cind;
7212         }
7213       }
7214     } else {
7215       for (k = 0; k < dof; ++k) {
7216         if ((cind < cdof) && (k == cdofs[cind])) {
7217           /* Insert check for returning constrained indices */
7218           indices[*loff+dof-k-1] = -(off+k+1);
7219           ++cind;
7220         } else {
7221           indices[*loff+dof-k-1] = off+k-cind;
7222         }
7223       }
7224     }
7225   }
7226   *loff += dof;
7227   PetscFunctionReturn(0);
7228 }
7229 
7230 #undef __FUNCT__
7231 #define __FUNCT__ "indicesPointFields_private"
7232 /* . off - The global offset of this point */
7233 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
7234 {
7235   PetscInt       numFields, foff, f;
7236   PetscErrorCode ierr;
7237 
7238   PetscFunctionBegin;
7239   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7240   for (f = 0, foff = 0; f < numFields; ++f) {
7241     PetscInt        fdof, fcomp, cfdof;
7242     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
7243     PetscInt        cind = 0, k, c;
7244 
7245     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
7246     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
7247     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
7248     if (!cfdof || setBC) {
7249       if (orientation >= 0) {
7250         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
7251       } else {
7252         for (k = fdof/fcomp-1; k >= 0; --k) {
7253           for (c = 0; c < fcomp; ++c) {
7254             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
7255           }
7256         }
7257       }
7258     } else {
7259       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
7260       if (orientation >= 0) {
7261         for (k = 0; k < fdof; ++k) {
7262           if ((cind < cfdof) && (k == fcdofs[cind])) {
7263             indices[foffs[f]+k] = -(off+foff+k+1);
7264             ++cind;
7265           } else {
7266             indices[foffs[f]+k] = off+foff+k-cind;
7267           }
7268         }
7269       } else {
7270         for (k = fdof/fcomp-1; k >= 0; --k) {
7271           for (c = 0; c < fcomp; ++c) {
7272             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
7273               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
7274               ++cind;
7275             } else {
7276               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
7277             }
7278           }
7279         }
7280       }
7281     }
7282     foff     += fdof - cfdof;
7283     foffs[f] += fdof;
7284   }
7285   PetscFunctionReturn(0);
7286 }
7287 
7288 #undef __FUNCT__
7289 #define __FUNCT__ "DMPlexMatSetClosure"
7290 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
7291 {
7292   DM_Plex       *mesh   = (DM_Plex*) dm->data;
7293   PetscInt      *points = NULL;
7294   PetscInt      *indices;
7295   PetscInt       offsets[32];
7296   PetscInt       numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
7297   PetscBool      useDefault       =       !section ? PETSC_TRUE : PETSC_FALSE;
7298   PetscBool      useGlobalDefault = !globalSection ? PETSC_TRUE : PETSC_FALSE;
7299   PetscErrorCode ierr;
7300 
7301   PetscFunctionBegin;
7302   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7303   PetscValidHeaderSpecific(A, MAT_CLASSID, 3);
7304   if (useDefault) {
7305     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7306   }
7307   if (useGlobalDefault) {
7308     if (useDefault) {
7309       ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);
7310     } else {
7311       ierr = PetscSectionCreateGlobalSection(section, dm->sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7312     }
7313   }
7314   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7315   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
7316   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
7317   ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7318   /* Compress out points not in the section */
7319   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
7320   for (p = 0, q = 0; p < numPoints*2; p += 2) {
7321     if ((points[p] >= pStart) && (points[p] < pEnd)) {
7322       points[q*2]   = points[p];
7323       points[q*2+1] = points[p+1];
7324       ++q;
7325     }
7326   }
7327   numPoints = q;
7328   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
7329     PetscInt fdof;
7330 
7331     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
7332     for (f = 0; f < numFields; ++f) {
7333       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
7334       offsets[f+1] += fdof;
7335     }
7336     numIndices += dof;
7337   }
7338   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
7339 
7340   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
7341   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7342   if (numFields) {
7343     for (p = 0; p < numPoints*2; p += 2) {
7344       PetscInt o = points[p+1];
7345       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7346       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
7347     }
7348   } else {
7349     for (p = 0, off = 0; p < numPoints*2; p += 2) {
7350       PetscInt o = points[p+1];
7351       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
7352       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
7353     }
7354   }
7355   if (useGlobalDefault && !useDefault) {
7356     ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7357   }
7358   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr);}
7359   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
7360   if (ierr) {
7361     PetscMPIInt    rank;
7362     PetscErrorCode ierr2;
7363 
7364     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
7365     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
7366     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, values);CHKERRQ(ierr2);
7367     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
7368     CHKERRQ(ierr);
7369   }
7370   ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
7371   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
7372   PetscFunctionReturn(0);
7373 }
7374 
7375 PETSC_STATIC_INLINE PetscInt epsilon(PetscInt i, PetscInt j, PetscInt k)
7376 {
7377   switch (i) {
7378   case 0:
7379     switch (j) {
7380     case 0: return 0;
7381     case 1:
7382       switch (k) {
7383       case 0: return 0;
7384       case 1: return 0;
7385       case 2: return 1;
7386       }
7387     case 2:
7388       switch (k) {
7389       case 0: return 0;
7390       case 1: return -1;
7391       case 2: return 0;
7392       }
7393     }
7394   case 1:
7395     switch (j) {
7396     case 0:
7397       switch (k) {
7398       case 0: return 0;
7399       case 1: return 0;
7400       case 2: return -1;
7401       }
7402     case 1: return 0;
7403     case 2:
7404       switch (k) {
7405       case 0: return 1;
7406       case 1: return 0;
7407       case 2: return 0;
7408       }
7409     }
7410   case 2:
7411     switch (j) {
7412     case 0:
7413       switch (k) {
7414       case 0: return 0;
7415       case 1: return 1;
7416       case 2: return 0;
7417       }
7418     case 1:
7419       switch (k) {
7420       case 0: return -1;
7421       case 1: return 0;
7422       case 2: return 0;
7423       }
7424     case 2: return 0;
7425     }
7426   }
7427   return 0;
7428 }
7429 
7430 #undef __FUNCT__
7431 #define __FUNCT__ "DMPlexCreateRigidBody"
7432 /*@C
7433   DMPlexCreateRigidBody - create rigid body modes from coordinates
7434 
7435   Collective on DM
7436 
7437   Input Arguments:
7438 + dm - the DM
7439 . section - the local section associated with the rigid field, or NULL for the default section
7440 - globalSection - the global section associated with the rigid field, or NULL for the default section
7441 
7442   Output Argument:
7443 . sp - the null space
7444 
7445   Note: This is necessary to take account of Dirichlet conditions on the displacements
7446 
7447   Level: advanced
7448 
7449 .seealso: MatNullSpaceCreate()
7450 @*/
7451 PetscErrorCode DMPlexCreateRigidBody(DM dm, PetscSection section, PetscSection globalSection, MatNullSpace *sp)
7452 {
7453   MPI_Comm       comm;
7454   Vec            coordinates, localMode, mode[6];
7455   PetscSection   coordSection;
7456   PetscScalar   *coords;
7457   PetscInt       dim, vStart, vEnd, v, n, m, d, i, j;
7458   PetscErrorCode ierr;
7459 
7460   PetscFunctionBegin;
7461   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
7462   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7463   if (dim == 1) {
7464     ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr);
7465     PetscFunctionReturn(0);
7466   }
7467   if (!section)       {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
7468   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
7469   ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
7470   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7471   ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
7472   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
7473   m    = (dim*(dim+1))/2;
7474   ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
7475   ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
7476   ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
7477   for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
7478   /* Assume P1 */
7479   ierr = DMGetLocalVector(dm, &localMode);CHKERRQ(ierr);
7480   for (d = 0; d < dim; ++d) {
7481     PetscScalar values[3] = {0.0, 0.0, 0.0};
7482 
7483     values[d] = 1.0;
7484     ierr      = VecSet(localMode, 0.0);CHKERRQ(ierr);
7485     for (v = vStart; v < vEnd; ++v) {
7486       ierr = DMPlexVecSetClosure(dm, section, localMode, v, values, INSERT_VALUES);CHKERRQ(ierr);
7487     }
7488     ierr = DMLocalToGlobalBegin(dm, localMode, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
7489     ierr = DMLocalToGlobalEnd(dm, localMode, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
7490   }
7491   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
7492   for (d = dim; d < dim*(dim+1)/2; ++d) {
7493     PetscInt i, j, k = dim > 2 ? d - dim : d;
7494 
7495     ierr = VecSet(localMode, 0.0);CHKERRQ(ierr);
7496     for (v = vStart; v < vEnd; ++v) {
7497       PetscScalar values[3] = {0.0, 0.0, 0.0};
7498       PetscInt    off;
7499 
7500       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
7501       for (i = 0; i < dim; ++i) {
7502         for (j = 0; j < dim; ++j) {
7503           values[j] += epsilon(i, j, k)*PetscRealPart(coords[off+i]);
7504         }
7505       }
7506       ierr = DMPlexVecSetClosure(dm, section, localMode, v, values, INSERT_VALUES);CHKERRQ(ierr);
7507     }
7508     ierr = DMLocalToGlobalBegin(dm, localMode, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
7509     ierr = DMLocalToGlobalEnd(dm, localMode, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
7510   }
7511   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
7512   ierr = DMRestoreLocalVector(dm, &localMode);CHKERRQ(ierr);
7513   for (i = 0; i < dim; ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);}
7514   /* Orthonormalize system */
7515   for (i = dim; i < m; ++i) {
7516     PetscScalar dots[6];
7517 
7518     ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr);
7519     for (j = 0; j < i; ++j) dots[j] *= -1.0;
7520     ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr);
7521     ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
7522   }
7523   ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr);
7524   for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
7525   PetscFunctionReturn(0);
7526 }
7527 
7528 #undef __FUNCT__
7529 #define __FUNCT__ "DMPlexGetHybridBounds"
7530 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
7531 {
7532   DM_Plex       *mesh = (DM_Plex*) dm->data;
7533   PetscInt       dim;
7534   PetscErrorCode ierr;
7535 
7536   PetscFunctionBegin;
7537   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7538   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7539   if (cMax) *cMax = mesh->hybridPointMax[dim];
7540   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
7541   if (eMax) *eMax = mesh->hybridPointMax[1];
7542   if (vMax) *vMax = mesh->hybridPointMax[0];
7543   PetscFunctionReturn(0);
7544 }
7545 
7546 #undef __FUNCT__
7547 #define __FUNCT__ "DMPlexSetHybridBounds"
7548 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
7549 {
7550   DM_Plex       *mesh = (DM_Plex*) dm->data;
7551   PetscInt       dim;
7552   PetscErrorCode ierr;
7553 
7554   PetscFunctionBegin;
7555   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7556   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7557   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
7558   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
7559   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
7560   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
7561   PetscFunctionReturn(0);
7562 }
7563 
7564 #undef __FUNCT__
7565 #define __FUNCT__ "DMPlexGetVTKCellHeight"
7566 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
7567 {
7568   DM_Plex *mesh = (DM_Plex*) dm->data;
7569 
7570   PetscFunctionBegin;
7571   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7572   PetscValidPointer(cellHeight, 2);
7573   *cellHeight = mesh->vtkCellHeight;
7574   PetscFunctionReturn(0);
7575 }
7576 
7577 #undef __FUNCT__
7578 #define __FUNCT__ "DMPlexSetVTKCellHeight"
7579 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
7580 {
7581   DM_Plex *mesh = (DM_Plex*) dm->data;
7582 
7583   PetscFunctionBegin;
7584   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7585   mesh->vtkCellHeight = cellHeight;
7586   PetscFunctionReturn(0);
7587 }
7588 
7589 #undef __FUNCT__
7590 #define __FUNCT__ "DMPlexCreateNumbering_Private"
7591 /* We can easily have a form that takes an IS instead */
7592 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
7593 {
7594   PetscSection   section, globalSection;
7595   PetscInt      *numbers, p;
7596   PetscErrorCode ierr;
7597 
7598   PetscFunctionBegin;
7599   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
7600   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
7601   for (p = pStart; p < pEnd; ++p) {
7602     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
7603   }
7604   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
7605   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7606   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &numbers);CHKERRQ(ierr);
7607   for (p = pStart; p < pEnd; ++p) {
7608     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
7609   }
7610   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
7611   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
7612   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7613   PetscFunctionReturn(0);
7614 }
7615 
7616 #undef __FUNCT__
7617 #define __FUNCT__ "DMPlexGetCellNumbering"
7618 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7619 {
7620   DM_Plex       *mesh = (DM_Plex*) dm->data;
7621   PetscInt       cellHeight, cStart, cEnd, cMax;
7622   PetscErrorCode ierr;
7623 
7624   PetscFunctionBegin;
7625   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7626   if (!mesh->globalCellNumbers) {
7627     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7628     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7629     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
7630     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
7631     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
7632   }
7633   *globalCellNumbers = mesh->globalCellNumbers;
7634   PetscFunctionReturn(0);
7635 }
7636 
7637 #undef __FUNCT__
7638 #define __FUNCT__ "DMPlexGetVertexNumbering"
7639 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7640 {
7641   DM_Plex       *mesh = (DM_Plex*) dm->data;
7642   PetscInt       vStart, vEnd, vMax;
7643   PetscErrorCode ierr;
7644 
7645   PetscFunctionBegin;
7646   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7647   if (!mesh->globalVertexNumbers) {
7648     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7649     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
7650     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
7651     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
7652   }
7653   *globalVertexNumbers = mesh->globalVertexNumbers;
7654   PetscFunctionReturn(0);
7655 }
7656 
7657 #undef __FUNCT__
7658 #define __FUNCT__ "DMPlexGetScale"
7659 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale)
7660 {
7661   DM_Plex *mesh = (DM_Plex*) dm->data;
7662 
7663   PetscFunctionBegin;
7664   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7665   PetscValidPointer(scale, 3);
7666   *scale = mesh->scale[unit];
7667   PetscFunctionReturn(0);
7668 }
7669 
7670 #undef __FUNCT__
7671 #define __FUNCT__ "DMPlexSetScale"
7672 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale)
7673 {
7674   DM_Plex *mesh = (DM_Plex*) dm->data;
7675 
7676   PetscFunctionBegin;
7677   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7678   mesh->scale[unit] = scale;
7679   PetscFunctionReturn(0);
7680 }
7681 
7682 
7683 /*******************************************************************************
7684 This should be in a separate Discretization object, but I am not sure how to lay
7685 it out yet, so I am stuffing things here while I experiment.
7686 *******************************************************************************/
7687 #undef __FUNCT__
7688 #define __FUNCT__ "DMPlexSetFEMIntegration"
7689 PetscErrorCode DMPlexSetFEMIntegration(DM dm,
7690                                           PetscErrorCode (*integrateResidualFEM)(PetscInt, PetscInt, PetscInt, PetscQuadrature[], const PetscScalar[],
7691                                                                                  const PetscReal[], const PetscReal[], const PetscReal[], const PetscReal[],
7692                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7693                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]), PetscScalar[]),
7694                                           PetscErrorCode (*integrateJacobianActionFEM)(PetscInt, PetscInt, PetscInt, PetscQuadrature[], const PetscScalar[], const PetscScalar[],
7695                                                                                        const PetscReal[], const PetscReal[], const PetscReal[], const PetscReal[],
7696                                                                                        void (**)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7697                                                                                        void (**)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7698                                                                                        void (**)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7699                                                                                        void (**)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]), PetscScalar[]),
7700                                           PetscErrorCode (*integrateJacobianFEM)(PetscInt, PetscInt, PetscInt, PetscInt, PetscQuadrature[], const PetscScalar[],
7701                                                                                  const PetscReal[], const PetscReal[], const PetscReal[], const PetscReal[],
7702                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7703                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7704                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]),
7705                                                                                  void (*)(const PetscScalar[], const PetscScalar[], const PetscReal[], PetscScalar[]), PetscScalar[]))
7706 {
7707   DM_Plex *mesh = (DM_Plex*) dm->data;
7708 
7709   PetscFunctionBegin;
7710   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7711   mesh->integrateResidualFEM       = integrateResidualFEM;
7712   mesh->integrateJacobianActionFEM = integrateJacobianActionFEM;
7713   mesh->integrateJacobianFEM       = integrateJacobianFEM;
7714   PetscFunctionReturn(0);
7715 }
7716 
7717 #undef __FUNCT__
7718 #define __FUNCT__ "DMPlexProjectFunctionLocal"
7719 PetscErrorCode DMPlexProjectFunctionLocal(DM dm, PetscInt numComp, PetscScalar (**funcs)(const PetscReal []), InsertMode mode, Vec localX)
7720 {
7721   Vec            coordinates;
7722   PetscSection   section, cSection;
7723   PetscInt       dim, vStart, vEnd, v, c, d;
7724   PetscScalar   *values, *cArray;
7725   PetscReal     *coords;
7726   PetscErrorCode ierr;
7727 
7728   PetscFunctionBegin;
7729   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7730   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7731   ierr = DMPlexGetCoordinateSection(dm, &cSection);CHKERRQ(ierr);
7732   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
7733   ierr = PetscMalloc(numComp * sizeof(PetscScalar), &values);CHKERRQ(ierr);
7734   ierr = VecGetArray(coordinates, &cArray);CHKERRQ(ierr);
7735   ierr = PetscSectionGetDof(cSection, vStart, &dim);CHKERRQ(ierr);
7736   ierr = PetscMalloc(dim * sizeof(PetscReal),&coords);CHKERRQ(ierr);
7737   for (v = vStart; v < vEnd; ++v) {
7738     PetscInt dof, off;
7739 
7740     ierr = PetscSectionGetDof(cSection, v, &dof);CHKERRQ(ierr);
7741     ierr = PetscSectionGetOffset(cSection, v, &off);CHKERRQ(ierr);
7742     if (dof > dim) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Cannot have more coordinates %d then dimensions %d", dof, dim);
7743     for (d = 0; d < dof; ++d) coords[d] = PetscRealPart(cArray[off+d]);
7744     for (c = 0; c < numComp; ++c) values[c] = (*funcs[c])(coords);
7745     ierr = VecSetValuesSection(localX, section, v, values, mode);CHKERRQ(ierr);
7746   }
7747   ierr = VecRestoreArray(coordinates, &cArray);CHKERRQ(ierr);
7748   /* Temporary, must be replaced by a projection on the finite element basis */
7749   {
7750     PetscInt eStart = 0, eEnd = 0, e, depth;
7751 
7752     ierr = DMPlexGetLabelSize(dm, "depth", &depth);CHKERRQ(ierr);
7753     --depth;
7754     if (depth > 1) {ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);}
7755     for (e = eStart; e < eEnd; ++e) {
7756       const PetscInt *cone = NULL;
7757       PetscInt        coneSize, d;
7758       PetscScalar    *coordsA, *coordsB;
7759 
7760       ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
7761       ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
7762       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Cone size %d for point %d should be 2", coneSize, e);
7763       ierr = VecGetValuesSection(coordinates, cSection, cone[0], &coordsA);CHKERRQ(ierr);
7764       ierr = VecGetValuesSection(coordinates, cSection, cone[1], &coordsB);CHKERRQ(ierr);
7765       for (d = 0; d < dim; ++d) {
7766         coords[d] = 0.5*(PetscRealPart(coordsA[d]) + PetscRealPart(coordsB[d]));
7767       }
7768       for (c = 0; c < numComp; ++c) values[c] = (*funcs[c])(coords);
7769       ierr = VecSetValuesSection(localX, section, e, values, mode);CHKERRQ(ierr);
7770     }
7771   }
7772 
7773   ierr = PetscFree(coords);CHKERRQ(ierr);
7774   ierr = PetscFree(values);CHKERRQ(ierr);
7775 #if 0
7776   const PetscInt localDof = this->_mesh->sizeWithBC(s, *cells->begin());
7777   PetscReal      detJ;
7778 
7779   ierr = PetscMalloc(localDof * sizeof(PetscScalar), &values);CHKERRQ(ierr);
7780   ierr = PetscMalloc2(dim,PetscReal,&v0,dim*dim,PetscReal,&J);CHKERRQ(ierr);
7781   ALE::ISieveVisitor::PointRetriever<PETSC_MESH_TYPE::sieve_type> pV(PetscPowInt(this->_mesh->getSieve()->getMaxConeSize(),dim+1), true);
7782 
7783   for (PetscInt c = cStart; c < cEnd; ++c) {
7784     ALE::ISieveTraversal<PETSC_MESH_TYPE::sieve_type>::orientedClosure(*this->_mesh->getSieve(), c, pV);
7785     const PETSC_MESH_TYPE::point_type *oPoints = pV.getPoints();
7786     const int                          oSize   = pV.getSize();
7787     int                                v       = 0;
7788 
7789     ierr = DMPlexComputeCellGeometry(dm, c, v0, J, NULL, &detJ);CHKERRQ(ierr);
7790     for (PetscInt cl = 0; cl < oSize; ++cl) {
7791       const PetscInt fDim;
7792 
7793       ierr = PetscSectionGetDof(oPoints[cl], &fDim);CHKERRQ(ierr);
7794       if (pointDim) {
7795         for (PetscInt d = 0; d < fDim; ++d, ++v) {
7796           values[v] = (*this->_options.integrate)(v0, J, v, initFunc);
7797         }
7798       }
7799     }
7800     ierr = DMPlexVecSetClosure(dm, NULL, localX, c, values);CHKERRQ(ierr);
7801     pV.clear();
7802   }
7803   ierr = PetscFree2(v0,J);CHKERRQ(ierr);
7804   ierr = PetscFree(values);CHKERRQ(ierr);
7805 #endif
7806   PetscFunctionReturn(0);
7807 }
7808 
7809 #undef __FUNCT__
7810 #define __FUNCT__ "DMPlexProjectFunction"
7811 /*@C
7812   DMPlexProjectFunction - This projects the given function into the function space provided.
7813 
7814   Input Parameters:
7815 + dm      - The DM
7816 . numComp - The number of components (functions)
7817 . funcs   - The coordinate functions to evaluate
7818 - mode    - The insertion mode for values
7819 
7820   Output Parameter:
7821 . X - vector
7822 
7823   Level: developer
7824 
7825   Note:
7826   This currently just calls the function with the coordinates of each vertex and edge midpoint, and stores the result in a vector.
7827   We will eventually fix it.
7828 
7829 ,seealso: DMPlexComputeL2Diff()
7830 */
7831 PetscErrorCode DMPlexProjectFunction(DM dm, PetscInt numComp, PetscScalar (**funcs)(const PetscReal []), InsertMode mode, Vec X)
7832 {
7833   Vec            localX;
7834   PetscErrorCode ierr;
7835 
7836   PetscFunctionBegin;
7837   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
7838   ierr = DMPlexProjectFunctionLocal(dm, numComp, funcs, mode, localX);CHKERRQ(ierr);
7839   ierr = DMLocalToGlobalBegin(dm, localX, mode, X);CHKERRQ(ierr);
7840   ierr = DMLocalToGlobalEnd(dm, localX, mode, X);CHKERRQ(ierr);
7841   ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
7842   PetscFunctionReturn(0);
7843 }
7844 
7845 #undef __FUNCT__
7846 #define __FUNCT__ "DMPlexComputeL2Diff"
7847 /*@C
7848   DMPlexComputeL2Diff - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h.
7849 
7850   Input Parameters:
7851 + dm    - The DM
7852 . quad  - The PetscQuadrature object for each field
7853 . funcs - The functions to evaluate for each field component
7854 - X     - The coefficient vector u_h
7855 
7856   Output Parameter:
7857 . diff - The diff ||u - u_h||_2
7858 
7859   Level: developer
7860 
7861 .seealso: DMPlexProjectFunction()
7862 */
7863 PetscErrorCode DMPlexComputeL2Diff(DM dm, PetscQuadrature quad[], PetscScalar (**funcs)(const PetscReal []), Vec X, PetscReal *diff)
7864 {
7865   const PetscInt debug = 0;
7866   PetscSection   section;
7867   Vec            localX;
7868   PetscReal     *coords, *v0, *J, *invJ, detJ;
7869   PetscReal      localDiff = 0.0;
7870   PetscInt       dim, numFields, numComponents = 0, cStart, cEnd, c, field, fieldOffset, comp;
7871   PetscErrorCode ierr;
7872 
7873   PetscFunctionBegin;
7874   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7875   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7876   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7877   ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
7878   ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
7879   ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
7880   for (field = 0; field < numFields; ++field) {
7881     numComponents += quad[field].numComponents;
7882   }
7883   ierr = DMPlexProjectFunctionLocal(dm, numComponents, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
7884   ierr = PetscMalloc4(dim,PetscReal,&coords,dim,PetscReal,&v0,dim*dim,PetscReal,&J,dim*dim,PetscReal,&invJ);CHKERRQ(ierr);
7885   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7886   for (c = cStart; c < cEnd; ++c) {
7887     PetscScalar *x;
7888     PetscReal    elemDiff = 0.0;
7889 
7890     ierr = DMPlexComputeCellGeometry(dm, c, v0, J, invJ, &detJ);CHKERRQ(ierr);
7891     if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ, c);
7892     ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
7893 
7894     for (field = 0, comp = 0, fieldOffset = 0; field < numFields; ++field) {
7895       const PetscInt   numQuadPoints = quad[field].numQuadPoints;
7896       const PetscReal *quadPoints    = quad[field].quadPoints;
7897       const PetscReal *quadWeights   = quad[field].quadWeights;
7898       const PetscInt   numBasisFuncs = quad[field].numBasisFuncs;
7899       const PetscInt   numBasisComps = quad[field].numComponents;
7900       const PetscReal *basis         = quad[field].basis;
7901       PetscInt         q, d, e, fc, f;
7902 
7903       if (debug) {
7904         char title[1024];
7905         ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr);
7906         ierr = DMPrintCellVector(c, title, numBasisFuncs*numBasisComps, &x[fieldOffset]);CHKERRQ(ierr);
7907       }
7908       for (q = 0; q < numQuadPoints; ++q) {
7909         for (d = 0; d < dim; d++) {
7910           coords[d] = v0[d];
7911           for (e = 0; e < dim; e++) {
7912             coords[d] += J[d*dim+e]*(quadPoints[q*dim+e] + 1.0);
7913           }
7914         }
7915         for (fc = 0; fc < numBasisComps; ++fc) {
7916           const PetscReal funcVal     = PetscRealPart((*funcs[comp+fc])(coords));
7917           PetscReal       interpolant = 0.0;
7918           for (f = 0; f < numBasisFuncs; ++f) {
7919             const PetscInt fidx = f*numBasisComps+fc;
7920             interpolant += PetscRealPart(x[fieldOffset+fidx])*basis[q*numBasisFuncs*numBasisComps+fidx];
7921           }
7922           if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "    elem %d field %d diff %g\n", c, field, PetscSqr(interpolant - funcVal)*quadWeights[q]*detJ);CHKERRQ(ierr);}
7923           elemDiff += PetscSqr(interpolant - funcVal)*quadWeights[q]*detJ;
7924         }
7925       }
7926       comp        += numBasisComps;
7927       fieldOffset += numBasisFuncs*numBasisComps;
7928     }
7929     ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
7930     if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, "  elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);}
7931     localDiff += elemDiff;
7932   }
7933   ierr  = PetscFree4(coords,v0,J,invJ);CHKERRQ(ierr);
7934   ierr  = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
7935   ierr  = MPI_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPI_SUM, PETSC_COMM_WORLD);CHKERRQ(ierr);
7936   *diff = PetscSqrtReal(*diff);
7937   PetscFunctionReturn(0);
7938 }
7939 
7940 #undef __FUNCT__
7941 #define __FUNCT__ "DMPlexComputeResidualFEM"
7942 /*@
7943   DMPlexComputeResidualFEM - Form the local residual F from the local input X using pointwise functions specified by the user
7944 
7945   Input Parameters:
7946 + dm - The mesh
7947 . X  - Local input vector
7948 - user - The user context
7949 
7950   Output Parameter:
7951 . F  - Local output vector
7952 
7953   Note:
7954   The second member of the user context must be an FEMContext.
7955 
7956   We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator,
7957   like a GPU, or vectorize on a multicore machine.
7958 
7959 .seealso: DMPlexComputeJacobianActionFEM()
7960 */
7961 PetscErrorCode DMPlexComputeResidualFEM(DM dm, Vec X, Vec F, void *user)
7962 {
7963   DM_Plex         *mesh = (DM_Plex*) dm->data;
7964   PetscFEM        *fem  = (PetscFEM*) &((DM*) user)[1];
7965   PetscQuadrature *quad = fem->quad;
7966   PetscSection     section;
7967   PetscReal       *v0, *J, *invJ, *detJ;
7968   PetscScalar     *elemVec, *u;
7969   PetscInt         dim, numFields, field, numBatchesTmp = 1, numCells, cStart, cEnd, c;
7970   PetscInt         cellDof = 0, numComponents = 0;
7971   PetscErrorCode   ierr;
7972 
7973   PetscFunctionBegin;
7974   /* ierr = PetscLogEventBegin(ResidualFEMEvent,0,0,0,0);CHKERRQ(ierr); */
7975   ierr     = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
7976   ierr     = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
7977   ierr     = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
7978   ierr     = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7979   numCells = cEnd - cStart;
7980   for (field = 0; field < numFields; ++field) {
7981     cellDof       += quad[field].numBasisFuncs*quad[field].numComponents;
7982     numComponents += quad[field].numComponents;
7983   }
7984   ierr = DMPlexProjectFunctionLocal(dm, numComponents, fem->bcFuncs, INSERT_BC_VALUES, X);CHKERRQ(ierr);
7985   ierr = VecSet(F, 0.0);CHKERRQ(ierr);
7986   ierr = PetscMalloc6(numCells*cellDof,PetscScalar,&u,numCells*dim,PetscReal,&v0,numCells*dim*dim,PetscReal,&J,numCells*dim*dim,PetscReal,&invJ,numCells,PetscReal,&detJ,numCells*cellDof,PetscScalar,&elemVec);CHKERRQ(ierr);
7987   for (c = cStart; c < cEnd; ++c) {
7988     PetscScalar *x;
7989     PetscInt     i;
7990 
7991     ierr = DMPlexComputeCellGeometry(dm, c, &v0[c*dim], &J[c*dim*dim], &invJ[c*dim*dim], &detJ[c]);CHKERRQ(ierr);
7992     if (detJ[c] <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ[c], c);
7993     ierr = DMPlexVecGetClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
7994 
7995     for (i = 0; i < cellDof; ++i) u[c*cellDof+i] = x[i];
7996     ierr = DMPlexVecRestoreClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
7997   }
7998   for (field = 0; field < numFields; ++field) {
7999     const PetscInt numQuadPoints = quad[field].numQuadPoints;
8000     const PetscInt numBasisFuncs = quad[field].numBasisFuncs;
8001     void           (*f0)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]) = fem->f0Funcs[field];
8002     void           (*f1)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]) = fem->f1Funcs[field];
8003     /* Conforming batches */
8004     PetscInt blockSize  = numBasisFuncs*numQuadPoints;
8005     PetscInt numBlocks  = 1;
8006     PetscInt batchSize  = numBlocks * blockSize;
8007     PetscInt numBatches = numBatchesTmp;
8008     PetscInt numChunks  = numCells / (numBatches*batchSize);
8009     /* Remainder */
8010     PetscInt numRemainder = numCells % (numBatches * batchSize);
8011     PetscInt offset       = numCells - numRemainder;
8012 
8013     ierr = (*mesh->integrateResidualFEM)(numChunks*numBatches*batchSize, numFields, field, quad, u, v0, J, invJ, detJ, f0, f1, elemVec);CHKERRQ(ierr);
8014     ierr = (*mesh->integrateResidualFEM)(numRemainder, numFields, field, quad, &u[offset*cellDof], &v0[offset*dim], &J[offset*dim*dim], &invJ[offset*dim*dim], &detJ[offset],
8015                                          f0, f1, &elemVec[offset*cellDof]);CHKERRQ(ierr);
8016   }
8017   for (c = cStart; c < cEnd; ++c) {
8018     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(c, "Residual", cellDof, &elemVec[c*cellDof]);CHKERRQ(ierr);}
8019     ierr = DMPlexVecSetClosure(dm, NULL, F, c, &elemVec[c*cellDof], ADD_VALUES);CHKERRQ(ierr);
8020   }
8021   ierr = PetscFree6(u,v0,J,invJ,detJ,elemVec);CHKERRQ(ierr);
8022   if (mesh->printFEM) {
8023     PetscMPIInt rank, numProcs;
8024     PetscInt    p;
8025 
8026     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
8027     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &numProcs);CHKERRQ(ierr);
8028     ierr = PetscPrintf(PETSC_COMM_WORLD, "Residual:\n");CHKERRQ(ierr);
8029     for (p = 0; p < numProcs; ++p) {
8030       if (p == rank) {
8031         Vec f;
8032 
8033         ierr = VecDuplicate(F, &f);CHKERRQ(ierr);
8034         ierr = VecCopy(F, f);CHKERRQ(ierr);
8035         ierr = VecChop(f, 1.0e-10);CHKERRQ(ierr);
8036         ierr = VecView(f, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
8037         ierr = VecDestroy(&f);CHKERRQ(ierr);
8038         ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
8039       }
8040       ierr = PetscBarrier((PetscObject) dm);CHKERRQ(ierr);
8041     }
8042   }
8043   /* ierr = PetscLogEventEnd(ResidualFEMEvent,0,0,0,0);CHKERRQ(ierr); */
8044   PetscFunctionReturn(0);
8045 }
8046 
8047 #undef __FUNCT__
8048 #define __FUNCT__ "DMPlexComputeJacobianActionFEM"
8049 /*@C
8050   DMPlexComputeJacobianActionFEM - Form the local action of Jacobian J(u) on the local input X using pointwise functions specified by the user
8051 
8052   Input Parameters:
8053 + dm - The mesh
8054 . J  - The Jacobian shell matrix
8055 . X  - Local input vector
8056 - user - The user context
8057 
8058   Output Parameter:
8059 . F  - Local output vector
8060 
8061   Note:
8062   The second member of the user context must be an FEMContext.
8063 
8064   We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator,
8065   like a GPU, or vectorize on a multicore machine.
8066 
8067 .seealso: DMPlexComputeResidualFEM()
8068 */
8069 PetscErrorCode DMPlexComputeJacobianActionFEM(DM dm, Mat Jac, Vec X, Vec F, void *user)
8070 {
8071   DM_Plex         *mesh = (DM_Plex*) dm->data;
8072   PetscFEM        *fem  = (PetscFEM*) &((DM*) user)[1];
8073   PetscQuadrature *quad = fem->quad;
8074   PetscSection     section;
8075   JacActionCtx    *jctx;
8076   PetscReal       *v0, *J, *invJ, *detJ;
8077   PetscScalar     *elemVec, *u, *a;
8078   PetscInt         dim, numFields, field, numBatchesTmp = 1, numCells, cStart, cEnd, c;
8079   PetscInt         cellDof = 0;
8080   PetscErrorCode   ierr;
8081 
8082   PetscFunctionBegin;
8083   /* ierr = PetscLogEventBegin(JacobianActionFEMEvent,0,0,0,0);CHKERRQ(ierr); */
8084   ierr     = MatShellGetContext(Jac, &jctx);CHKERRQ(ierr);
8085   ierr     = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
8086   ierr     = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
8087   ierr     = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
8088   ierr     = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
8089   numCells = cEnd - cStart;
8090   for (field = 0; field < numFields; ++field) {
8091     cellDof += quad[field].numBasisFuncs*quad[field].numComponents;
8092   }
8093   ierr = VecSet(F, 0.0);CHKERRQ(ierr);
8094   ierr = PetscMalloc7(numCells*cellDof,PetscScalar,&u,numCells*cellDof,PetscScalar,&a,numCells*dim,PetscReal,&v0,numCells*dim*dim,PetscReal,&J,numCells*dim*dim,PetscReal,&invJ,numCells,PetscReal,&detJ,numCells*cellDof,PetscScalar,&elemVec);CHKERRQ(ierr);
8095   for (c = cStart; c < cEnd; ++c) {
8096     PetscScalar *x;
8097     PetscInt     i;
8098 
8099     ierr = DMPlexComputeCellGeometry(dm, c, &v0[c*dim], &J[c*dim*dim], &invJ[c*dim*dim], &detJ[c]);CHKERRQ(ierr);
8100     if (detJ[c] <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ[c], c);
8101     ierr = DMPlexVecGetClosure(dm, NULL, jctx->u, c, NULL, &x);CHKERRQ(ierr);
8102     for (i = 0; i < cellDof; ++i) u[c*cellDof+i] = x[i];
8103     ierr = DMPlexVecRestoreClosure(dm, NULL, jctx->u, c, NULL, &x);CHKERRQ(ierr);
8104     ierr = DMPlexVecGetClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
8105     for (i = 0; i < cellDof; ++i) a[c*cellDof+i] = x[i];
8106     ierr = DMPlexVecRestoreClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
8107   }
8108   for (field = 0; field < numFields; ++field) {
8109     const PetscInt numQuadPoints = quad[field].numQuadPoints;
8110     const PetscInt numBasisFuncs = quad[field].numBasisFuncs;
8111     /* Conforming batches */
8112     PetscInt blockSize  = numBasisFuncs*numQuadPoints;
8113     PetscInt numBlocks  = 1;
8114     PetscInt batchSize  = numBlocks * blockSize;
8115     PetscInt numBatches = numBatchesTmp;
8116     PetscInt numChunks  = numCells / (numBatches*batchSize);
8117     /* Remainder */
8118     PetscInt numRemainder = numCells % (numBatches * batchSize);
8119     PetscInt offset       = numCells - numRemainder;
8120 
8121     ierr = (*mesh->integrateJacobianActionFEM)(numChunks*numBatches*batchSize, numFields, field, quad, u, a, v0, J, invJ, detJ, fem->g0Funcs, fem->g1Funcs, fem->g2Funcs, fem->g3Funcs, elemVec);CHKERRQ(ierr);
8122     ierr = (*mesh->integrateJacobianActionFEM)(numRemainder, numFields, field, quad, &u[offset*cellDof], &a[offset*cellDof], &v0[offset*dim], &J[offset*dim*dim], &invJ[offset*dim*dim], &detJ[offset],
8123                                                fem->g0Funcs, fem->g1Funcs, fem->g2Funcs, fem->g3Funcs, &elemVec[offset*cellDof]);CHKERRQ(ierr);
8124   }
8125   for (c = cStart; c < cEnd; ++c) {
8126     if (mesh->printFEM > 1) {ierr = DMPrintCellVector(c, "Jacobian Action", cellDof, &elemVec[c*cellDof]);CHKERRQ(ierr);}
8127     ierr = DMPlexVecSetClosure(dm, NULL, F, c, &elemVec[c*cellDof], ADD_VALUES);CHKERRQ(ierr);
8128   }
8129   ierr = PetscFree7(u,a,v0,J,invJ,detJ,elemVec);CHKERRQ(ierr);
8130   if (mesh->printFEM) {
8131     PetscMPIInt rank, numProcs;
8132     PetscInt    p;
8133 
8134     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
8135     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &numProcs);CHKERRQ(ierr);
8136     ierr = PetscPrintf(PETSC_COMM_WORLD, "Jacobian Action:\n");CHKERRQ(ierr);
8137     for (p = 0; p < numProcs; ++p) {
8138       if (p == rank) {ierr = VecView(F, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);}
8139       ierr = PetscBarrier((PetscObject) dm);CHKERRQ(ierr);
8140     }
8141   }
8142   /* ierr = PetscLogEventEnd(JacobianActionFEMEvent,0,0,0,0);CHKERRQ(ierr); */
8143   PetscFunctionReturn(0);
8144 }
8145 
8146 #undef __FUNCT__
8147 #define __FUNCT__ "DMPlexComputeJacobianFEM"
8148 /*@
8149   DMPlexComputeJacobianFEM - Form the local portion of the Jacobian matrix J at the local solution X using pointwise functions specified by the user.
8150 
8151   Input Parameters:
8152 + dm - The mesh
8153 . X  - Local input vector
8154 - user - The user context
8155 
8156   Output Parameter:
8157 . Jac  - Jacobian matrix
8158 
8159   Note:
8160   The second member of the user context must be an FEMContext.
8161 
8162   We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator,
8163   like a GPU, or vectorize on a multicore machine.
8164 
8165 .seealso: FormFunctionLocal()
8166 */
8167 PetscErrorCode DMPlexComputeJacobianFEM(DM dm, Vec X, Mat Jac, Mat JacP, MatStructure *str,void *user)
8168 {
8169   DM_Plex         *mesh = (DM_Plex*) dm->data;
8170   PetscFEM        *fem  = (PetscFEM*) &((DM*) user)[1];
8171   PetscQuadrature *quad = fem->quad;
8172   PetscSection     section;
8173   PetscReal       *v0, *J, *invJ, *detJ;
8174   PetscScalar     *elemMat, *u;
8175   PetscInt         dim, numFields, field, fieldI, numBatchesTmp = 1, numCells, cStart, cEnd, c;
8176   PetscInt         cellDof = 0, numComponents = 0;
8177   PetscBool        isShell;
8178   PetscErrorCode   ierr;
8179 
8180   PetscFunctionBegin;
8181   /* ierr = PetscLogEventBegin(JacobianFEMEvent,0,0,0,0);CHKERRQ(ierr); */
8182   ierr     = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
8183   ierr     = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
8184   ierr     = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
8185   ierr     = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
8186   numCells = cEnd - cStart;
8187   for (field = 0; field < numFields; ++field) {
8188     cellDof       += quad[field].numBasisFuncs*quad[field].numComponents;
8189     numComponents += quad[field].numComponents;
8190   }
8191   ierr = DMPlexProjectFunctionLocal(dm, numComponents, fem->bcFuncs, INSERT_BC_VALUES, X);CHKERRQ(ierr);
8192   ierr = MatZeroEntries(JacP);CHKERRQ(ierr);
8193   ierr = PetscMalloc6(numCells*cellDof,PetscScalar,&u,numCells*dim,PetscReal,&v0,numCells*dim*dim,PetscReal,&J,numCells*dim*dim,PetscReal,&invJ,numCells,PetscReal,&detJ,numCells*cellDof*cellDof,PetscScalar,&elemMat);CHKERRQ(ierr);
8194   for (c = cStart; c < cEnd; ++c) {
8195     PetscScalar *x;
8196     PetscInt     i;
8197 
8198     ierr = DMPlexComputeCellGeometry(dm, c, &v0[c*dim], &J[c*dim*dim], &invJ[c*dim*dim], &detJ[c]);CHKERRQ(ierr);
8199     if (detJ[c] <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ[c], c);
8200     ierr = DMPlexVecGetClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
8201 
8202     for (i = 0; i < cellDof; ++i) u[c*cellDof+i] = x[i];
8203     ierr = DMPlexVecRestoreClosure(dm, NULL, X, c, NULL, &x);CHKERRQ(ierr);
8204   }
8205   ierr = PetscMemzero(elemMat, numCells*cellDof*cellDof * sizeof(PetscScalar));CHKERRQ(ierr);
8206   for (fieldI = 0; fieldI < numFields; ++fieldI) {
8207     const PetscInt numQuadPoints = quad[fieldI].numQuadPoints;
8208     const PetscInt numBasisFuncs = quad[fieldI].numBasisFuncs;
8209     PetscInt       fieldJ;
8210 
8211     for (fieldJ = 0; fieldJ < numFields; ++fieldJ) {
8212       void (*g0)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar g0[]) = fem->g0Funcs[fieldI*numFields+fieldJ];
8213       void (*g1)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar g1[]) = fem->g1Funcs[fieldI*numFields+fieldJ];
8214       void (*g2)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar g2[]) = fem->g2Funcs[fieldI*numFields+fieldJ];
8215       void (*g3)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar g3[]) = fem->g3Funcs[fieldI*numFields+fieldJ];
8216       /* Conforming batches */
8217       PetscInt blockSize  = numBasisFuncs*numQuadPoints;
8218       PetscInt numBlocks  = 1;
8219       PetscInt batchSize  = numBlocks * blockSize;
8220       PetscInt numBatches = numBatchesTmp;
8221       PetscInt numChunks  = numCells / (numBatches*batchSize);
8222       /* Remainder */
8223       PetscInt numRemainder = numCells % (numBatches * batchSize);
8224       PetscInt offset       = numCells - numRemainder;
8225 
8226       ierr = (*mesh->integrateJacobianFEM)(numChunks*numBatches*batchSize, numFields, fieldI, fieldJ, quad, u, v0, J, invJ, detJ, g0, g1, g2, g3, elemMat);CHKERRQ(ierr);
8227       ierr = (*mesh->integrateJacobianFEM)(numRemainder, numFields, fieldI, fieldJ, quad, &u[offset*cellDof], &v0[offset*dim], &J[offset*dim*dim], &invJ[offset*dim*dim], &detJ[offset],
8228                                            g0, g1, g2, g3, &elemMat[offset*cellDof*cellDof]);CHKERRQ(ierr);
8229     }
8230   }
8231   for (c = cStart; c < cEnd; ++c) {
8232     if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(c, "Jacobian", cellDof, cellDof, &elemMat[c*cellDof*cellDof]);CHKERRQ(ierr);}
8233     ierr = DMPlexMatSetClosure(dm, NULL, NULL, JacP, c, &elemMat[c*cellDof*cellDof], ADD_VALUES);CHKERRQ(ierr);
8234   }
8235   ierr = PetscFree6(u,v0,J,invJ,detJ,elemMat);CHKERRQ(ierr);
8236 
8237   /* Assemble matrix, using the 2-step process:
8238        MatAssemblyBegin(), MatAssemblyEnd(). */
8239   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8240   ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8241 
8242   if (mesh->printFEM) {
8243     ierr = PetscPrintf(PETSC_COMM_WORLD, "Jacobian:\n");CHKERRQ(ierr);
8244     ierr = MatChop(JacP, 1.0e-10);CHKERRQ(ierr);
8245     ierr = MatView(JacP, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
8246   }
8247   /* ierr = PetscLogEventEnd(JacobianFEMEvent,0,0,0,0);CHKERRQ(ierr); */
8248   ierr = PetscObjectTypeCompare((PetscObject)Jac, MATSHELL, &isShell);CHKERRQ(ierr);
8249   if (isShell) {
8250     JacActionCtx *jctx;
8251 
8252     ierr = MatShellGetContext(Jac, &jctx);CHKERRQ(ierr);
8253     ierr = VecCopy(X, jctx->u);CHKERRQ(ierr);
8254   }
8255   *str = SAME_NONZERO_PATTERN;
8256   PetscFunctionReturn(0);
8257 }
8258 
8259 
8260 #undef __FUNCT__
8261 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
8262 /*@C
8263   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
8264   the local section and an SF describing the section point overlap.
8265 
8266   Input Parameters:
8267   + s - The PetscSection for the local field layout
8268   . sf - The SF describing parallel layout of the section points
8269   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
8270   . label - The label specifying the points
8271   - labelValue - The label stratum specifying the points
8272 
8273   Output Parameter:
8274   . gsection - The PetscSection for the global field layout
8275 
8276   Note: This gives negative sizes and offsets to points not owned by this process
8277 
8278   Level: developer
8279 
8280 .seealso: PetscSectionCreate()
8281 @*/
8282 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
8283 {
8284   PetscInt      *neg;
8285   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
8286   PetscErrorCode ierr;
8287 
8288   PetscFunctionBegin;
8289   ierr = PetscSectionCreate(s->atlasLayout.comm, gsection);CHKERRQ(ierr);
8290   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
8291   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
8292   ierr = PetscMalloc((pEnd - pStart) * sizeof(PetscInt), &neg);CHKERRQ(ierr);
8293   /* Mark ghost points with negative dof */
8294   for (p = pStart; p < pEnd; ++p) {
8295     PetscInt value;
8296 
8297     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
8298     if (value != labelValue) continue;
8299     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
8300     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
8301     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
8302     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
8303     neg[p-pStart] = -(dof+1);
8304   }
8305   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
8306   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
8307   if (nroots >= 0) {
8308     if (nroots > pEnd - pStart) {
8309       PetscInt *tmpDof;
8310       /* Help Jed: HAVE TO MAKE A BUFFER HERE THE SIZE OF THE COMPLETE SPACE AND THEN COPY INTO THE atlasDof FOR THIS SECTION */
8311       ierr = PetscMalloc(nroots * sizeof(PetscInt), &tmpDof);CHKERRQ(ierr);
8312       ierr = PetscSFBcastBegin(sf, MPIU_INT, &neg[-pStart], tmpDof);CHKERRQ(ierr);
8313       ierr = PetscSFBcastEnd(sf, MPIU_INT, &neg[-pStart], tmpDof);CHKERRQ(ierr);
8314       for (p = pStart; p < pEnd; ++p) {
8315         if (tmpDof[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpDof[p];
8316       }
8317       ierr = PetscFree(tmpDof);CHKERRQ(ierr);
8318     } else {
8319       ierr = PetscSFBcastBegin(sf, MPIU_INT, &neg[-pStart], &(*gsection)->atlasDof[-pStart]);CHKERRQ(ierr);
8320       ierr = PetscSFBcastEnd(sf, MPIU_INT, &neg[-pStart], &(*gsection)->atlasDof[-pStart]);CHKERRQ(ierr);
8321     }
8322   }
8323   /* Calculate new sizes, get proccess offset, and calculate point offsets */
8324   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
8325     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
8326 
8327     (*gsection)->atlasOff[p] = off;
8328 
8329     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
8330   }
8331   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, s->atlasLayout.comm);CHKERRQ(ierr);
8332   globalOff -= off;
8333   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
8334     (*gsection)->atlasOff[p] += globalOff;
8335 
8336     neg[p] = -((*gsection)->atlasOff[p]+1);
8337   }
8338   /* Put in negative offsets for ghost points */
8339   if (nroots >= 0) {
8340     if (nroots > pEnd - pStart) {
8341       PetscInt *tmpOff;
8342       /* Help Jed: HAVE TO MAKE A BUFFER HERE THE SIZE OF THE COMPLETE SPACE AND THEN COPY INTO THE atlasDof FOR THIS SECTION */
8343       ierr = PetscMalloc(nroots * sizeof(PetscInt), &tmpOff);CHKERRQ(ierr);
8344       ierr = PetscSFBcastBegin(sf, MPIU_INT, &neg[-pStart], tmpOff);CHKERRQ(ierr);
8345       ierr = PetscSFBcastEnd(sf, MPIU_INT, &neg[-pStart], tmpOff);CHKERRQ(ierr);
8346       for (p = pStart; p < pEnd; ++p) {
8347         if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];
8348       }
8349       ierr = PetscFree(tmpOff);CHKERRQ(ierr);
8350     } else {
8351       ierr = PetscSFBcastBegin(sf, MPIU_INT, &neg[-pStart], &(*gsection)->atlasOff[-pStart]);CHKERRQ(ierr);
8352       ierr = PetscSFBcastEnd(sf, MPIU_INT, &neg[-pStart], &(*gsection)->atlasOff[-pStart]);CHKERRQ(ierr);
8353     }
8354   }
8355   ierr = PetscFree(neg);CHKERRQ(ierr);
8356   PetscFunctionReturn(0);
8357 }
8358