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