xref: /petsc/src/dm/impls/plex/plex.c (revision d3d1a6afe2c0350ca49d14e2502e7597c3acb707)
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__ "DMPlexConstraintsModifyMat"
5305 static PetscErrorCode DMPlexConstraintsModifyMat(DM dm, PetscSection section, PetscInt numPoints, PetscInt numIndices, const PetscInt points[], const PetscScalar values[], PetscInt *outNumPoints, PetscInt *outNumIndices, PetscInt *outPoints[], PetscScalar *outValues[], PetscInt offsets[])
5306 {
5307   Mat             cMat;
5308   PetscSection    aSec, cSec;
5309   IS              aIS;
5310   PetscInt        aStart = -1, aEnd = -1;
5311   const PetscInt  *anchors;
5312   PetscInt        numFields, f, p, q, newP;
5313   PetscInt        newNumPoints = 0, newNumIndices = 0;
5314   PetscInt        *newPoints, *indices, *newIndices;
5315   PetscInt        maxAnchor, maxDof;
5316   PetscInt        newOffsets[32];
5317   PetscInt        *pointMatOffsets[32];
5318   PetscInt        *newPointOffsets[32];
5319   PetscScalar     *pointMat[32];
5320   PetscScalar     *newValues,*tmpValues;
5321   PetscBool       anyConstrained = PETSC_FALSE;
5322   PetscErrorCode  ierr;
5323 
5324   PetscFunctionBegin;
5325   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5326   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5327   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5328 
5329   ierr = DMPlexGetConstraints(dm,&aSec,&aIS);CHKERRQ(ierr);
5330   /* if there are point-to-point constraints */
5331   if (aSec) {
5332     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5333     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5334     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
5335     /* figure out how many points are going to be in the new element matrix
5336      * (we allow double counting, because it's all just going to be summed
5337      * into the global matrix anyway) */
5338     for (p = 0; p < 2*numPoints; p+=2) {
5339       PetscInt b    = points[p];
5340       PetscInt bDof = 0;
5341 
5342       if (b >= aStart && b < aEnd) {
5343         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
5344       }
5345       if (bDof) {
5346         /* this point is constrained */
5347         /* it is going to be replaced by its anchors */
5348         PetscInt bOff, q;
5349 
5350         anyConstrained = PETSC_TRUE;
5351         newNumPoints  += bDof;
5352         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
5353         for (q = 0; q < bDof; q++) {
5354           PetscInt a = anchors[bOff + q];
5355           PetscInt aDof;
5356 
5357           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5358           newNumIndices += aDof;
5359           for (f = 0; f < numFields; ++f) {
5360             PetscInt fDof;
5361 
5362             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
5363             newOffsets[f+1] += fDof;
5364           }
5365         }
5366       }
5367       else {
5368         /* this point is not constrained */
5369         newNumPoints++;
5370         ierr           = PetscSectionGetDof(section,b,&bDof);CHKERRQ(ierr);
5371         newNumIndices += bDof;
5372         for (f = 0; f < numFields; ++f) {
5373           PetscInt fDof;
5374 
5375           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5376           newOffsets[f+1] += fDof;
5377         }
5378       }
5379     }
5380   }
5381   if (!anyConstrained) {
5382     *outNumPoints  = 0;
5383     *outNumIndices = 0;
5384     *outPoints     = NULL;
5385     *outValues     = NULL;
5386     if (aSec) {
5387       ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5388     }
5389     PetscFunctionReturn(0);
5390   }
5391 
5392   for (f = 1; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
5393 
5394   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", newOffsets[numFields], newNumIndices);
5395 
5396   ierr = DMPlexGetConstraintSection(dm, &cSec);CHKERRQ(ierr);
5397   ierr = DMPlexGetConstraintMatrix(dm, &cMat);CHKERRQ(ierr);
5398 
5399   /* output arrays */
5400   ierr = DMGetWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
5401   ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
5402 
5403   /* workspaces */
5404   ierr = DMGetWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
5405   if (numFields) {
5406     for (f = 0; f < numFields; f++) {
5407       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5408       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5409     }
5410   }
5411   else {
5412     ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5413     ierr = DMGetWorkArray(dm,numPoints,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5414   }
5415 
5416   /* get workspaces for the point-to-point matrices */
5417   if (numFields) {
5418     for (p = 0; p < numPoints; p++) {
5419       PetscInt b    = points[2*p];
5420       PetscInt bDof = 0;
5421 
5422       if (b >= aStart && b < aEnd) {
5423         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5424       }
5425       if (bDof) {
5426         for (f = 0; f < numFields; f++) {
5427           PetscInt fDof, q, bOff, allFDof = 0;
5428 
5429           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5430           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5431           for (q = 0; q < bDof; q++) {
5432             PetscInt a = anchors[bOff + q];
5433             PetscInt aFDof;
5434 
5435             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
5436             allFDof += aFDof;
5437           }
5438           newPointOffsets[f][p+1] = allFDof;
5439           pointMatOffsets[f][p+1] = fDof * allFDof;
5440         }
5441       }
5442       else {
5443         for (f = 0; f < numFields; f++) {
5444           PetscInt fDof;
5445 
5446           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5447           newPointOffsets[f][p+1] = fDof;
5448           pointMatOffsets[f][p+1] = 0;
5449         }
5450       }
5451     }
5452     for (f = 0; f < numFields; f++) {
5453       newPointOffsets[f][0] = 0;
5454       pointMatOffsets[f][0] = 0;
5455       for (p = 0; p < numPoints; p++) {
5456         newPointOffsets[f][p+1] += newPointOffsets[f][p];
5457         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
5458       }
5459       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5460     }
5461   }
5462   else {
5463     for (p = 0; p < numPoints; p++) {
5464       PetscInt b    = points[2*p];
5465       PetscInt bDof = 0;
5466 
5467       if (b >= aStart && b < aEnd) {
5468         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5469       }
5470       if (bDof) {
5471         PetscInt dof, bOff, q, allDof = 0;
5472 
5473         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
5474         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5475         for (q = 0; q < bDof; q++) {
5476           PetscInt a = anchors[bOff + q], aDof;
5477 
5478           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5479           allDof += aDof;
5480         }
5481         newPointOffsets[0][p+1] = allDof;
5482         pointMatOffsets[0][p+1] = dof * allDof;
5483       }
5484       else {
5485         PetscInt dof;
5486 
5487         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
5488         newPointOffsets[0][p+1] = dof;
5489         pointMatOffsets[0][p+1] = 0;
5490       }
5491     }
5492     newPointOffsets[0][0] = 0;
5493     pointMatOffsets[0][0] = 0;
5494     for (p = 0; p < numPoints; p++) {
5495       newPointOffsets[0][p+1] += newPointOffsets[0][p];
5496       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
5497     }
5498     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5499   }
5500 
5501   /* get the point-to-point matrices; construct newPoints */
5502   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
5503   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
5504   ierr = DMGetWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
5505   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
5506   if (numFields) {
5507     for (p = 0, newP = 0; p < numPoints; p++) {
5508       PetscInt b    = points[2*p];
5509       PetscInt o    = points[2*p+1];
5510       PetscInt bDof = 0;
5511 
5512       if (b >= aStart && b < aEnd) {
5513         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5514       }
5515       if (bDof) {
5516         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
5517 
5518         fStart[0] = 0;
5519         fEnd[0]   = 0;
5520         for (f = 0; f < numFields; f++) {
5521           PetscInt fDof;
5522 
5523           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
5524           fStart[f+1] = fStart[f] + fDof;
5525           fEnd[f+1]   = fStart[f+1];
5526         }
5527         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5528         ierr = indicesPointFields_private(cSec, b, bOff, fEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
5529 
5530         fAnchorStart[0] = 0;
5531         fAnchorEnd[0]   = 0;
5532         for (f = 0; f < numFields; f++) {
5533           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
5534 
5535           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
5536           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
5537         }
5538         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
5539         for (q = 0; q < bDof; q++) {
5540           PetscInt a = anchors[bOff + q], aOff;
5541 
5542           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5543           newPoints[2*(newP + q)]     = a;
5544           newPoints[2*(newP + q) + 1] = 0;
5545           ierr = PetscSectionGetOffset(section, a, &aOff);
5546           ierr = indicesPointFields_private(section, a, aOff, fAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
5547         }
5548         newP += bDof;
5549 
5550         /* get the point-to-point submatrix */
5551         for (f = 0; f < numFields; f++) {
5552           ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
5553         }
5554       }
5555       else {
5556         newPoints[2 * newP]     = b;
5557         newPoints[2 * newP + 1] = o;
5558         newP++;
5559       }
5560     }
5561   } else {
5562     for (p = 0; p < numPoints; p++) {
5563       PetscInt b    = points[2*p];
5564       PetscInt o    = points[2*p+1];
5565       PetscInt bDof = 0;
5566 
5567       if (b >= aStart && b < aEnd) {
5568         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5569       }
5570       if (bDof) {
5571         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
5572 
5573         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
5574         ierr = indicesPoint_private(cSec, b, bOff, &bEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
5575 
5576         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
5577         for (q = 0; q < bDof; q++) {
5578           PetscInt a = anchors[bOff + q], aOff;
5579 
5580           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
5581 
5582           newPoints[2*(newP + q)]     = a;
5583           newPoints[2*(newP + q) + 1] = 0;
5584           ierr = PetscSectionGetOffset(section, a, &aOff);
5585           ierr = indicesPoint_private(section, a, aOff, &bAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
5586         }
5587         newP += bDof;
5588 
5589         /* get the point-to-point submatrix */
5590         ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
5591       }
5592       else {
5593         newPoints[2 * newP]     = b;
5594         newPoints[2 * newP + 1] = o;
5595         newP++;
5596       }
5597     }
5598   }
5599 
5600   ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
5601   /* multiply constraints on the right */
5602   if (numFields) {
5603     for (f = 0; f < numFields; f++) {
5604       PetscInt oldOff = offsets[f];
5605 
5606       for (p = 0; p < numPoints; p++) {
5607         PetscInt cStart = newPointOffsets[f][p];
5608         PetscInt b      = points[2 * p];
5609         PetscInt c, r, k;
5610         PetscInt dof;
5611 
5612         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5613         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5614           PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
5615           const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
5616 
5617           for (r = 0; r < numIndices; r++) {
5618             for (c = 0; c < nCols; c++) {
5619               for (k = 0; k < dof; k++) {
5620                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
5621               }
5622             }
5623           }
5624         }
5625         else {
5626           /* copy this column as is */
5627           for (r = 0; r < numIndices; r++) {
5628             for (c = 0; c < dof; c++) {
5629               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5630             }
5631           }
5632         }
5633         oldOff += dof;
5634       }
5635     }
5636   }
5637   else {
5638     PetscInt oldOff = 0;
5639     for (p = 0; p < numPoints; p++) {
5640       PetscInt cStart = newPointOffsets[0][p];
5641       PetscInt b      = points[2 * p];
5642       PetscInt c, r, k;
5643       PetscInt dof;
5644 
5645       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5646       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5647         PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
5648         const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
5649 
5650         for (r = 0; r < numIndices; r++) {
5651           for (c = 0; c < nCols; c++) {
5652             for (k = 0; k < dof; k++) {
5653               tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
5654             }
5655           }
5656         }
5657       }
5658       else {
5659         /* copy this column as is */
5660         for (r = 0; r < numIndices; r++) {
5661           for (c = 0; c < dof; c++) {
5662             tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
5663           }
5664         }
5665       }
5666       oldOff += dof;
5667     }
5668   }
5669 
5670   ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
5671   /* multiply constraints transpose on the left */
5672   if (numFields) {
5673     for (f = 0; f < numFields; f++) {
5674       PetscInt oldOff = offsets[f];
5675 
5676       for (p = 0; p < numPoints; p++) {
5677         PetscInt rStart = newPointOffsets[f][p];
5678         PetscInt b      = points[2 * p];
5679         PetscInt c, r, k;
5680         PetscInt dof;
5681 
5682         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
5683         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
5684           PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
5685           const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
5686 
5687           for (r = 0; r < nRows; r++) {
5688             for (c = 0; c < newNumIndices; c++) {
5689               for (k = 0; k < dof; k++) {
5690                 newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5691               }
5692             }
5693           }
5694         }
5695         else {
5696           /* copy this row as is */
5697           for (r = 0; r < dof; r++) {
5698             for (c = 0; c < newNumIndices; c++) {
5699               newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5700             }
5701           }
5702         }
5703         oldOff += dof;
5704       }
5705     }
5706   }
5707   else {
5708     PetscInt oldOff = 0;
5709 
5710     for (p = 0; p < numPoints; p++) {
5711       PetscInt rStart = newPointOffsets[0][p];
5712       PetscInt b      = points[2 * p];
5713       PetscInt c, r, k;
5714       PetscInt dof;
5715 
5716       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
5717       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
5718         PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
5719         const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
5720 
5721         for (r = 0; r < nRows; r++) {
5722           for (c = 0; c < newNumIndices; c++) {
5723             for (k = 0; k < dof; k++) {
5724               newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
5725             }
5726           }
5727         }
5728       }
5729       else {
5730         /* copy this row as is */
5731         for (r = 0; r < dof; c++) {
5732           for (c = 0; c < newNumIndices; c++) {
5733             newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
5734           }
5735         }
5736       }
5737       oldOff += dof;
5738     }
5739   }
5740 
5741   /* clean up */
5742   ierr = DMRestoreWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
5743   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
5744   if (numFields) {
5745     for (f = 0; f < numFields; f++) {
5746       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5747       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5748       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5749     }
5750   }
5751   else {
5752     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5753     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5754     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5755   }
5756   ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
5757   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5758 
5759   /* output */
5760   *outNumPoints  = newNumPoints;
5761   *outNumIndices = newNumIndices;
5762   *outPoints     = newPoints;
5763   *outValues     = newValues;
5764   for (f = 0; f < numFields; f++) {
5765     offsets[f] = newOffsets[f];
5766   }
5767   PetscFunctionReturn(0);
5768 }
5769 
5770 #undef __FUNCT__
5771 #define __FUNCT__ "DMPlexMatSetClosure"
5772 /*@C
5773   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5774 
5775   Not collective
5776 
5777   Input Parameters:
5778 + dm - The DM
5779 . section - The section describing the layout in v, or NULL to use the default section
5780 . globalSection - The section describing the layout in v, or NULL to use the default global section
5781 . A - The matrix
5782 . point - The sieve point in the DM
5783 . values - The array of values
5784 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5785 
5786   Fortran Notes:
5787   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5788 
5789   Level: intermediate
5790 
5791 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5792 @*/
5793 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5794 {
5795   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5796   PetscSection    clSection;
5797   IS              clPoints;
5798   PetscInt       *points = NULL, *newPoints;
5799   const PetscInt *clp;
5800   PetscInt       *indices;
5801   PetscInt        offsets[32];
5802   PetscInt        numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5803   PetscScalar    *newValues;
5804   PetscErrorCode  ierr;
5805 
5806   PetscFunctionBegin;
5807   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5808   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5809   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5810   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5811   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5812   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5813   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5814   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5815   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5816   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5817   if (!clPoints) {
5818     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5819     /* Compress out points not in the section */
5820     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5821     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5822       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5823         points[q*2]   = points[p];
5824         points[q*2+1] = points[p+1];
5825         ++q;
5826       }
5827     }
5828     numPoints = q;
5829   } else {
5830     PetscInt dof, off;
5831 
5832     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5833     numPoints = dof/2;
5834     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5835     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5836     points = (PetscInt *) &clp[off];
5837   }
5838   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5839     PetscInt fdof;
5840 
5841     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5842     for (f = 0; f < numFields; ++f) {
5843       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5844       offsets[f+1] += fdof;
5845     }
5846     numIndices += dof;
5847   }
5848   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5849 
5850   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5851   ierr = DMPlexConstraintsModifyMat(dm,section,numPoints,numIndices,points,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets);CHKERRQ(ierr);
5852   if (newNumPoints) {
5853     if (!clPoints) {
5854       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5855     } else {
5856       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5857     }
5858     numPoints  = newNumPoints;
5859     numIndices = newNumIndices;
5860     points     = newPoints;
5861     values     = newValues;
5862   }
5863   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5864   if (numFields) {
5865     for (p = 0; p < numPoints*2; p += 2) {
5866       PetscInt o = points[p+1];
5867       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5868       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5869     }
5870   } else {
5871     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5872       PetscInt o = points[p+1];
5873       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5874       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5875     }
5876   }
5877   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5878   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5879   if (ierr) {
5880     PetscMPIInt    rank;
5881     PetscErrorCode ierr2;
5882 
5883     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5884     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5885     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5886     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5887     CHKERRQ(ierr);
5888   }
5889   if (newNumPoints) {
5890     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
5891     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
5892   }
5893   else {
5894     if (!clPoints) {
5895       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5896     } else {
5897       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5898     }
5899   }
5900   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5901   PetscFunctionReturn(0);
5902 }
5903 
5904 #undef __FUNCT__
5905 #define __FUNCT__ "DMPlexMatSetClosureRefined"
5906 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5907 {
5908   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5909   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5910   PetscInt       *cpoints = NULL;
5911   PetscInt       *findices, *cindices;
5912   PetscInt        foffsets[32], coffsets[32];
5913   CellRefiner     cellRefiner;
5914   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5915   PetscErrorCode  ierr;
5916 
5917   PetscFunctionBegin;
5918   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5919   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5920   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5921   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5922   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5923   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5924   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5925   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5926   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5927   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5928   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5929   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5930   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5931   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5932   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5933   /* Column indices */
5934   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5935   maxFPoints = numCPoints;
5936   /* Compress out points not in the section */
5937   /*   TODO: Squeeze out points with 0 dof as well */
5938   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5939   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5940     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5941       cpoints[q*2]   = cpoints[p];
5942       cpoints[q*2+1] = cpoints[p+1];
5943       ++q;
5944     }
5945   }
5946   numCPoints = q;
5947   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5948     PetscInt fdof;
5949 
5950     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5951     if (!dof) continue;
5952     for (f = 0; f < numFields; ++f) {
5953       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5954       coffsets[f+1] += fdof;
5955     }
5956     numCIndices += dof;
5957   }
5958   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5959   /* Row indices */
5960   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5961   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5962   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5963   for (r = 0, q = 0; r < numSubcells; ++r) {
5964     /* TODO Map from coarse to fine cells */
5965     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5966     /* Compress out points not in the section */
5967     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5968     for (p = 0; p < numFPoints*2; p += 2) {
5969       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5970         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5971         if (!dof) continue;
5972         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5973         if (s < q) continue;
5974         ftotpoints[q*2]   = fpoints[p];
5975         ftotpoints[q*2+1] = fpoints[p+1];
5976         ++q;
5977       }
5978     }
5979     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5980   }
5981   numFPoints = q;
5982   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5983     PetscInt fdof;
5984 
5985     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5986     if (!dof) continue;
5987     for (f = 0; f < numFields; ++f) {
5988       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5989       foffsets[f+1] += fdof;
5990     }
5991     numFIndices += dof;
5992   }
5993   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5994 
5995   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
5996   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
5997   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5998   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5999   if (numFields) {
6000     for (p = 0; p < numFPoints*2; p += 2) {
6001       PetscInt o = ftotpoints[p+1];
6002       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6003       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
6004     }
6005     for (p = 0; p < numCPoints*2; p += 2) {
6006       PetscInt o = cpoints[p+1];
6007       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6008       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
6009     }
6010   } else {
6011     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
6012       PetscInt o = ftotpoints[p+1];
6013       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6014       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
6015     }
6016     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
6017       PetscInt o = cpoints[p+1];
6018       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6019       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
6020     }
6021   }
6022   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6023   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6024   if (ierr) {
6025     PetscMPIInt    rank;
6026     PetscErrorCode ierr2;
6027 
6028     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6029     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6030     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6031     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
6032     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
6033     CHKERRQ(ierr);
6034   }
6035   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
6036   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6037   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
6038   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
6039   PetscFunctionReturn(0);
6040 }
6041 
6042 #undef __FUNCT__
6043 #define __FUNCT__ "DMPlexMatGetClosureIndicesRefined"
6044 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
6045 {
6046   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
6047   PetscInt      *cpoints = NULL;
6048   PetscInt       foffsets[32], coffsets[32];
6049   CellRefiner    cellRefiner;
6050   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6051   PetscErrorCode ierr;
6052 
6053   PetscFunctionBegin;
6054   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6055   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6056   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
6057   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6058   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
6059   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6060   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6061   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6062   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6063   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6064   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6065   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6066   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6067   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
6068   /* Column indices */
6069   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6070   maxFPoints = numCPoints;
6071   /* Compress out points not in the section */
6072   /*   TODO: Squeeze out points with 0 dof as well */
6073   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6074   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6075     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6076       cpoints[q*2]   = cpoints[p];
6077       cpoints[q*2+1] = cpoints[p+1];
6078       ++q;
6079     }
6080   }
6081   numCPoints = q;
6082   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6083     PetscInt fdof;
6084 
6085     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6086     if (!dof) continue;
6087     for (f = 0; f < numFields; ++f) {
6088       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6089       coffsets[f+1] += fdof;
6090     }
6091     numCIndices += dof;
6092   }
6093   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6094   /* Row indices */
6095   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
6096   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6097   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
6098   for (r = 0, q = 0; r < numSubcells; ++r) {
6099     /* TODO Map from coarse to fine cells */
6100     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6101     /* Compress out points not in the section */
6102     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6103     for (p = 0; p < numFPoints*2; p += 2) {
6104       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6105         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6106         if (!dof) continue;
6107         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6108         if (s < q) continue;
6109         ftotpoints[q*2]   = fpoints[p];
6110         ftotpoints[q*2+1] = fpoints[p+1];
6111         ++q;
6112       }
6113     }
6114     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6115   }
6116   numFPoints = q;
6117   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6118     PetscInt fdof;
6119 
6120     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6121     if (!dof) continue;
6122     for (f = 0; f < numFields; ++f) {
6123       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6124       foffsets[f+1] += fdof;
6125     }
6126     numFIndices += dof;
6127   }
6128   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6129 
6130   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
6131   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
6132   if (numFields) {
6133     for (p = 0; p < numFPoints*2; p += 2) {
6134       PetscInt o = ftotpoints[p+1];
6135       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6136       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
6137     }
6138     for (p = 0; p < numCPoints*2; p += 2) {
6139       PetscInt o = cpoints[p+1];
6140       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6141       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
6142     }
6143   } else {
6144     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
6145       PetscInt o = ftotpoints[p+1];
6146       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
6147       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
6148     }
6149     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
6150       PetscInt o = cpoints[p+1];
6151       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
6152       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
6153     }
6154   }
6155   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
6156   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6157   PetscFunctionReturn(0);
6158 }
6159 
6160 #undef __FUNCT__
6161 #define __FUNCT__ "DMPlexGetHybridBounds"
6162 /*@
6163   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
6164 
6165   Input Parameter:
6166 . dm - The DMPlex object
6167 
6168   Output Parameters:
6169 + cMax - The first hybrid cell
6170 . fMax - The first hybrid face
6171 . eMax - The first hybrid edge
6172 - vMax - The first hybrid vertex
6173 
6174   Level: developer
6175 
6176 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
6177 @*/
6178 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
6179 {
6180   DM_Plex       *mesh = (DM_Plex*) dm->data;
6181   PetscInt       dim;
6182   PetscErrorCode ierr;
6183 
6184   PetscFunctionBegin;
6185   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6186   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6187   if (cMax) *cMax = mesh->hybridPointMax[dim];
6188   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
6189   if (eMax) *eMax = mesh->hybridPointMax[1];
6190   if (vMax) *vMax = mesh->hybridPointMax[0];
6191   PetscFunctionReturn(0);
6192 }
6193 
6194 #undef __FUNCT__
6195 #define __FUNCT__ "DMPlexSetHybridBounds"
6196 /*@
6197   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
6198 
6199   Input Parameters:
6200 . dm   - The DMPlex object
6201 . cMax - The first hybrid cell
6202 . fMax - The first hybrid face
6203 . eMax - The first hybrid edge
6204 - vMax - The first hybrid vertex
6205 
6206   Level: developer
6207 
6208 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
6209 @*/
6210 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
6211 {
6212   DM_Plex       *mesh = (DM_Plex*) dm->data;
6213   PetscInt       dim;
6214   PetscErrorCode ierr;
6215 
6216   PetscFunctionBegin;
6217   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6218   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6219   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
6220   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
6221   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
6222   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
6223   PetscFunctionReturn(0);
6224 }
6225 
6226 #undef __FUNCT__
6227 #define __FUNCT__ "DMPlexGetVTKCellHeight"
6228 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6229 {
6230   DM_Plex *mesh = (DM_Plex*) dm->data;
6231 
6232   PetscFunctionBegin;
6233   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6234   PetscValidPointer(cellHeight, 2);
6235   *cellHeight = mesh->vtkCellHeight;
6236   PetscFunctionReturn(0);
6237 }
6238 
6239 #undef __FUNCT__
6240 #define __FUNCT__ "DMPlexSetVTKCellHeight"
6241 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6242 {
6243   DM_Plex *mesh = (DM_Plex*) dm->data;
6244 
6245   PetscFunctionBegin;
6246   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6247   mesh->vtkCellHeight = cellHeight;
6248   PetscFunctionReturn(0);
6249 }
6250 
6251 #undef __FUNCT__
6252 #define __FUNCT__ "DMPlexCreateNumbering_Private"
6253 /* We can easily have a form that takes an IS instead */
6254 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
6255 {
6256   PetscSection   section, globalSection;
6257   PetscInt      *numbers, p;
6258   PetscErrorCode ierr;
6259 
6260   PetscFunctionBegin;
6261   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6262   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6263   for (p = pStart; p < pEnd; ++p) {
6264     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6265   }
6266   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6267   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6268   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
6269   for (p = pStart; p < pEnd; ++p) {
6270     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6271     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
6272     else                       numbers[p-pStart] += shift;
6273   }
6274   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6275   if (globalSize) {
6276     PetscLayout layout;
6277     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
6278     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
6279     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
6280   }
6281   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6282   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6283   PetscFunctionReturn(0);
6284 }
6285 
6286 #undef __FUNCT__
6287 #define __FUNCT__ "DMPlexGetCellNumbering"
6288 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6289 {
6290   DM_Plex       *mesh = (DM_Plex*) dm->data;
6291   PetscInt       cellHeight, cStart, cEnd, cMax;
6292   PetscErrorCode ierr;
6293 
6294   PetscFunctionBegin;
6295   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6296   if (!mesh->globalCellNumbers) {
6297     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6298     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6299     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6300     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
6301     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
6302   }
6303   *globalCellNumbers = mesh->globalCellNumbers;
6304   PetscFunctionReturn(0);
6305 }
6306 
6307 #undef __FUNCT__
6308 #define __FUNCT__ "DMPlexGetVertexNumbering"
6309 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6310 {
6311   DM_Plex       *mesh = (DM_Plex*) dm->data;
6312   PetscInt       vStart, vEnd, vMax;
6313   PetscErrorCode ierr;
6314 
6315   PetscFunctionBegin;
6316   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6317   if (!mesh->globalVertexNumbers) {
6318     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6319     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6320     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
6321     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
6322   }
6323   *globalVertexNumbers = mesh->globalVertexNumbers;
6324   PetscFunctionReturn(0);
6325 }
6326 
6327 #undef __FUNCT__
6328 #define __FUNCT__ "DMPlexCreatePointNumbering"
6329 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
6330 {
6331   IS             nums[4];
6332   PetscInt       depths[4];
6333   PetscInt       depth, d, shift = 0;
6334   PetscErrorCode ierr;
6335 
6336   PetscFunctionBegin;
6337   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6338   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6339   depths[0] = depth; depths[1] = 0;
6340   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
6341   for (d = 0; d <= depth; ++d) {
6342     PetscInt pStart, pEnd, gsize;
6343 
6344     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
6345     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
6346     shift += gsize;
6347   }
6348   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);
6349   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
6350   PetscFunctionReturn(0);
6351 }
6352 
6353 
6354 #undef __FUNCT__
6355 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
6356 /*@C
6357   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
6358   the local section and an SF describing the section point overlap.
6359 
6360   Input Parameters:
6361   + s - The PetscSection for the local field layout
6362   . sf - The SF describing parallel layout of the section points
6363   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
6364   . label - The label specifying the points
6365   - labelValue - The label stratum specifying the points
6366 
6367   Output Parameter:
6368   . gsection - The PetscSection for the global field layout
6369 
6370   Note: This gives negative sizes and offsets to points not owned by this process
6371 
6372   Level: developer
6373 
6374 .seealso: PetscSectionCreate()
6375 @*/
6376 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
6377 {
6378   PetscInt      *neg = NULL, *tmpOff = NULL;
6379   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
6380   PetscErrorCode ierr;
6381 
6382   PetscFunctionBegin;
6383   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) s), gsection);CHKERRQ(ierr);
6384   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
6385   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
6386   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
6387   if (nroots >= 0) {
6388     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
6389     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
6390     if (nroots > pEnd-pStart) {
6391       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
6392     } else {
6393       tmpOff = &(*gsection)->atlasDof[-pStart];
6394     }
6395   }
6396   /* Mark ghost points with negative dof */
6397   for (p = pStart; p < pEnd; ++p) {
6398     PetscInt value;
6399 
6400     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6401     if (value != labelValue) continue;
6402     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6403     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6404     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6405     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6406     if (neg) neg[p] = -(dof+1);
6407   }
6408   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6409   if (nroots >= 0) {
6410     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6411     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6412     if (nroots > pEnd-pStart) {
6413       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6414     }
6415   }
6416   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6417   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6418     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6419     (*gsection)->atlasOff[p] = off;
6420     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6421   }
6422   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) s));CHKERRQ(ierr);
6423   globalOff -= off;
6424   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6425     (*gsection)->atlasOff[p] += globalOff;
6426     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6427   }
6428   /* Put in negative offsets for ghost points */
6429   if (nroots >= 0) {
6430     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6431     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6432     if (nroots > pEnd-pStart) {
6433       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6434     }
6435   }
6436   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6437   ierr = PetscFree(neg);CHKERRQ(ierr);
6438   PetscFunctionReturn(0);
6439 }
6440 
6441 #undef __FUNCT__
6442 #define __FUNCT__ "DMPlexCheckSymmetry"
6443 /*@
6444   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6445 
6446   Input Parameters:
6447   + dm - The DMPlex object
6448 
6449   Note: This is a useful diagnostic when creating meshes programmatically.
6450 
6451   Level: developer
6452 
6453 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6454 @*/
6455 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6456 {
6457   PetscSection    coneSection, supportSection;
6458   const PetscInt *cone, *support;
6459   PetscInt        coneSize, c, supportSize, s;
6460   PetscInt        pStart, pEnd, p, csize, ssize;
6461   PetscErrorCode  ierr;
6462 
6463   PetscFunctionBegin;
6464   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6465   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6466   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6467   /* Check that point p is found in the support of its cone points, and vice versa */
6468   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6469   for (p = pStart; p < pEnd; ++p) {
6470     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6471     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6472     for (c = 0; c < coneSize; ++c) {
6473       PetscBool dup = PETSC_FALSE;
6474       PetscInt  d;
6475       for (d = c-1; d >= 0; --d) {
6476         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
6477       }
6478       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6479       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6480       for (s = 0; s < supportSize; ++s) {
6481         if (support[s] == p) break;
6482       }
6483       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
6484         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6485         for (s = 0; s < coneSize; ++s) {
6486           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6487         }
6488         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6489         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6490         for (s = 0; s < supportSize; ++s) {
6491           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6492         }
6493         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6494         if (dup) {
6495           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
6496         } else {
6497           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6498         }
6499       }
6500     }
6501     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6502     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6503     for (s = 0; s < supportSize; ++s) {
6504       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6505       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6506       for (c = 0; c < coneSize; ++c) {
6507         if (cone[c] == p) break;
6508       }
6509       if (c >= coneSize) {
6510         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6511         for (c = 0; c < supportSize; ++c) {
6512           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6513         }
6514         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6515         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6516         for (c = 0; c < coneSize; ++c) {
6517           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6518         }
6519         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6520         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6521       }
6522     }
6523   }
6524   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6525   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6526   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6527   PetscFunctionReturn(0);
6528 }
6529 
6530 #undef __FUNCT__
6531 #define __FUNCT__ "DMPlexCheckSkeleton"
6532 /*@
6533   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6534 
6535   Input Parameters:
6536 + dm - The DMPlex object
6537 . isSimplex - Are the cells simplices or tensor products
6538 - cellHeight - Normally 0
6539 
6540   Note: This is a useful diagnostic when creating meshes programmatically.
6541 
6542   Level: developer
6543 
6544 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6545 @*/
6546 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6547 {
6548   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6549   PetscErrorCode ierr;
6550 
6551   PetscFunctionBegin;
6552   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6553   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6554   switch (dim) {
6555   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6556   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6557   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6558   default:
6559     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6560   }
6561   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6562   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6563   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6564   cMax = cMax >= 0 ? cMax : cEnd;
6565   for (c = cStart; c < cMax; ++c) {
6566     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6567 
6568     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6569     for (cl = 0; cl < closureSize*2; cl += 2) {
6570       const PetscInt p = closure[cl];
6571       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6572     }
6573     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6574     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6575   }
6576   for (c = cMax; c < cEnd; ++c) {
6577     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6578 
6579     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6580     for (cl = 0; cl < closureSize*2; cl += 2) {
6581       const PetscInt p = closure[cl];
6582       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6583     }
6584     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6585     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
6586   }
6587   PetscFunctionReturn(0);
6588 }
6589 
6590 #undef __FUNCT__
6591 #define __FUNCT__ "DMPlexCheckFaces"
6592 /*@
6593   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6594 
6595   Input Parameters:
6596 + dm - The DMPlex object
6597 . isSimplex - Are the cells simplices or tensor products
6598 - cellHeight - Normally 0
6599 
6600   Note: This is a useful diagnostic when creating meshes programmatically.
6601 
6602   Level: developer
6603 
6604 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6605 @*/
6606 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6607 {
6608   PetscInt       pMax[4];
6609   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6610   PetscErrorCode ierr;
6611 
6612   PetscFunctionBegin;
6613   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6614   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6615   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6616   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6617   for (h = cellHeight; h < dim; ++h) {
6618     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6619     for (c = cStart; c < cEnd; ++c) {
6620       const PetscInt *cone, *ornt, *faces;
6621       PetscInt        numFaces, faceSize, coneSize,f;
6622       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6623 
6624       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6625       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6626       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6627       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6628       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6629       for (cl = 0; cl < closureSize*2; cl += 2) {
6630         const PetscInt p = closure[cl];
6631         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6632       }
6633       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6634       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
6635       for (f = 0; f < numFaces; ++f) {
6636         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6637 
6638         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6639         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6640           const PetscInt p = fclosure[cl];
6641           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6642         }
6643         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);
6644         for (v = 0; v < fnumCorners; ++v) {
6645           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]);
6646         }
6647         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6648       }
6649       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6650       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6651     }
6652   }
6653   PetscFunctionReturn(0);
6654 }
6655 
6656 #undef __FUNCT__
6657 #define __FUNCT__ "DMCreateInterpolation_Plex"
6658 /* Pointwise interpolation
6659      Just code FEM for now
6660      u^f = I u^c
6661      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6662      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6663      I_{ij} = psi^f_i phi^c_j
6664 */
6665 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6666 {
6667   PetscSection   gsc, gsf;
6668   PetscInt       m, n;
6669   void          *ctx;
6670   PetscErrorCode ierr;
6671 
6672   PetscFunctionBegin;
6673   /*
6674   Loop over coarse cells
6675     Loop over coarse basis functions
6676       Loop over fine cells in coarse cell
6677         Loop over fine dual basis functions
6678           Evaluate coarse basis on fine dual basis quad points
6679           Sum
6680           Update local element matrix
6681     Accumulate to interpolation matrix
6682 
6683    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
6684   */
6685   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6686   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6687   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6688   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6689   /* We need to preallocate properly */
6690   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6691   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6692   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6693   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6694   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
6695   /* Use naive scaling */
6696   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6697   PetscFunctionReturn(0);
6698 }
6699 
6700 #undef __FUNCT__
6701 #define __FUNCT__ "DMCreateInjection_Plex"
6702 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
6703 {
6704   PetscErrorCode ierr;
6705 
6706   PetscFunctionBegin;
6707   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, ctx, NULL);CHKERRQ(ierr);
6708   PetscFunctionReturn(0);
6709 }
6710 
6711 #undef __FUNCT__
6712 #define __FUNCT__ "DMCreateDefaultSection_Plex"
6713 /* Pointwise interpolation
6714      Just code FEM for now
6715      u^f = I u^c
6716      sum_k u^f_k phi^f_k = I sum_l u^c_l phi^c_l
6717      u^f_i = sum_l int psi^f_i I phi^c_l u^c_l
6718      I_{ij} = int psi^f_i phi^c_j
6719 */
6720 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6721 {
6722   PetscSection   section;
6723   IS            *bcPoints;
6724   PetscInt      *bcFields, *numComp, *numDof;
6725   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc, f;
6726   PetscErrorCode ierr;
6727 
6728   PetscFunctionBegin;
6729   /* Handle boundary conditions */
6730   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6731   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6732   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
6733   for (bd = 0; bd < numBd; ++bd) {
6734     PetscBool isEssential;
6735     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6736     if (isEssential) ++numBC;
6737   }
6738   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
6739   for (bd = 0, bc = 0; bd < numBd; ++bd) {
6740     const char     *bdLabel;
6741     DMLabel         label;
6742     const PetscInt *values;
6743     PetscInt        bd2, field, numValues;
6744     PetscBool       isEssential, duplicate = PETSC_FALSE;
6745 
6746     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6747     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
6748     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6749     /* Only want to do this for FEM, and only once */
6750     for (bd2 = 0; bd2 < bd; ++bd2) {
6751       const char *bdname;
6752       ierr = DMPlexGetBoundary(dm, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6753       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
6754       if (duplicate) break;
6755     }
6756     if (!duplicate) {
6757       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6758       ierr = DMPlexLabelAddCells(dm, label);CHKERRQ(ierr);
6759     }
6760     /* Filter out cells, if you actually want to constraint cells you need to do things by hand right now */
6761     if (isEssential) {
6762       IS              tmp;
6763       PetscInt       *newidx;
6764       const PetscInt *idx;
6765       PetscInt        cStart, cEnd, n, p, newn = 0;
6766 
6767       bcFields[bc] = field;
6768       ierr = DMPlexGetStratumIS(dm, bdLabel, values[0], &tmp);CHKERRQ(ierr);
6769       ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6770       ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6771       ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6772       for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
6773       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
6774       newn = 0;
6775       for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
6776       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6777       ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6778       ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6779     }
6780   }
6781   /* Handle discretization */
6782   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6783   ierr = PetscMalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6784   for (f = 0; f < numFields; ++f) {
6785     PetscFE         fe;
6786     const PetscInt *numFieldDof;
6787     PetscInt        d;
6788 
6789     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6790     ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6791     ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6792     for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6793   }
6794   for (f = 0; f < numFields; ++f) {
6795     PetscInt d;
6796     for (d = 1; d < dim; ++d) {
6797       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.");
6798     }
6799   }
6800   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, NULL, &section);CHKERRQ(ierr);
6801   for (f = 0; f < numFields; ++f) {
6802     PetscFE     fe;
6803     const char *name;
6804 
6805     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6806     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6807     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6808   }
6809   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6810   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6811   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
6812   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
6813   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6814   PetscFunctionReturn(0);
6815 }
6816 
6817 #undef __FUNCT__
6818 #define __FUNCT__ "DMPlexGetCoarseDM"
6819 /*@
6820   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
6821 
6822   Input Parameter:
6823 . dm - The DMPlex object
6824 
6825   Output Parameter:
6826 . cdm - The coarse DM
6827 
6828   Level: intermediate
6829 
6830 .seealso: DMPlexSetCoarseDM()
6831 @*/
6832 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
6833 {
6834   PetscFunctionBegin;
6835   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6836   PetscValidPointer(cdm, 2);
6837   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
6838   PetscFunctionReturn(0);
6839 }
6840 
6841 #undef __FUNCT__
6842 #define __FUNCT__ "DMPlexSetCoarseDM"
6843 /*@
6844   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
6845 
6846   Input Parameters:
6847 + dm - The DMPlex object
6848 - cdm - The coarse DM
6849 
6850   Level: intermediate
6851 
6852 .seealso: DMPlexGetCoarseDM()
6853 @*/
6854 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
6855 {
6856   DM_Plex       *mesh;
6857   PetscErrorCode ierr;
6858 
6859   PetscFunctionBegin;
6860   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6861   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
6862   mesh = (DM_Plex *) dm->data;
6863   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
6864   mesh->coarseMesh = cdm;
6865   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
6866   PetscFunctionReturn(0);
6867 }
6868 
6869 /* constraints */
6870 #undef __FUNCT__
6871 #define __FUNCT__ "DMPlexGetConstraints"
6872 /*@
6873   DMPlexGetConstraints - Get the layout of the local point-to-point constraints
6874 
6875   not collective
6876 
6877   Input Parameters:
6878 . dm - The DMPlex object
6879 
6880   Output Parameters:
6881 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
6882 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
6883 
6884 
6885   Level: intermediate
6886 
6887 .seealso: DMPlexSetConstraints(), DMPlexGetConstraintSection(), DMPlexGetConstraintMatrix(), DMPlexSetConstraintMatrix()
6888 @*/
6889 PetscErrorCode DMPlexGetConstraints(DM dm, PetscSection *anchorSection, IS *anchorIS)
6890 {
6891   DM_Plex *plex = (DM_Plex *)dm->data;
6892 
6893   PetscFunctionBegin;
6894   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6895   if (anchorSection) *anchorSection = plex->anchorSection;
6896   if (anchorIS) *anchorIS = plex->anchorIS;
6897   PetscFunctionReturn(0);
6898 }
6899 
6900 #undef __FUNCT__
6901 #define __FUNCT__ "DMGlobalToLocalHook_Plex_constraints"
6902 static PetscErrorCode DMGlobalToLocalHook_Plex_constraints(DM dm, Vec g, InsertMode mode, Vec l, void *ctx)
6903 {
6904   DM_Plex *plex = (DM_Plex *)dm->data;
6905   Mat cMat;
6906   Vec cVec;
6907   PetscSection section, cSec;
6908   PetscInt pStart, pEnd, p, dof;
6909   PetscErrorCode ierr;
6910 
6911   PetscFunctionBegin;
6912   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6913   cMat = plex->constraintMat;
6914   if (cMat && (mode == INSERT_VALUES || mode == INSERT_ALL_VALUES || mode == INSERT_BC_VALUES)) {
6915     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
6916     cSec = plex->constraintSection;
6917     ierr = MatGetVecs(cMat,NULL,&cVec);CHKERRQ(ierr);
6918     ierr = MatMult(cMat,l,cVec);CHKERRQ(ierr);
6919     ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
6920     for (p = pStart; p < pEnd; p++) {
6921       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6922       if (dof) {
6923         PetscScalar *vals;
6924         ierr = VecGetValuesSection(cVec,cSec,p,&vals);CHKERRQ(ierr);
6925         ierr = VecSetValuesSection(l,section,p,vals,INSERT_ALL_VALUES);CHKERRQ(ierr);
6926       }
6927     }
6928     ierr = VecDestroy(&cVec);CHKERRQ(ierr);
6929   }
6930   PetscFunctionReturn(0);
6931 }
6932 
6933 #undef __FUNCT__
6934 #define __FUNCT__ "DMLocalToGlobalHook_Plex_constraints"
6935 static PetscErrorCode DMLocalToGlobalHook_Plex_constraints(DM dm, Vec l, InsertMode mode, Vec g, void *ctx)
6936 {
6937   DM_Plex *plex = (DM_Plex *)dm->data;
6938   Mat cMat;
6939   Vec cVec;
6940   PetscSection section, cSec;
6941   PetscInt pStart, pEnd, p, dof;
6942   PetscErrorCode ierr;
6943 
6944   PetscFunctionBegin;
6945   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6946   cMat = plex->constraintMat;
6947   if (cMat && (mode == ADD_VALUES || mode == ADD_ALL_VALUES || mode == ADD_BC_VALUES)) {
6948     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
6949     cSec = plex->constraintSection;
6950     ierr = MatGetVecs(cMat,NULL,&cVec);CHKERRQ(ierr);
6951     ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
6952     for (p = pStart; p < pEnd; p++) {
6953       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6954       if (dof) {
6955         PetscInt d;
6956         PetscScalar *vals;
6957         ierr = VecGetValuesSection(l,section,p,&vals);CHKERRQ(ierr);
6958         ierr = VecSetValuesSection(cVec,cSec,p,vals,mode);CHKERRQ(ierr);
6959         /* for this to be the true transpose, we have to zero the values that
6960          * we just extracted */
6961         for (d = 0; d < dof; d++) {
6962           vals[d] = 0.;
6963         }
6964       }
6965     }
6966     ierr = MatMultTransposeAdd(cMat,cVec,l,l);CHKERRQ(ierr);
6967     ierr = VecDestroy(&cVec);CHKERRQ(ierr);
6968   }
6969   PetscFunctionReturn(0);
6970 }
6971 
6972 #undef __FUNCT__
6973 #define __FUNCT__ "DMPlexSetConstraints"
6974 /*@
6975   DMPlexSetConstraints - Set the layout of the local point-to-point constraints.  Unlike boundary conditions, when a
6976   point's degrees of freedom in a section are constrained to an outside value, the point-to-point constraints set a
6977   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
6978 
6979   After specifying the layout of constraints with DMPlexSetConstraints(), one specifies the constraints by calling
6980   DMPlexGetConstraintMatrix() and filling in the entries.  This matrix will be used fill in the constrained values
6981   from the anchor values in local vectors in DMGlobalToLocalEnd() with mode = INSERT_VALUES, and its transpose is used
6982   to sum constrained values back to their anchor values in DMLocalToGlobalBegin() with mode = ADD_VALUES.
6983 
6984   logically collective
6985 
6986   Input Parameters:
6987 + dm - The DMPlex object
6988 . anchorSection - The section that describes the mapping from constrained points to the anchor points listed in anchorIS.
6989 - anchorIS - The list of all anchor points.
6990 
6991   The reference counts of anchorSection and anchorIS are incremented.
6992 
6993 
6994   Level: intermediate
6995 
6996 .seealso: DMPlexGetConstraints(), DMPlexGetConstraintSection(), DMPlexGetConstraintMatrix(), DMPlexSetConstraintMatrix()
6997 @*/
6998 PetscErrorCode DMPlexSetConstraints(DM dm, PetscSection anchorSection, IS anchorIS)
6999 {
7000   DM_Plex *plex = (DM_Plex *)dm->data;
7001   PetscErrorCode ierr;
7002 
7003   PetscFunctionBegin;
7004   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7005 
7006   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
7007   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
7008   plex->anchorSection = anchorSection;
7009 
7010   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
7011   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
7012   plex->anchorIS = anchorIS;
7013 
7014 #if defined(PETSC_USE_DEBUG)
7015   if (anchorIS && anchorSection) {
7016     PetscInt size, a, pStart, pEnd;
7017     const PetscInt *anchors;
7018 
7019     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
7020     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
7021     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
7022     for (a = 0; a < size; a++) {
7023       PetscInt p;
7024 
7025       p = anchors[a];
7026       if (p >= pStart && p < pEnd) {
7027         PetscInt dof;
7028 
7029         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
7030         if (dof) {
7031           PetscErrorCode ierr2;
7032 
7033           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
7034           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %d cannot be constrained and an anchor",p);
7035         }
7036       }
7037     }
7038     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
7039   }
7040 #endif
7041 
7042   ierr = PetscSectionDestroy(&plex->constraintSection);CHKERRQ(ierr);
7043   ierr = MatDestroy(&plex->constraintMat);CHKERRQ(ierr);
7044 
7045   if (anchorSection) {
7046     /* add the constraint hooks if they have not already been added */
7047     {
7048       DMGlobalToLocalHookLink link,next=NULL;
7049       for (link=dm->gtolhook; link; link=next) {
7050         next = link->next;
7051         if (link->endhook == DMGlobalToLocalHook_Plex_constraints) {
7052           break;
7053         }
7054       }
7055       if (!link) {
7056         ierr = DMGlobalToLocalHookAdd(dm,NULL,DMGlobalToLocalHook_Plex_constraints,NULL);CHKERRQ(ierr);
7057       }
7058     }
7059     {
7060       DMLocalToGlobalHookLink link,next=NULL;
7061       for (link=dm->ltoghook; link; link=next) {
7062         next = link->next;
7063         if (link->beginhook == DMLocalToGlobalHook_Plex_constraints) {
7064           break;
7065         }
7066       }
7067       if (!link) {
7068         ierr = DMLocalToGlobalHookAdd(dm,DMLocalToGlobalHook_Plex_constraints,NULL,NULL);CHKERRQ(ierr);
7069       }
7070     }
7071   }
7072   else {
7073     /* remove the constraint hooks if they were added before */
7074     {
7075       DMGlobalToLocalHookLink prev=NULL,link,next=NULL;
7076       for (link=dm->gtolhook; link; link=next) {
7077         next = link->next;
7078         if (link->endhook == DMGlobalToLocalHook_Plex_constraints) {
7079           break;
7080         }
7081       }
7082       if (link) {
7083         ierr = PetscFree(link);CHKERRQ(ierr);
7084         if (prev) {
7085           prev->next = next;
7086         }
7087         else {
7088           dm->gtolhook = next;
7089         }
7090       }
7091     }
7092     {
7093       DMLocalToGlobalHookLink prev=NULL,link,next=NULL;
7094       for (link=dm->ltoghook; link; link=next) {
7095         next = link->next;
7096         if (link->beginhook == DMLocalToGlobalHook_Plex_constraints) {
7097           break;
7098         }
7099       }
7100       if (link) {
7101         ierr = PetscFree(link);CHKERRQ(ierr);
7102         if (prev) {
7103           prev->next = next;
7104         }
7105         else {
7106           dm->ltoghook = next;
7107         }
7108       }
7109     }
7110   }
7111 
7112   PetscFunctionReturn(0);
7113 }
7114 
7115 #undef __FUNCT__
7116 #define __FUNCT__ "DMPlexCreateConstraintSection"
7117 static PetscErrorCode DMPlexCreateConstraintSection(DM dm, PetscSection *cSec)
7118 {
7119   DM_Plex *plex = (DM_Plex *)dm->data;
7120   PetscSection section, anchorSection;
7121   PetscInt pStart, pEnd, p, dof, numFields, f;
7122   PetscErrorCode ierr;
7123 
7124   PetscFunctionBegin;
7125   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7126   anchorSection = plex->anchorSection;
7127   ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
7128   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)section),cSec);CHKERRQ(ierr);
7129   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
7130   ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
7131   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
7132   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
7133   for (p = pStart; p < pEnd; p++) {
7134     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
7135     if (dof) {
7136       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
7137       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
7138       for (f = 0; f < numFields; f++) {
7139         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
7140         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
7141       }
7142     }
7143   }
7144   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
7145   PetscFunctionReturn(0);
7146 }
7147 
7148 #undef __FUNCT__
7149 #define __FUNCT__ "DMPlexGetConstraintSection"
7150 /*@
7151   DMPlexGetConstraintSection - Get the section that maps constrained points to rows of the constraint matrix.
7152 
7153   The default section obtained with DMGetDefaultSection() maps points to columns of the constraint matrix.
7154 
7155   logically collective
7156 
7157   Input Parameters:
7158 . dm - The DMPlex object
7159 
7160   Output Parameters:
7161 . cSec - If not NULL, set to the section describing which points anchor the constrained points.
7162 
7163 
7164   Level: intermediate
7165 
7166 .seealso: DMPlexGetConstraints(), DMPlexSetConstraints(), DMPlexGetConstraintMatrix(), DMPlexSetConstraintMatrix()
7167 @*/
7168 PetscErrorCode DMPlexGetConstraintSection(DM dm, PetscSection *cSec)
7169 {
7170   DM_Plex *plex = (DM_Plex *)dm->data;
7171   PetscErrorCode ierr;
7172 
7173   PetscFunctionBegin;
7174   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7175   if (plex->anchorSection && !plex->constraintSection) {
7176     ierr = DMPlexCreateConstraintSection(dm,&plex->constraintSection);CHKERRQ(ierr);
7177   }
7178   if (cSec) *cSec = plex->constraintSection;
7179   PetscFunctionReturn(0);
7180 }
7181 
7182 #undef __FUNCT__
7183 #define __FUNCT__ "DMPlexCreateConstraintMatrix"
7184 static PetscErrorCode DMPlexCreateConstraintMatrix(DM dm, Mat *cMat)
7185 {
7186   DM_Plex *plex = (DM_Plex *)dm->data;
7187   PetscSection section, aSec, cSec;
7188   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
7189   const PetscInt *anchors;
7190   PetscInt numFields, f;
7191   PetscErrorCode ierr;
7192 
7193   PetscFunctionBegin;
7194   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7195   ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
7196   ierr = DMPlexGetConstraintSection(dm, &cSec);CHKERRQ(ierr);
7197   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
7198   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
7199   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
7200   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
7201   ierr = MatSetType(*cMat,MATSEQAIJ);
7202   aSec = plex->anchorSection;
7203   ierr = ISGetIndices(plex->anchorIS,&anchors);CHKERRQ(ierr);
7204   ierr = PetscSectionGetChart(aSec,&pStart,&pEnd);CHKERRQ(ierr);
7205   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
7206   i[0] = 0;
7207   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
7208   for (p = pStart; p < pEnd; p++) {
7209     ierr = PetscSectionGetDof(aSec,p,&dof);CHKERRQ(ierr);
7210     if (!dof) continue;
7211     ierr = PetscSectionGetOffset(aSec,p,&off);CHKERRQ(ierr);
7212     if (numFields) {
7213       for (f = 0; f < numFields; f++) {
7214         annz = 0;
7215         for (q = 0; q < dof; q++) {
7216           a = anchors[off + q];
7217           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
7218           annz += aDof;
7219         }
7220         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
7221         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
7222         for (q = 0; q < dof; q++) {
7223           i[off + q + 1] = i[off + q] + annz;
7224         }
7225       }
7226     }
7227     else {
7228       annz = 0;
7229       for (q = 0; q < dof; q++) {
7230         a = anchors[off + q];
7231         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7232         annz += aDof;
7233       }
7234       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
7235       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
7236       for (q = 0; q < dof; q++) {
7237         i[off + q + 1] = i[off + q] + annz;
7238       }
7239     }
7240   }
7241   nnz = i[m];
7242   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
7243   offset = 0;
7244   for (p = pStart; p < pEnd; p++) {
7245     if (numFields) {
7246       for (f = 0; f < numFields; f++) {
7247         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
7248         for (q = 0; q < dof; q++) {
7249           PetscInt rDof, rOff, r;
7250           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
7251           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
7252           for (r = 0; r < rDof; r++) {
7253             PetscInt s;
7254 
7255             a = anchors[rOff + r];
7256 
7257             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
7258             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
7259             for (s = 0; s < aDof; s++) {
7260               j[offset++] = aOff + s;
7261             }
7262           }
7263         }
7264       }
7265     }
7266     else {
7267       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
7268       for (q = 0; q < dof; q++) {
7269         PetscInt rDof, rOff, r;
7270         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
7271         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
7272         for (r = 0; r < rDof; r++) {
7273           PetscInt s;
7274 
7275           a = anchors[rOff + r];
7276 
7277           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
7278           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
7279           for (s = 0; s < aDof; s++) {
7280             j[offset++] = aOff + s;
7281           }
7282         }
7283       }
7284     }
7285   }
7286   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
7287   ierr = PetscFree2(i,j);CHKERRQ(ierr);
7288   ierr = ISRestoreIndices(plex->anchorIS,&anchors);CHKERRQ(ierr);
7289   PetscFunctionReturn(0);
7290 }
7291 
7292 #undef __FUNCT__
7293 #define __FUNCT__ "DMPlexGetConstraintMatrix"
7294 /*@
7295   DMPlexGetConstraintMatrix - Get the matrix that specifies the point-to-point constraints.
7296 
7297   logically collective
7298 
7299   Input Parameters:
7300 . dm - The DMPlex object
7301 
7302   Output Parameters:
7303 . cMat - If not NULL, returns the constraint matrix.  If the constraint matrix has not been created before, then it is
7304          created and its nonzero structure is allocated, so that the user can insert values.
7305 
7306 
7307   Level: intermediate
7308 
7309 .seealso: DMPlexGetConstraints(), DMPlexSetConstraints(), DMPlexGetConstraintSection(), DMPlexSetConstraintMatrix()
7310 @*/
7311 PetscErrorCode DMPlexGetConstraintMatrix(DM dm, Mat *cMat)
7312 {
7313   DM_Plex *plex = (DM_Plex *)dm->data;
7314   PetscErrorCode ierr;
7315 
7316   PetscFunctionBegin;
7317   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7318   if (plex->anchorSection && !plex->constraintMat) {
7319     ierr = DMPlexCreateConstraintMatrix(dm,&plex->constraintMat);CHKERRQ(ierr);
7320   }
7321   if (cMat) *cMat = plex->constraintMat;
7322   PetscFunctionReturn(0);
7323 }
7324 
7325 #undef __FUNCT__
7326 #define __FUNCT__ "DMPlexSetConstraintMatrix"
7327 /*@
7328   DMPlexSetConstraintMatrix - Set the matrix that specifies the point-to-point constraints.  It should have the same
7329   number of rows as the layout size of the section returned by DMPlexGetConstraintSection(), and it should have the
7330   same number of columns as the layout size of the section returned by DMGetDefaultSection().  For the constraint
7331   matrix to be used when constructing a matrix in, e.g., DMPlexSNESComputeJacobianFEM(), then MatGetValues() must be
7332   implemented.
7333 
7334   logically collective
7335 
7336   Input Parameters:
7337 + dm - The DMPlex object
7338 - cMat - The constraint matrix.
7339 
7340   The reference count of cMat is incremented.
7341 
7342 
7343   Level: advanced.
7344 
7345 .seealso: DMPlexGetConstraints(), DMPlexSetConstraints(), DMPlexGetConstraintSection(), DMPlexGetConstraintMatrix()
7346 @*/
7347 PetscErrorCode DMPlexSetConstraintMatrix(DM dm, Mat cMat)
7348 {
7349   DM_Plex *plex = (DM_Plex *)dm->data;
7350   PetscErrorCode ierr;
7351 
7352   PetscFunctionBegin;
7353   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7354   ierr = PetscObjectReference((PetscObject)cMat);CHKERRQ(ierr);
7355   ierr = MatDestroy(&plex->constraintMat);CHKERRQ(ierr);
7356   plex->constraintMat = cMat;
7357   PetscFunctionReturn(0);
7358 }
7359