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