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