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