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