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