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