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