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