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