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