xref: /petsc/src/dm/impls/plex/plex.c (revision f5476a2b443e0eedb22d31cb1b2d85b9b918f73f)
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 = DMPlexInsertBoundaryValues(dm, v, 0.0, NULL, NULL, NULL);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   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
528   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
529   while (next) {
530     DMLabel tmp = next->next;
531 
532     ierr = DMLabelDestroy(&next);CHKERRQ(ierr);
533     next = tmp;
534   }
535   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
536   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
537   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
538   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
539   ierr = BoundaryDestroy(&mesh->boundary);CHKERRQ(ierr);
540   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
541   ierr = ISDestroy(&mesh->anchorIS);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__ "DMPlexLocalizeCoordinate_Internal"
2649 PetscErrorCode DMPlexLocalizeCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
2650 {
2651   PetscInt d;
2652 
2653   PetscFunctionBegin;
2654   if (!dm->maxCell) {
2655     for (d = 0; d < dim; ++d) out[d] = in[d];
2656   } else {
2657     for (d = 0; d < dim; ++d) {
2658       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
2659         out[d] = PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
2660       } else {
2661         out[d] = in[d];
2662       }
2663     }
2664   }
2665   PetscFunctionReturn(0);
2666 }
2667 
2668 #undef __FUNCT__
2669 #define __FUNCT__ "DMPlexLocalizeAddCoordinate_Internal"
2670 PetscErrorCode DMPlexLocalizeAddCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
2671 {
2672   PetscInt d;
2673 
2674   PetscFunctionBegin;
2675   if (!dm->maxCell) {
2676     for (d = 0; d < dim; ++d) out[d] += in[d];
2677   } else {
2678     for (d = 0; d < dim; ++d) {
2679       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
2680         out[d] += PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
2681       } else {
2682         out[d] += in[d];
2683       }
2684     }
2685   }
2686   PetscFunctionReturn(0);
2687 }
2688 
2689 #undef __FUNCT__
2690 #define __FUNCT__ "DMPlexLocalizeCoordinates"
2691 PetscErrorCode DMPlexLocalizeCoordinates(DM dm)
2692 {
2693   PetscSection   coordSection, cSection;
2694   Vec            coordinates,  cVec;
2695   PetscScalar   *coords, *coords2, *anchor;
2696   PetscInt       Nc, cStart, cEnd, c, vStart, vEnd, v, dof, d, off, off2, bs, coordSize;
2697   PetscErrorCode ierr;
2698 
2699   PetscFunctionBegin;
2700   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2701   if (!dm->maxCell) PetscFunctionReturn(0);
2702   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2703   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
2704   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2705   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2706   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &cSection);CHKERRQ(ierr);
2707   ierr = PetscSectionSetNumFields(cSection, 1);CHKERRQ(ierr);
2708   ierr = PetscSectionGetFieldComponents(coordSection, 0, &Nc);CHKERRQ(ierr);
2709   ierr = PetscSectionSetFieldComponents(cSection, 0, Nc);CHKERRQ(ierr);
2710   ierr = PetscSectionSetChart(cSection, cStart, vEnd);CHKERRQ(ierr);
2711   for (v = vStart; v < vEnd; ++v) {
2712     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2713     ierr = PetscSectionSetDof(cSection,     v,  dof);CHKERRQ(ierr);
2714     ierr = PetscSectionSetFieldDof(cSection, v, 0, dof);CHKERRQ(ierr);
2715   }
2716   for (c = cStart; c < cEnd; ++c) {
2717     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, NULL);CHKERRQ(ierr);
2718     ierr = PetscSectionSetDof(cSection, c, dof);CHKERRQ(ierr);
2719     ierr = PetscSectionSetFieldDof(cSection, c, 0, dof);CHKERRQ(ierr);
2720   }
2721   ierr = PetscSectionSetUp(cSection);CHKERRQ(ierr);
2722   ierr = PetscSectionGetStorageSize(cSection, &coordSize);CHKERRQ(ierr);
2723   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cVec);CHKERRQ(ierr);
2724   ierr = VecGetBlockSize(coordinates, &bs);CHKERRQ(ierr);
2725   ierr = VecSetBlockSize(cVec,         bs);CHKERRQ(ierr);
2726   ierr = VecSetSizes(cVec, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2727   ierr = VecSetType(cVec,VECSTANDARD);CHKERRQ(ierr);
2728   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
2729   ierr = VecGetArray(cVec,        &coords2);CHKERRQ(ierr);
2730   for (v = vStart; v < vEnd; ++v) {
2731     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2732     ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
2733     ierr = PetscSectionGetOffset(cSection,     v, &off2);CHKERRQ(ierr);
2734     for (d = 0; d < dof; ++d) coords2[off2+d] = coords[off+d];
2735   }
2736   ierr = DMGetWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2737   for (c = cStart; c < cEnd; ++c) {
2738     PetscScalar *cellCoords = NULL;
2739     PetscInt     b;
2740 
2741     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2742     ierr = PetscSectionGetOffset(cSection, c, &off2);CHKERRQ(ierr);
2743     for (b = 0; b < bs; ++b) anchor[b] = cellCoords[b];
2744     for (d = 0; d < dof/bs; ++d) {ierr = DMPlexLocalizeCoordinate_Internal(dm, bs, anchor, &cellCoords[d*bs], &coords2[off2+d*bs]);CHKERRQ(ierr);}
2745     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2746   }
2747   ierr = DMRestoreWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2748   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
2749   ierr = VecRestoreArray(cVec,        &coords2);CHKERRQ(ierr);
2750   ierr = DMSetCoordinateSection(dm, PETSC_DETERMINE, cSection);CHKERRQ(ierr);
2751   ierr = DMSetCoordinatesLocal(dm, cVec);CHKERRQ(ierr);
2752   ierr = VecDestroy(&cVec);CHKERRQ(ierr);
2753   ierr = PetscSectionDestroy(&cSection);CHKERRQ(ierr);
2754   PetscFunctionReturn(0);
2755 }
2756 
2757 #undef __FUNCT__
2758 #define __FUNCT__ "DMPlexGetDepthLabel"
2759 /*@
2760   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
2761 
2762   Not Collective
2763 
2764   Input Parameter:
2765 . dm    - The DMPlex object
2766 
2767   Output Parameter:
2768 . depthLabel - The DMLabel recording point depth
2769 
2770   Level: developer
2771 
2772 .keywords: mesh, points
2773 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2774 @*/
2775 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
2776 {
2777   DM_Plex       *mesh = (DM_Plex*) dm->data;
2778   PetscErrorCode ierr;
2779 
2780   PetscFunctionBegin;
2781   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2782   PetscValidPointer(depthLabel, 2);
2783   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
2784   *depthLabel = mesh->depthLabel;
2785   PetscFunctionReturn(0);
2786 }
2787 
2788 #undef __FUNCT__
2789 #define __FUNCT__ "DMPlexGetDepth"
2790 /*@
2791   DMPlexGetDepth - Get the depth of the DAG representing this mesh
2792 
2793   Not Collective
2794 
2795   Input Parameter:
2796 . dm    - The DMPlex object
2797 
2798   Output Parameter:
2799 . depth - The number of strata (breadth first levels) in the DAG
2800 
2801   Level: developer
2802 
2803 .keywords: mesh, points
2804 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2805 @*/
2806 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
2807 {
2808   DMLabel        label;
2809   PetscInt       d = 0;
2810   PetscErrorCode ierr;
2811 
2812   PetscFunctionBegin;
2813   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2814   PetscValidPointer(depth, 2);
2815   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2816   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
2817   *depth = d-1;
2818   PetscFunctionReturn(0);
2819 }
2820 
2821 #undef __FUNCT__
2822 #define __FUNCT__ "DMPlexGetDepthStratum"
2823 /*@
2824   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
2825 
2826   Not Collective
2827 
2828   Input Parameters:
2829 + dm           - The DMPlex object
2830 - stratumValue - The requested depth
2831 
2832   Output Parameters:
2833 + start - The first point at this depth
2834 - end   - One beyond the last point at this depth
2835 
2836   Level: developer
2837 
2838 .keywords: mesh, points
2839 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
2840 @*/
2841 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2842 {
2843   DMLabel        label;
2844   PetscInt       pStart, pEnd;
2845   PetscErrorCode ierr;
2846 
2847   PetscFunctionBegin;
2848   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2849   if (start) {PetscValidPointer(start, 3); *start = 0;}
2850   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2851   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2852   if (pStart == pEnd) PetscFunctionReturn(0);
2853   if (stratumValue < 0) {
2854     if (start) *start = pStart;
2855     if (end)   *end   = pEnd;
2856     PetscFunctionReturn(0);
2857   }
2858   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2859   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
2860   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
2861   PetscFunctionReturn(0);
2862 }
2863 
2864 #undef __FUNCT__
2865 #define __FUNCT__ "DMPlexGetHeightStratum"
2866 /*@
2867   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
2868 
2869   Not Collective
2870 
2871   Input Parameters:
2872 + dm           - The DMPlex object
2873 - stratumValue - The requested height
2874 
2875   Output Parameters:
2876 + start - The first point at this height
2877 - end   - One beyond the last point at this height
2878 
2879   Level: developer
2880 
2881 .keywords: mesh, points
2882 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
2883 @*/
2884 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2885 {
2886   DMLabel        label;
2887   PetscInt       depth, pStart, pEnd;
2888   PetscErrorCode ierr;
2889 
2890   PetscFunctionBegin;
2891   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2892   if (start) {PetscValidPointer(start, 3); *start = 0;}
2893   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2894   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2895   if (pStart == pEnd) PetscFunctionReturn(0);
2896   if (stratumValue < 0) {
2897     if (start) *start = pStart;
2898     if (end)   *end   = pEnd;
2899     PetscFunctionReturn(0);
2900   }
2901   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2902   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
2903   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
2904   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
2905   PetscFunctionReturn(0);
2906 }
2907 
2908 #undef __FUNCT__
2909 #define __FUNCT__ "DMPlexCreateSectionInitial"
2910 /* Set the number of dof on each point and separate by fields */
2911 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
2912 {
2913   PetscInt      *numDofTot;
2914   PetscInt       depth, pStart = 0, pEnd = 0;
2915   PetscInt       p, d, dep, f;
2916   PetscErrorCode ierr;
2917 
2918   PetscFunctionBegin;
2919   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
2920   for (d = 0; d <= dim; ++d) {
2921     numDofTot[d] = 0;
2922     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
2923   }
2924   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2925   if (numFields > 0) {
2926     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
2927     if (numComp) {
2928       for (f = 0; f < numFields; ++f) {
2929         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
2930       }
2931     }
2932   }
2933   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2934   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
2935   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2936   for (dep = 0; dep <= depth; ++dep) {
2937     d    = dim == depth ? dep : (!dep ? 0 : dim);
2938     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
2939     for (p = pStart; p < pEnd; ++p) {
2940       for (f = 0; f < numFields; ++f) {
2941         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
2942       }
2943       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
2944     }
2945   }
2946   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
2947   PetscFunctionReturn(0);
2948 }
2949 
2950 #undef __FUNCT__
2951 #define __FUNCT__ "DMPlexCreateSectionBCDof"
2952 /* Set the number of dof on each point and separate by fields
2953    If constDof is PETSC_DETERMINE, constrain every dof on the point
2954 */
2955 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
2956 {
2957   PetscInt       numFields;
2958   PetscInt       bc;
2959   PetscSection   aSec;
2960   PetscErrorCode ierr;
2961 
2962   PetscFunctionBegin;
2963   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2964   for (bc = 0; bc < numBC; ++bc) {
2965     PetscInt        field = 0;
2966     const PetscInt *idx;
2967     PetscInt        n, i;
2968 
2969     if (numFields) field = bcField[bc];
2970     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
2971     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2972     for (i = 0; i < n; ++i) {
2973       const PetscInt p        = idx[i];
2974       PetscInt       numConst = constDof;
2975 
2976       /* Constrain every dof on the point */
2977       if (numConst < 0) {
2978         if (numFields) {
2979           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
2980         } else {
2981           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
2982         }
2983       }
2984       if (numFields) {
2985         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
2986       }
2987       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
2988     }
2989     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2990   }
2991   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
2992   if (aSec) {
2993     PetscInt aStart, aEnd, a;
2994 
2995     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
2996     for (a = aStart; a < aEnd; a++) {
2997       PetscInt dof;
2998 
2999       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3000       if (dof) {
3001         /* if there are point-to-point constraints, then all dofs are constrained */
3002         ierr = PetscSectionGetDof(section, a, &dof);CHKERRQ(ierr);
3003         ierr = PetscSectionSetConstraintDof(section, a, dof);CHKERRQ(ierr);
3004         if (numFields) {
3005           PetscInt f;
3006 
3007           for (f = 0; f < numFields; f++) {
3008             ierr = PetscSectionGetFieldDof(section, a, f, &dof);CHKERRQ(ierr);
3009             ierr = PetscSectionSetFieldConstraintDof(section, a, f, dof);CHKERRQ(ierr);
3010           }
3011         }
3012       }
3013     }
3014   }
3015   PetscFunctionReturn(0);
3016 }
3017 
3018 #undef __FUNCT__
3019 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
3020 /* Set the constrained indices on each point and separate by fields */
3021 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
3022 {
3023   PetscInt      *maxConstraints;
3024   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
3025   PetscErrorCode ierr;
3026 
3027   PetscFunctionBegin;
3028   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3029   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3030   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
3031   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
3032   for (p = pStart; p < pEnd; ++p) {
3033     PetscInt cdof;
3034 
3035     if (numFields) {
3036       for (f = 0; f < numFields; ++f) {
3037         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
3038         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
3039       }
3040     } else {
3041       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3042       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
3043     }
3044   }
3045   for (f = 0; f < numFields; ++f) {
3046     maxConstraints[numFields] += maxConstraints[f];
3047   }
3048   if (maxConstraints[numFields]) {
3049     PetscInt *indices;
3050 
3051     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
3052     for (p = pStart; p < pEnd; ++p) {
3053       PetscInt cdof, d;
3054 
3055       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3056       if (cdof) {
3057         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
3058         if (numFields) {
3059           PetscInt numConst = 0, foff = 0;
3060 
3061           for (f = 0; f < numFields; ++f) {
3062             PetscInt cfdof, fdof;
3063 
3064             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
3065             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
3066             /* Change constraint numbering from absolute local dof number to field relative local dof number */
3067             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
3068             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
3069             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
3070             numConst += cfdof;
3071             foff     += fdof;
3072           }
3073           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
3074         } else {
3075           for (d = 0; d < cdof; ++d) indices[d] = d;
3076         }
3077         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
3078       }
3079     }
3080     ierr = PetscFree(indices);CHKERRQ(ierr);
3081   }
3082   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
3083   PetscFunctionReturn(0);
3084 }
3085 
3086 #undef __FUNCT__
3087 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
3088 /* Set the constrained field indices on each point */
3089 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
3090 {
3091   const PetscInt *points, *indices;
3092   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
3093   PetscErrorCode  ierr;
3094 
3095   PetscFunctionBegin;
3096   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3097   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
3098 
3099   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
3100   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
3101   if (!constraintIndices) {
3102     PetscInt *idx, i;
3103 
3104     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3105     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
3106     for (i = 0; i < maxDof; ++i) idx[i] = i;
3107     for (p = 0; p < numPoints; ++p) {
3108       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
3109     }
3110     ierr = PetscFree(idx);CHKERRQ(ierr);
3111   } else {
3112     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
3113     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
3114     for (p = 0; p < numPoints; ++p) {
3115       PetscInt fcdof;
3116 
3117       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
3118       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);
3119       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
3120     }
3121     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
3122   }
3123   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
3124   PetscFunctionReturn(0);
3125 }
3126 
3127 #undef __FUNCT__
3128 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
3129 /* Set the constrained indices on each point and separate by fields */
3130 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
3131 {
3132   PetscInt      *indices;
3133   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
3134   PetscErrorCode ierr;
3135 
3136   PetscFunctionBegin;
3137   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3138   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3139   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3140   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
3141   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3142   for (p = pStart; p < pEnd; ++p) {
3143     PetscInt cdof, d;
3144 
3145     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3146     if (cdof) {
3147       PetscInt numConst = 0, foff = 0;
3148 
3149       for (f = 0; f < numFields; ++f) {
3150         const PetscInt *fcind;
3151         PetscInt        fdof, fcdof;
3152 
3153         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
3154         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
3155         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
3156         /* Change constraint numbering from field relative local dof number to absolute local dof number */
3157         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
3158         foff     += fdof;
3159         numConst += fcdof;
3160       }
3161       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
3162       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
3163     }
3164   }
3165   ierr = PetscFree(indices);CHKERRQ(ierr);
3166   PetscFunctionReturn(0);
3167 }
3168 
3169 #undef __FUNCT__
3170 #define __FUNCT__ "DMPlexCreateSection"
3171 /*@C
3172   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
3173 
3174   Not Collective
3175 
3176   Input Parameters:
3177 + dm        - The DMPlex object
3178 . dim       - The spatial dimension of the problem
3179 . numFields - The number of fields in the problem
3180 . numComp   - An array of size numFields that holds the number of components for each field
3181 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
3182 . numBC     - The number of boundary conditions
3183 . bcField   - An array of size numBC giving the field number for each boundry condition
3184 . bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
3185 - perm      - Optional permutation of the chart, or NULL
3186 
3187   Output Parameter:
3188 . section - The PetscSection object
3189 
3190   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
3191   number of dof for field 0 on each edge.
3192 
3193   The chart permutation is the same one set using PetscSectionSetPermutation()
3194 
3195   Level: developer
3196 
3197   Fortran Notes:
3198   A Fortran 90 version is available as DMPlexCreateSectionF90()
3199 
3200 .keywords: mesh, elements
3201 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
3202 @*/
3203 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)
3204 {
3205   PetscSection   aSec;
3206   PetscErrorCode ierr;
3207 
3208   PetscFunctionBegin;
3209   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
3210   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
3211   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
3212   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3213   ierr = DMPlexGetAnchors(dm,&aSec,NULL);CHKERRQ(ierr);
3214   if (numBC || aSec) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
3215   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
3216   PetscFunctionReturn(0);
3217 }
3218 
3219 #undef __FUNCT__
3220 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
3221 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3222 {
3223   PetscSection   section;
3224   PetscErrorCode ierr;
3225 
3226   PetscFunctionBegin;
3227   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
3228   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
3229   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
3230   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
3231   PetscFunctionReturn(0);
3232 }
3233 
3234 #undef __FUNCT__
3235 #define __FUNCT__ "DMPlexGetConeSection"
3236 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
3237 {
3238   DM_Plex *mesh = (DM_Plex*) dm->data;
3239 
3240   PetscFunctionBegin;
3241   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3242   if (section) *section = mesh->coneSection;
3243   PetscFunctionReturn(0);
3244 }
3245 
3246 #undef __FUNCT__
3247 #define __FUNCT__ "DMPlexGetSupportSection"
3248 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
3249 {
3250   DM_Plex *mesh = (DM_Plex*) dm->data;
3251 
3252   PetscFunctionBegin;
3253   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3254   if (section) *section = mesh->supportSection;
3255   PetscFunctionReturn(0);
3256 }
3257 
3258 #undef __FUNCT__
3259 #define __FUNCT__ "DMPlexGetCones"
3260 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
3261 {
3262   DM_Plex *mesh = (DM_Plex*) dm->data;
3263 
3264   PetscFunctionBegin;
3265   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3266   if (cones) *cones = mesh->cones;
3267   PetscFunctionReturn(0);
3268 }
3269 
3270 #undef __FUNCT__
3271 #define __FUNCT__ "DMPlexGetConeOrientations"
3272 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
3273 {
3274   DM_Plex *mesh = (DM_Plex*) dm->data;
3275 
3276   PetscFunctionBegin;
3277   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3278   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
3279   PetscFunctionReturn(0);
3280 }
3281 
3282 /******************************** FEM Support **********************************/
3283 
3284 #undef __FUNCT__
3285 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
3286 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3287 {
3288   PetscScalar    *array, *vArray;
3289   const PetscInt *cone, *coneO;
3290   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
3291   PetscErrorCode  ierr;
3292 
3293   PetscFunctionBeginHot;
3294   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3295   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3296   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3297   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3298   if (!values || !*values) {
3299     if ((point >= pStart) && (point < pEnd)) {
3300       PetscInt dof;
3301 
3302       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3303       size += dof;
3304     }
3305     for (p = 0; p < numPoints; ++p) {
3306       const PetscInt cp = cone[p];
3307       PetscInt       dof;
3308 
3309       if ((cp < pStart) || (cp >= pEnd)) continue;
3310       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3311       size += dof;
3312     }
3313     if (!values) {
3314       if (csize) *csize = size;
3315       PetscFunctionReturn(0);
3316     }
3317     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
3318   } else {
3319     array = *values;
3320   }
3321   size = 0;
3322   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3323   if ((point >= pStart) && (point < pEnd)) {
3324     PetscInt     dof, off, d;
3325     PetscScalar *varr;
3326 
3327     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3328     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3329     varr = &vArray[off];
3330     for (d = 0; d < dof; ++d, ++offset) {
3331       array[offset] = varr[d];
3332     }
3333     size += dof;
3334   }
3335   for (p = 0; p < numPoints; ++p) {
3336     const PetscInt cp = cone[p];
3337     PetscInt       o  = coneO[p];
3338     PetscInt       dof, off, d;
3339     PetscScalar   *varr;
3340 
3341     if ((cp < pStart) || (cp >= pEnd)) continue;
3342     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3343     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3344     varr = &vArray[off];
3345     if (o >= 0) {
3346       for (d = 0; d < dof; ++d, ++offset) {
3347         array[offset] = varr[d];
3348       }
3349     } else {
3350       for (d = dof-1; d >= 0; --d, ++offset) {
3351         array[offset] = varr[d];
3352       }
3353     }
3354     size += dof;
3355   }
3356   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3357   if (!*values) {
3358     if (csize) *csize = size;
3359     *values = array;
3360   } else {
3361     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3362     *csize = size;
3363   }
3364   PetscFunctionReturn(0);
3365 }
3366 
3367 #undef __FUNCT__
3368 #define __FUNCT__ "DMPlexVecGetClosure_Static"
3369 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3370 {
3371   PetscInt       offset = 0, p;
3372   PetscErrorCode ierr;
3373 
3374   PetscFunctionBeginHot;
3375   *size = 0;
3376   for (p = 0; p < numPoints*2; p += 2) {
3377     const PetscInt point = points[p];
3378     const PetscInt o     = points[p+1];
3379     PetscInt       dof, off, d;
3380     const PetscScalar *varr;
3381 
3382     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3383     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3384     varr = &vArray[off];
3385     if (o >= 0) {
3386       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
3387     } else {
3388       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
3389     }
3390   }
3391   *size = offset;
3392   PetscFunctionReturn(0);
3393 }
3394 
3395 #undef __FUNCT__
3396 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
3397 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3398 {
3399   PetscInt       offset = 0, f;
3400   PetscErrorCode ierr;
3401 
3402   PetscFunctionBeginHot;
3403   *size = 0;
3404   for (f = 0; f < numFields; ++f) {
3405     PetscInt fcomp, p;
3406 
3407     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3408     for (p = 0; p < numPoints*2; p += 2) {
3409       const PetscInt point = points[p];
3410       const PetscInt o     = points[p+1];
3411       PetscInt       fdof, foff, d, c;
3412       const PetscScalar *varr;
3413 
3414       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3415       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3416       varr = &vArray[foff];
3417       if (o >= 0) {
3418         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
3419       } else {
3420         for (d = fdof/fcomp-1; d >= 0; --d) {
3421           for (c = 0; c < fcomp; ++c, ++offset) {
3422             array[offset] = varr[d*fcomp+c];
3423           }
3424         }
3425       }
3426     }
3427   }
3428   *size = offset;
3429   PetscFunctionReturn(0);
3430 }
3431 
3432 #undef __FUNCT__
3433 #define __FUNCT__ "DMPlexVecGetClosure"
3434 /*@C
3435   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
3436 
3437   Not collective
3438 
3439   Input Parameters:
3440 + dm - The DM
3441 . section - The section describing the layout in v, or NULL to use the default section
3442 . v - The local vector
3443 - point - The sieve point in the DM
3444 
3445   Output Parameters:
3446 + csize - The number of values in the closure, or NULL
3447 - values - The array of values, which is a borrowed array and should not be freed
3448 
3449   Fortran Notes:
3450   Since it returns an array, this routine is only available in Fortran 90, and you must
3451   include petsc.h90 in your code.
3452 
3453   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3454 
3455   Level: intermediate
3456 
3457 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3458 @*/
3459 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3460 {
3461   PetscSection    clSection;
3462   IS              clPoints;
3463   PetscScalar    *array, *vArray;
3464   PetscInt       *points = NULL;
3465   const PetscInt *clp;
3466   PetscInt        depth, numFields, numPoints, size;
3467   PetscErrorCode  ierr;
3468 
3469   PetscFunctionBeginHot;
3470   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3471   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3472   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3473   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3474   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3475   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3476   if (depth == 1 && numFields < 2) {
3477     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
3478     PetscFunctionReturn(0);
3479   }
3480   /* Get points */
3481   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3482   if (!clPoints) {
3483     PetscInt pStart, pEnd, p, q;
3484 
3485     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3486     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3487     /* Compress out points not in the section */
3488     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3489       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3490         points[q*2]   = points[p];
3491         points[q*2+1] = points[p+1];
3492         ++q;
3493       }
3494     }
3495     numPoints = q;
3496   } else {
3497     PetscInt dof, off;
3498 
3499     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3500     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3501     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3502     numPoints = dof/2;
3503     points    = (PetscInt *) &clp[off];
3504   }
3505   /* Get array */
3506   if (!values || !*values) {
3507     PetscInt asize = 0, dof, p;
3508 
3509     for (p = 0; p < numPoints*2; p += 2) {
3510       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3511       asize += dof;
3512     }
3513     if (!values) {
3514       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3515       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3516       if (csize) *csize = asize;
3517       PetscFunctionReturn(0);
3518     }
3519     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
3520   } else {
3521     array = *values;
3522   }
3523   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3524   /* Get values */
3525   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
3526   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
3527   /* Cleanup points */
3528   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3529   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3530   /* Cleanup array */
3531   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3532   if (!*values) {
3533     if (csize) *csize = size;
3534     *values = array;
3535   } else {
3536     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3537     *csize = size;
3538   }
3539   PetscFunctionReturn(0);
3540 }
3541 
3542 #undef __FUNCT__
3543 #define __FUNCT__ "DMPlexVecRestoreClosure"
3544 /*@C
3545   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
3546 
3547   Not collective
3548 
3549   Input Parameters:
3550 + dm - The DM
3551 . section - The section describing the layout in v, or NULL to use the default section
3552 . v - The local vector
3553 . point - The sieve point in the DM
3554 . csize - The number of values in the closure, or NULL
3555 - values - The array of values, which is a borrowed array and should not be freed
3556 
3557   Fortran Notes:
3558   Since it returns an array, this routine is only available in Fortran 90, and you must
3559   include petsc.h90 in your code.
3560 
3561   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3562 
3563   Level: intermediate
3564 
3565 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3566 @*/
3567 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3568 {
3569   PetscInt       size = 0;
3570   PetscErrorCode ierr;
3571 
3572   PetscFunctionBegin;
3573   /* Should work without recalculating size */
3574   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
3575   PetscFunctionReturn(0);
3576 }
3577 
3578 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
3579 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
3580 
3581 #undef __FUNCT__
3582 #define __FUNCT__ "updatePoint_private"
3583 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[])
3584 {
3585   PetscInt        cdof;   /* The number of constraints on this point */
3586   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3587   PetscScalar    *a;
3588   PetscInt        off, cind = 0, k;
3589   PetscErrorCode  ierr;
3590 
3591   PetscFunctionBegin;
3592   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3593   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3594   a    = &array[off];
3595   if (!cdof || setBC) {
3596     if (orientation >= 0) {
3597       for (k = 0; k < dof; ++k) {
3598         fuse(&a[k], values[k]);
3599       }
3600     } else {
3601       for (k = 0; k < dof; ++k) {
3602         fuse(&a[k], values[dof-k-1]);
3603       }
3604     }
3605   } else {
3606     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3607     if (orientation >= 0) {
3608       for (k = 0; k < dof; ++k) {
3609         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3610         fuse(&a[k], values[k]);
3611       }
3612     } else {
3613       for (k = 0; k < dof; ++k) {
3614         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3615         fuse(&a[k], values[dof-k-1]);
3616       }
3617     }
3618   }
3619   PetscFunctionReturn(0);
3620 }
3621 
3622 #undef __FUNCT__
3623 #define __FUNCT__ "updatePointBC_private"
3624 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
3625 {
3626   PetscInt        cdof;   /* The number of constraints on this point */
3627   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3628   PetscScalar    *a;
3629   PetscInt        off, cind = 0, k;
3630   PetscErrorCode  ierr;
3631 
3632   PetscFunctionBegin;
3633   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3634   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3635   a    = &array[off];
3636   if (cdof) {
3637     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3638     if (orientation >= 0) {
3639       for (k = 0; k < dof; ++k) {
3640         if ((cind < cdof) && (k == cdofs[cind])) {
3641           fuse(&a[k], values[k]);
3642           ++cind;
3643         }
3644       }
3645     } else {
3646       for (k = 0; k < dof; ++k) {
3647         if ((cind < cdof) && (k == cdofs[cind])) {
3648           fuse(&a[k], values[dof-k-1]);
3649           ++cind;
3650         }
3651       }
3652     }
3653   }
3654   PetscFunctionReturn(0);
3655 }
3656 
3657 #undef __FUNCT__
3658 #define __FUNCT__ "updatePointFields_private"
3659 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[])
3660 {
3661   PetscScalar    *a;
3662   PetscInt        fdof, foff, fcdof, foffset = *offset;
3663   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3664   PetscInt        cind = 0, k, c;
3665   PetscErrorCode  ierr;
3666 
3667   PetscFunctionBegin;
3668   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3669   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3670   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3671   a    = &array[foff];
3672   if (!fcdof || setBC) {
3673     if (o >= 0) {
3674       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
3675     } else {
3676       for (k = fdof/fcomp-1; k >= 0; --k) {
3677         for (c = 0; c < fcomp; ++c) {
3678           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3679         }
3680       }
3681     }
3682   } else {
3683     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3684     if (o >= 0) {
3685       for (k = 0; k < fdof; ++k) {
3686         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
3687         fuse(&a[k], values[foffset+k]);
3688       }
3689     } else {
3690       for (k = fdof/fcomp-1; k >= 0; --k) {
3691         for (c = 0; c < fcomp; ++c) {
3692           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
3693           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3694         }
3695       }
3696     }
3697   }
3698   *offset += fdof;
3699   PetscFunctionReturn(0);
3700 }
3701 
3702 #undef __FUNCT__
3703 #define __FUNCT__ "updatePointFieldsBC_private"
3704 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[])
3705 {
3706   PetscScalar    *a;
3707   PetscInt        fdof, foff, fcdof, foffset = *offset;
3708   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3709   PetscInt        cind = 0, k, c;
3710   PetscErrorCode  ierr;
3711 
3712   PetscFunctionBegin;
3713   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3714   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3715   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3716   a    = &array[foff];
3717   if (fcdof) {
3718     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3719     if (o >= 0) {
3720       for (k = 0; k < fdof; ++k) {
3721         if ((cind < fcdof) && (k == fcdofs[cind])) {
3722           fuse(&a[k], values[foffset+k]);
3723           ++cind;
3724         }
3725       }
3726     } else {
3727       for (k = fdof/fcomp-1; k >= 0; --k) {
3728         for (c = 0; c < fcomp; ++c) {
3729           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
3730             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3731             ++cind;
3732           }
3733         }
3734       }
3735     }
3736   }
3737   *offset += fdof;
3738   PetscFunctionReturn(0);
3739 }
3740 
3741 #undef __FUNCT__
3742 #define __FUNCT__ "DMPlexVecSetClosure_Static"
3743 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3744 {
3745   PetscScalar    *array;
3746   const PetscInt *cone, *coneO;
3747   PetscInt        pStart, pEnd, p, numPoints, off, dof;
3748   PetscErrorCode  ierr;
3749 
3750   PetscFunctionBeginHot;
3751   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3752   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3753   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3754   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3755   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3756   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
3757     const PetscInt cp = !p ? point : cone[p-1];
3758     const PetscInt o  = !p ? 0     : coneO[p-1];
3759 
3760     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
3761     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3762     /* ADD_VALUES */
3763     {
3764       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3765       PetscScalar    *a;
3766       PetscInt        cdof, coff, cind = 0, k;
3767 
3768       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
3769       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
3770       a    = &array[coff];
3771       if (!cdof) {
3772         if (o >= 0) {
3773           for (k = 0; k < dof; ++k) {
3774             a[k] += values[off+k];
3775           }
3776         } else {
3777           for (k = 0; k < dof; ++k) {
3778             a[k] += values[off+dof-k-1];
3779           }
3780         }
3781       } else {
3782         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
3783         if (o >= 0) {
3784           for (k = 0; k < dof; ++k) {
3785             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3786             a[k] += values[off+k];
3787           }
3788         } else {
3789           for (k = 0; k < dof; ++k) {
3790             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3791             a[k] += values[off+dof-k-1];
3792           }
3793         }
3794       }
3795     }
3796   }
3797   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3798   PetscFunctionReturn(0);
3799 }
3800 
3801 #undef __FUNCT__
3802 #define __FUNCT__ "DMPlexVecSetClosure"
3803 /*@C
3804   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
3805 
3806   Not collective
3807 
3808   Input Parameters:
3809 + dm - The DM
3810 . section - The section describing the layout in v, or NULL to use the default section
3811 . v - The local vector
3812 . point - The sieve point in the DM
3813 . values - The array of values
3814 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
3815 
3816   Fortran Notes:
3817   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
3818 
3819   Level: intermediate
3820 
3821 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
3822 @*/
3823 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3824 {
3825   PetscSection    clSection;
3826   IS              clPoints;
3827   PetscScalar    *array;
3828   PetscInt       *points = NULL;
3829   const PetscInt *clp;
3830   PetscInt        depth, numFields, numPoints, p;
3831   PetscErrorCode  ierr;
3832 
3833   PetscFunctionBeginHot;
3834   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3835   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3836   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3837   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3838   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3839   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3840   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
3841     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
3842     PetscFunctionReturn(0);
3843   }
3844   /* Get points */
3845   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3846   if (!clPoints) {
3847     PetscInt pStart, pEnd, q;
3848 
3849     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3850     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3851     /* Compress out points not in the section */
3852     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3853       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3854         points[q*2]   = points[p];
3855         points[q*2+1] = points[p+1];
3856         ++q;
3857       }
3858     }
3859     numPoints = q;
3860   } else {
3861     PetscInt dof, off;
3862 
3863     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3864     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3865     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3866     numPoints = dof/2;
3867     points    = (PetscInt *) &clp[off];
3868   }
3869   /* Get array */
3870   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3871   /* Get values */
3872   if (numFields > 0) {
3873     PetscInt offset = 0, fcomp, f;
3874     for (f = 0; f < numFields; ++f) {
3875       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3876       switch (mode) {
3877       case INSERT_VALUES:
3878         for (p = 0; p < numPoints*2; p += 2) {
3879           const PetscInt point = points[p];
3880           const PetscInt o     = points[p+1];
3881           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
3882         } break;
3883       case INSERT_ALL_VALUES:
3884         for (p = 0; p < numPoints*2; p += 2) {
3885           const PetscInt point = points[p];
3886           const PetscInt o     = points[p+1];
3887           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
3888         } break;
3889       case INSERT_BC_VALUES:
3890         for (p = 0; p < numPoints*2; p += 2) {
3891           const PetscInt point = points[p];
3892           const PetscInt o     = points[p+1];
3893           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
3894         } break;
3895       case ADD_VALUES:
3896         for (p = 0; p < numPoints*2; p += 2) {
3897           const PetscInt point = points[p];
3898           const PetscInt o     = points[p+1];
3899           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
3900         } break;
3901       case ADD_ALL_VALUES:
3902         for (p = 0; p < numPoints*2; p += 2) {
3903           const PetscInt point = points[p];
3904           const PetscInt o     = points[p+1];
3905           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
3906         } break;
3907       default:
3908         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3909       }
3910     }
3911   } else {
3912     PetscInt dof, off;
3913 
3914     switch (mode) {
3915     case INSERT_VALUES:
3916       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3917         PetscInt o = points[p+1];
3918         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3919         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
3920       } break;
3921     case INSERT_ALL_VALUES:
3922       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3923         PetscInt o = points[p+1];
3924         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3925         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
3926       } break;
3927     case INSERT_BC_VALUES:
3928       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3929         PetscInt o = points[p+1];
3930         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3931         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
3932       } break;
3933     case ADD_VALUES:
3934       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3935         PetscInt o = points[p+1];
3936         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3937         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
3938       } break;
3939     case ADD_ALL_VALUES:
3940       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3941         PetscInt o = points[p+1];
3942         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3943         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
3944       } break;
3945     default:
3946       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3947     }
3948   }
3949   /* Cleanup points */
3950   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3951   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3952   /* Cleanup array */
3953   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3954   PetscFunctionReturn(0);
3955 }
3956 
3957 #undef __FUNCT__
3958 #define __FUNCT__ "DMPlexVecSetFieldClosure_Internal"
3959 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, const PetscScalar values[], InsertMode mode)
3960 {
3961   PetscSection    clSection;
3962   IS              clPoints;
3963   PetscScalar    *array;
3964   PetscInt       *points = NULL;
3965   const PetscInt *clp;
3966   PetscInt        numFields, numPoints, p;
3967   PetscInt        offset = 0, fcomp, f;
3968   PetscErrorCode  ierr;
3969 
3970   PetscFunctionBeginHot;
3971   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3972   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3973   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3974   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3975   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3976   /* Get points */
3977   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3978   if (!clPoints) {
3979     PetscInt pStart, pEnd, q;
3980 
3981     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3982     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3983     /* Compress out points not in the section */
3984     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3985       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3986         points[q*2]   = points[p];
3987         points[q*2+1] = points[p+1];
3988         ++q;
3989       }
3990     }
3991     numPoints = q;
3992   } else {
3993     PetscInt dof, off;
3994 
3995     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3996     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3997     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3998     numPoints = dof/2;
3999     points    = (PetscInt *) &clp[off];
4000   }
4001   /* Get array */
4002   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4003   /* Get values */
4004   for (f = 0; f < numFields; ++f) {
4005     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
4006     if (!fieldActive[f]) {
4007       for (p = 0; p < numPoints*2; p += 2) {
4008         PetscInt fdof;
4009         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4010         offset += fdof;
4011       }
4012       continue;
4013     }
4014     switch (mode) {
4015     case INSERT_VALUES:
4016       for (p = 0; p < numPoints*2; p += 2) {
4017         const PetscInt point = points[p];
4018         const PetscInt o     = points[p+1];
4019         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
4020       } break;
4021     case INSERT_ALL_VALUES:
4022       for (p = 0; p < numPoints*2; p += 2) {
4023         const PetscInt point = points[p];
4024         const PetscInt o     = points[p+1];
4025         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
4026         } break;
4027     case INSERT_BC_VALUES:
4028       for (p = 0; p < numPoints*2; p += 2) {
4029         const PetscInt point = points[p];
4030         const PetscInt o     = points[p+1];
4031         updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
4032       } break;
4033     case ADD_VALUES:
4034       for (p = 0; p < numPoints*2; p += 2) {
4035         const PetscInt point = points[p];
4036         const PetscInt o     = points[p+1];
4037         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
4038       } break;
4039     case ADD_ALL_VALUES:
4040       for (p = 0; p < numPoints*2; p += 2) {
4041         const PetscInt point = points[p];
4042         const PetscInt o     = points[p+1];
4043         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
4044       } break;
4045     default:
4046       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
4047     }
4048   }
4049   /* Cleanup points */
4050   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
4051   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
4052   /* Cleanup array */
4053   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4054   PetscFunctionReturn(0);
4055 }
4056 
4057 #undef __FUNCT__
4058 #define __FUNCT__ "DMPlexPrintMatSetValues"
4059 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
4060 {
4061   PetscMPIInt    rank;
4062   PetscInt       i, j;
4063   PetscErrorCode ierr;
4064 
4065   PetscFunctionBegin;
4066   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
4067   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
4068   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
4069   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
4070   numCIndices = numCIndices ? numCIndices : numRIndices;
4071   for (i = 0; i < numRIndices; i++) {
4072     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
4073     for (j = 0; j < numCIndices; j++) {
4074 #if defined(PETSC_USE_COMPLEX)
4075       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
4076 #else
4077       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
4078 #endif
4079     }
4080     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
4081   }
4082   PetscFunctionReturn(0);
4083 }
4084 
4085 #undef __FUNCT__
4086 #define __FUNCT__ "indicesPoint_private"
4087 /* . off - The global offset of this point */
4088 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
4089 {
4090   PetscInt        dof;    /* The number of unknowns on this point */
4091   PetscInt        cdof;   /* The number of constraints on this point */
4092   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4093   PetscInt        cind = 0, k;
4094   PetscErrorCode  ierr;
4095 
4096   PetscFunctionBegin;
4097   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4098   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4099   if (!cdof || setBC) {
4100     if (orientation >= 0) {
4101       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
4102     } else {
4103       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
4104     }
4105   } else {
4106     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4107     if (orientation >= 0) {
4108       for (k = 0; k < dof; ++k) {
4109         if ((cind < cdof) && (k == cdofs[cind])) {
4110           /* Insert check for returning constrained indices */
4111           indices[*loff+k] = -(off+k+1);
4112           ++cind;
4113         } else {
4114           indices[*loff+k] = off+k-cind;
4115         }
4116       }
4117     } else {
4118       for (k = 0; k < dof; ++k) {
4119         if ((cind < cdof) && (k == cdofs[cind])) {
4120           /* Insert check for returning constrained indices */
4121           indices[*loff+dof-k-1] = -(off+k+1);
4122           ++cind;
4123         } else {
4124           indices[*loff+dof-k-1] = off+k-cind;
4125         }
4126       }
4127     }
4128   }
4129   *loff += dof;
4130   PetscFunctionReturn(0);
4131 }
4132 
4133 #undef __FUNCT__
4134 #define __FUNCT__ "indicesPointFields_private"
4135 /* . off - The global offset of this point */
4136 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
4137 {
4138   PetscInt       numFields, foff, f;
4139   PetscErrorCode ierr;
4140 
4141   PetscFunctionBegin;
4142   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4143   for (f = 0, foff = 0; f < numFields; ++f) {
4144     PetscInt        fdof, fcomp, cfdof;
4145     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4146     PetscInt        cind = 0, k, c;
4147 
4148     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
4149     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4150     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4151     if (!cfdof || setBC) {
4152       if (orientation >= 0) {
4153         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
4154       } else {
4155         for (k = fdof/fcomp-1; k >= 0; --k) {
4156           for (c = 0; c < fcomp; ++c) {
4157             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
4158           }
4159         }
4160       }
4161     } else {
4162       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4163       if (orientation >= 0) {
4164         for (k = 0; k < fdof; ++k) {
4165           if ((cind < cfdof) && (k == fcdofs[cind])) {
4166             indices[foffs[f]+k] = -(off+foff+k+1);
4167             ++cind;
4168           } else {
4169             indices[foffs[f]+k] = off+foff+k-cind;
4170           }
4171         }
4172       } else {
4173         for (k = fdof/fcomp-1; k >= 0; --k) {
4174           for (c = 0; c < fcomp; ++c) {
4175             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
4176               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
4177               ++cind;
4178             } else {
4179               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
4180             }
4181           }
4182         }
4183       }
4184     }
4185     foff     += fdof - cfdof;
4186     foffs[f] += fdof;
4187   }
4188   PetscFunctionReturn(0);
4189 }
4190 
4191 #undef __FUNCT__
4192 #define __FUNCT__ "DMPlexAnchorsModifyMat"
4193 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[])
4194 {
4195   Mat             cMat;
4196   PetscSection    aSec, cSec;
4197   IS              aIS;
4198   PetscInt        aStart = -1, aEnd = -1;
4199   const PetscInt  *anchors;
4200   PetscInt        numFields, f, p, q, newP = 0;
4201   PetscInt        newNumPoints = 0, newNumIndices = 0;
4202   PetscInt        *newPoints, *indices, *newIndices;
4203   PetscInt        maxAnchor, maxDof;
4204   PetscInt        newOffsets[32];
4205   PetscInt        *pointMatOffsets[32];
4206   PetscInt        *newPointOffsets[32];
4207   PetscScalar     *pointMat[32];
4208   PetscScalar     *newValues,*tmpValues;
4209   PetscBool       anyConstrained = PETSC_FALSE;
4210   PetscErrorCode  ierr;
4211 
4212   PetscFunctionBegin;
4213   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4214   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4215   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4216 
4217   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4218   /* if there are point-to-point constraints */
4219   if (aSec) {
4220     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4221     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4222     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4223     /* figure out how many points are going to be in the new element matrix
4224      * (we allow double counting, because it's all just going to be summed
4225      * into the global matrix anyway) */
4226     for (p = 0; p < 2*numPoints; p+=2) {
4227       PetscInt b    = points[p];
4228       PetscInt bDof = 0;
4229 
4230       if (b >= aStart && b < aEnd) {
4231         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4232       }
4233       if (bDof) {
4234         /* this point is constrained */
4235         /* it is going to be replaced by its anchors */
4236         PetscInt bOff, q;
4237 
4238         anyConstrained = PETSC_TRUE;
4239         newNumPoints  += bDof;
4240         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4241         for (q = 0; q < bDof; q++) {
4242           PetscInt a = anchors[bOff + q];
4243           PetscInt aDof;
4244 
4245           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4246           newNumIndices += aDof;
4247           for (f = 0; f < numFields; ++f) {
4248             PetscInt fDof;
4249 
4250             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4251             newOffsets[f+1] += fDof;
4252           }
4253         }
4254       }
4255       else {
4256         /* this point is not constrained */
4257         newNumPoints++;
4258         ierr           = PetscSectionGetDof(section,b,&bDof);CHKERRQ(ierr);
4259         newNumIndices += bDof;
4260         for (f = 0; f < numFields; ++f) {
4261           PetscInt fDof;
4262 
4263           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4264           newOffsets[f+1] += fDof;
4265         }
4266       }
4267     }
4268   }
4269   if (!anyConstrained) {
4270     *outNumPoints  = 0;
4271     *outNumIndices = 0;
4272     *outPoints     = NULL;
4273     *outValues     = NULL;
4274     if (aSec) {
4275       ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
4276     }
4277     PetscFunctionReturn(0);
4278   }
4279 
4280   for (f = 1; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
4281 
4282   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", newOffsets[numFields], newNumIndices);
4283 
4284   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
4285 
4286   /* output arrays */
4287   ierr = DMGetWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4288   ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4289 
4290   /* workspaces */
4291   ierr = DMGetWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4292   if (numFields) {
4293     for (f = 0; f < numFields; f++) {
4294       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4295       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4296     }
4297   }
4298   else {
4299     ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4300     ierr = DMGetWorkArray(dm,numPoints,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4301   }
4302 
4303   /* get workspaces for the point-to-point matrices */
4304   if (numFields) {
4305     for (p = 0; p < numPoints; p++) {
4306       PetscInt b    = points[2*p];
4307       PetscInt bDof = 0;
4308 
4309       if (b >= aStart && b < aEnd) {
4310         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4311       }
4312       if (bDof) {
4313         for (f = 0; f < numFields; f++) {
4314           PetscInt fDof, q, bOff, allFDof = 0;
4315 
4316           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4317           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4318           for (q = 0; q < bDof; q++) {
4319             PetscInt a = anchors[bOff + q];
4320             PetscInt aFDof;
4321 
4322             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4323             allFDof += aFDof;
4324           }
4325           newPointOffsets[f][p+1] = allFDof;
4326           pointMatOffsets[f][p+1] = fDof * allFDof;
4327         }
4328       }
4329       else {
4330         for (f = 0; f < numFields; f++) {
4331           PetscInt fDof;
4332 
4333           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4334           newPointOffsets[f][p+1] = fDof;
4335           pointMatOffsets[f][p+1] = 0;
4336         }
4337       }
4338     }
4339     for (f = 0; f < numFields; f++) {
4340       newPointOffsets[f][0] = 0;
4341       pointMatOffsets[f][0] = 0;
4342       for (p = 0; p < numPoints; p++) {
4343         newPointOffsets[f][p+1] += newPointOffsets[f][p];
4344         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
4345       }
4346       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4347     }
4348   }
4349   else {
4350     for (p = 0; p < numPoints; p++) {
4351       PetscInt b    = points[2*p];
4352       PetscInt bDof = 0;
4353 
4354       if (b >= aStart && b < aEnd) {
4355         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4356       }
4357       if (bDof) {
4358         PetscInt dof, bOff, q, allDof = 0;
4359 
4360         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4361         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4362         for (q = 0; q < bDof; q++) {
4363           PetscInt a = anchors[bOff + q], aDof;
4364 
4365           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
4366           allDof += aDof;
4367         }
4368         newPointOffsets[0][p+1] = allDof;
4369         pointMatOffsets[0][p+1] = dof * allDof;
4370       }
4371       else {
4372         PetscInt dof;
4373 
4374         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4375         newPointOffsets[0][p+1] = dof;
4376         pointMatOffsets[0][p+1] = 0;
4377       }
4378     }
4379     newPointOffsets[0][0] = 0;
4380     pointMatOffsets[0][0] = 0;
4381     for (p = 0; p < numPoints; p++) {
4382       newPointOffsets[0][p+1] += newPointOffsets[0][p];
4383       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
4384     }
4385     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4386   }
4387 
4388   /* get the point-to-point matrices; construct newPoints */
4389   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
4390   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4391   ierr = DMGetWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4392   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4393   if (numFields) {
4394     for (p = 0, newP = 0; p < numPoints; p++) {
4395       PetscInt b    = points[2*p];
4396       PetscInt o    = points[2*p+1];
4397       PetscInt bDof = 0;
4398 
4399       if (b >= aStart && b < aEnd) {
4400         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4401       }
4402       if (bDof) {
4403         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
4404 
4405         fStart[0] = 0;
4406         fEnd[0]   = 0;
4407         for (f = 0; f < numFields; f++) {
4408           PetscInt fDof;
4409 
4410           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
4411           fStart[f+1] = fStart[f] + fDof;
4412           fEnd[f+1]   = fStart[f+1];
4413         }
4414         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4415         ierr = indicesPointFields_private(cSec, b, bOff, fEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4416 
4417         fAnchorStart[0] = 0;
4418         fAnchorEnd[0]   = 0;
4419         for (f = 0; f < numFields; f++) {
4420           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
4421 
4422           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
4423           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
4424         }
4425         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4426         for (q = 0; q < bDof; q++) {
4427           PetscInt a = anchors[bOff + q], aOff;
4428 
4429           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4430           newPoints[2*(newP + q)]     = a;
4431           newPoints[2*(newP + q) + 1] = 0;
4432           ierr = PetscSectionGetOffset(section, a, &aOff);
4433           ierr = indicesPointFields_private(section, a, aOff, fAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4434         }
4435         newP += bDof;
4436 
4437         /* get the point-to-point submatrix */
4438         for (f = 0; f < numFields; f++) {
4439           ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
4440         }
4441       }
4442       else {
4443         newPoints[2 * newP]     = b;
4444         newPoints[2 * newP + 1] = o;
4445         newP++;
4446       }
4447     }
4448   } else {
4449     for (p = 0; p < numPoints; p++) {
4450       PetscInt b    = points[2*p];
4451       PetscInt o    = points[2*p+1];
4452       PetscInt bDof = 0;
4453 
4454       if (b >= aStart && b < aEnd) {
4455         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4456       }
4457       if (bDof) {
4458         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
4459 
4460         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4461         ierr = indicesPoint_private(cSec, b, bOff, &bEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4462 
4463         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4464         for (q = 0; q < bDof; q++) {
4465           PetscInt a = anchors[bOff + q], aOff;
4466 
4467           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4468 
4469           newPoints[2*(newP + q)]     = a;
4470           newPoints[2*(newP + q) + 1] = 0;
4471           ierr = PetscSectionGetOffset(section, a, &aOff);
4472           ierr = indicesPoint_private(section, a, aOff, &bAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4473         }
4474         newP += bDof;
4475 
4476         /* get the point-to-point submatrix */
4477         ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
4478       }
4479       else {
4480         newPoints[2 * newP]     = b;
4481         newPoints[2 * newP + 1] = o;
4482         newP++;
4483       }
4484     }
4485   }
4486 
4487   ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
4488   /* multiply constraints on the right */
4489   if (numFields) {
4490     for (f = 0; f < numFields; f++) {
4491       PetscInt oldOff = offsets[f];
4492 
4493       for (p = 0; p < numPoints; p++) {
4494         PetscInt cStart = newPointOffsets[f][p];
4495         PetscInt b      = points[2 * p];
4496         PetscInt c, r, k;
4497         PetscInt dof;
4498 
4499         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4500         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4501           PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
4502           const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
4503 
4504           for (r = 0; r < numIndices; r++) {
4505             for (c = 0; c < nCols; c++) {
4506               for (k = 0; k < dof; k++) {
4507                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4508               }
4509             }
4510           }
4511         }
4512         else {
4513           /* copy this column as is */
4514           for (r = 0; r < numIndices; r++) {
4515             for (c = 0; c < dof; c++) {
4516               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4517             }
4518           }
4519         }
4520         oldOff += dof;
4521       }
4522     }
4523   }
4524   else {
4525     PetscInt oldOff = 0;
4526     for (p = 0; p < numPoints; p++) {
4527       PetscInt cStart = newPointOffsets[0][p];
4528       PetscInt b      = points[2 * p];
4529       PetscInt c, r, k;
4530       PetscInt dof;
4531 
4532       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4533       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4534         PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
4535         const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
4536 
4537         for (r = 0; r < numIndices; r++) {
4538           for (c = 0; c < nCols; c++) {
4539             for (k = 0; k < dof; k++) {
4540               tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4541             }
4542           }
4543         }
4544       }
4545       else {
4546         /* copy this column as is */
4547         for (r = 0; r < numIndices; r++) {
4548           for (c = 0; c < dof; c++) {
4549             tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4550           }
4551         }
4552       }
4553       oldOff += dof;
4554     }
4555   }
4556 
4557   ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
4558   /* multiply constraints transpose on the left */
4559   if (numFields) {
4560     for (f = 0; f < numFields; f++) {
4561       PetscInt oldOff = offsets[f];
4562 
4563       for (p = 0; p < numPoints; p++) {
4564         PetscInt rStart = newPointOffsets[f][p];
4565         PetscInt b      = points[2 * p];
4566         PetscInt c, r, k;
4567         PetscInt dof;
4568 
4569         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4570         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4571           PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
4572           const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
4573 
4574           for (r = 0; r < nRows; r++) {
4575             for (c = 0; c < newNumIndices; c++) {
4576               for (k = 0; k < dof; k++) {
4577                 newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4578               }
4579             }
4580           }
4581         }
4582         else {
4583           /* copy this row as is */
4584           for (r = 0; r < dof; r++) {
4585             for (c = 0; c < newNumIndices; c++) {
4586               newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4587             }
4588           }
4589         }
4590         oldOff += dof;
4591       }
4592     }
4593   }
4594   else {
4595     PetscInt oldOff = 0;
4596 
4597     for (p = 0; p < numPoints; p++) {
4598       PetscInt rStart = newPointOffsets[0][p];
4599       PetscInt b      = points[2 * p];
4600       PetscInt c, r, k;
4601       PetscInt dof;
4602 
4603       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4604       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4605         PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
4606         const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
4607 
4608         for (r = 0; r < nRows; r++) {
4609           for (c = 0; c < newNumIndices; c++) {
4610             for (k = 0; k < dof; k++) {
4611               newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4612             }
4613           }
4614         }
4615       }
4616       else {
4617         /* copy this row as is */
4618         for (r = 0; r < dof; c++) {
4619           for (c = 0; c < newNumIndices; c++) {
4620             newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4621           }
4622         }
4623       }
4624       oldOff += dof;
4625     }
4626   }
4627 
4628   /* clean up */
4629   ierr = DMRestoreWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4630   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4631   if (numFields) {
4632     for (f = 0; f < numFields; f++) {
4633       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4634       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4635       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4636     }
4637   }
4638   else {
4639     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4640     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4641     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4642   }
4643   ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4644   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
4645 
4646   /* output */
4647   *outNumPoints  = newNumPoints;
4648   *outNumIndices = newNumIndices;
4649   *outPoints     = newPoints;
4650   *outValues     = newValues;
4651   for (f = 0; f < numFields; f++) {
4652     offsets[f] = newOffsets[f];
4653   }
4654   PetscFunctionReturn(0);
4655 }
4656 
4657 #undef __FUNCT__
4658 #define __FUNCT__ "DMPlexMatSetClosure"
4659 /*@C
4660   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
4661 
4662   Not collective
4663 
4664   Input Parameters:
4665 + dm - The DM
4666 . section - The section describing the layout in v, or NULL to use the default section
4667 . globalSection - The section describing the layout in v, or NULL to use the default global section
4668 . A - The matrix
4669 . point - The sieve point in the DM
4670 . values - The array of values
4671 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
4672 
4673   Fortran Notes:
4674   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4675 
4676   Level: intermediate
4677 
4678 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
4679 @*/
4680 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4681 {
4682   DM_Plex        *mesh   = (DM_Plex*) dm->data;
4683   PetscSection    clSection;
4684   IS              clPoints;
4685   PetscInt       *points = NULL, *newPoints;
4686   const PetscInt *clp;
4687   PetscInt       *indices;
4688   PetscInt        offsets[32];
4689   PetscInt        numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
4690   PetscScalar    *newValues;
4691   PetscErrorCode  ierr;
4692 
4693   PetscFunctionBegin;
4694   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4695   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4696   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4697   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
4698   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
4699   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
4700   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4701   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4702   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4703   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
4704   if (!clPoints) {
4705     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4706     /* Compress out points not in the section */
4707     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4708     for (p = 0, q = 0; p < numPoints*2; p += 2) {
4709       if ((points[p] >= pStart) && (points[p] < pEnd)) {
4710         points[q*2]   = points[p];
4711         points[q*2+1] = points[p+1];
4712         ++q;
4713       }
4714     }
4715     numPoints = q;
4716   } else {
4717     PetscInt dof, off;
4718 
4719     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4720     numPoints = dof/2;
4721     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4722     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
4723     points = (PetscInt *) &clp[off];
4724   }
4725   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
4726     PetscInt fdof;
4727 
4728     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4729     for (f = 0; f < numFields; ++f) {
4730       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4731       offsets[f+1] += fdof;
4732     }
4733     numIndices += dof;
4734   }
4735   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
4736 
4737   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
4738   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets);CHKERRQ(ierr);
4739   if (newNumPoints) {
4740     if (!clPoints) {
4741       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4742     } else {
4743       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4744     }
4745     numPoints  = newNumPoints;
4746     numIndices = newNumIndices;
4747     points     = newPoints;
4748     values     = newValues;
4749   }
4750   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4751   if (numFields) {
4752     for (p = 0; p < numPoints*2; p += 2) {
4753       PetscInt o = points[p+1];
4754       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4755       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
4756     }
4757   } else {
4758     for (p = 0, off = 0; p < numPoints*2; p += 2) {
4759       PetscInt o = points[p+1];
4760       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4761       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
4762     }
4763   }
4764   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
4765   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
4766   if (ierr) {
4767     PetscMPIInt    rank;
4768     PetscErrorCode ierr2;
4769 
4770     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4771     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4772     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
4773     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
4774     CHKERRQ(ierr);
4775   }
4776   if (newNumPoints) {
4777     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4778     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4779   }
4780   else {
4781     if (!clPoints) {
4782       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4783     } else {
4784       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4785     }
4786   }
4787   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4788   PetscFunctionReturn(0);
4789 }
4790 
4791 #undef __FUNCT__
4792 #define __FUNCT__ "DMPlexMatSetClosureRefined"
4793 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4794 {
4795   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
4796   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
4797   PetscInt       *cpoints = NULL;
4798   PetscInt       *findices, *cindices;
4799   PetscInt        foffsets[32], coffsets[32];
4800   CellRefiner     cellRefiner;
4801   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4802   PetscErrorCode  ierr;
4803 
4804   PetscFunctionBegin;
4805   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4806   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4807   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4808   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4809   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4810   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4811   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4812   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4813   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4814   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4815   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
4816   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4817   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4818   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4819   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4820   /* Column indices */
4821   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4822   maxFPoints = numCPoints;
4823   /* Compress out points not in the section */
4824   /*   TODO: Squeeze out points with 0 dof as well */
4825   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4826   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4827     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4828       cpoints[q*2]   = cpoints[p];
4829       cpoints[q*2+1] = cpoints[p+1];
4830       ++q;
4831     }
4832   }
4833   numCPoints = q;
4834   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4835     PetscInt fdof;
4836 
4837     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4838     if (!dof) continue;
4839     for (f = 0; f < numFields; ++f) {
4840       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4841       coffsets[f+1] += fdof;
4842     }
4843     numCIndices += dof;
4844   }
4845   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4846   /* Row indices */
4847   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4848   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4849   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4850   for (r = 0, q = 0; r < numSubcells; ++r) {
4851     /* TODO Map from coarse to fine cells */
4852     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4853     /* Compress out points not in the section */
4854     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4855     for (p = 0; p < numFPoints*2; p += 2) {
4856       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4857         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4858         if (!dof) continue;
4859         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4860         if (s < q) continue;
4861         ftotpoints[q*2]   = fpoints[p];
4862         ftotpoints[q*2+1] = fpoints[p+1];
4863         ++q;
4864       }
4865     }
4866     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4867   }
4868   numFPoints = q;
4869   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
4870     PetscInt fdof;
4871 
4872     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
4873     if (!dof) continue;
4874     for (f = 0; f < numFields; ++f) {
4875       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
4876       foffsets[f+1] += fdof;
4877     }
4878     numFIndices += dof;
4879   }
4880   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
4881 
4882   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
4883   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
4884   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4885   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4886   if (numFields) {
4887     for (p = 0; p < numFPoints*2; p += 2) {
4888       PetscInt o = ftotpoints[p+1];
4889       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4890       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
4891     }
4892     for (p = 0; p < numCPoints*2; p += 2) {
4893       PetscInt o = cpoints[p+1];
4894       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4895       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
4896     }
4897   } else {
4898     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
4899       PetscInt o = ftotpoints[p+1];
4900       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4901       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
4902     }
4903     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
4904       PetscInt o = cpoints[p+1];
4905       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4906       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
4907     }
4908   }
4909   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
4910   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
4911   if (ierr) {
4912     PetscMPIInt    rank;
4913     PetscErrorCode ierr2;
4914 
4915     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4916     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4917     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
4918     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
4919     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
4920     CHKERRQ(ierr);
4921   }
4922   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4923   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4924   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4925   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4926   PetscFunctionReturn(0);
4927 }
4928 
4929 #undef __FUNCT__
4930 #define __FUNCT__ "DMPlexMatGetClosureIndicesRefined"
4931 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
4932 {
4933   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
4934   PetscInt      *cpoints = NULL;
4935   PetscInt       foffsets[32], coffsets[32];
4936   CellRefiner    cellRefiner;
4937   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4938   PetscErrorCode ierr;
4939 
4940   PetscFunctionBegin;
4941   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4942   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4943   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4944   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4945   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4946   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4947   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4948   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4949   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4950   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4951   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4952   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4953   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4954   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4955   /* Column indices */
4956   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4957   maxFPoints = numCPoints;
4958   /* Compress out points not in the section */
4959   /*   TODO: Squeeze out points with 0 dof as well */
4960   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4961   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4962     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4963       cpoints[q*2]   = cpoints[p];
4964       cpoints[q*2+1] = cpoints[p+1];
4965       ++q;
4966     }
4967   }
4968   numCPoints = q;
4969   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4970     PetscInt fdof;
4971 
4972     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4973     if (!dof) continue;
4974     for (f = 0; f < numFields; ++f) {
4975       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4976       coffsets[f+1] += fdof;
4977     }
4978     numCIndices += dof;
4979   }
4980   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4981   /* Row indices */
4982   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4983   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4984   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4985   for (r = 0, q = 0; r < numSubcells; ++r) {
4986     /* TODO Map from coarse to fine cells */
4987     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4988     /* Compress out points not in the section */
4989     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4990     for (p = 0; p < numFPoints*2; p += 2) {
4991       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4992         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4993         if (!dof) continue;
4994         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4995         if (s < q) continue;
4996         ftotpoints[q*2]   = fpoints[p];
4997         ftotpoints[q*2+1] = fpoints[p+1];
4998         ++q;
4999       }
5000     }
5001     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5002   }
5003   numFPoints = q;
5004   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5005     PetscInt fdof;
5006 
5007     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5008     if (!dof) continue;
5009     for (f = 0; f < numFields; ++f) {
5010       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5011       foffsets[f+1] += fdof;
5012     }
5013     numFIndices += dof;
5014   }
5015   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5016 
5017   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
5018   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
5019   if (numFields) {
5020     for (p = 0; p < numFPoints*2; p += 2) {
5021       PetscInt o = ftotpoints[p+1];
5022       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5023       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
5024     }
5025     for (p = 0; p < numCPoints*2; p += 2) {
5026       PetscInt o = cpoints[p+1];
5027       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5028       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
5029     }
5030   } else {
5031     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
5032       PetscInt o = ftotpoints[p+1];
5033       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5034       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
5035     }
5036     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
5037       PetscInt o = cpoints[p+1];
5038       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5039       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
5040     }
5041   }
5042   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5043   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5044   PetscFunctionReturn(0);
5045 }
5046 
5047 #undef __FUNCT__
5048 #define __FUNCT__ "DMPlexGetHybridBounds"
5049 /*@
5050   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5051 
5052   Input Parameter:
5053 . dm - The DMPlex object
5054 
5055   Output Parameters:
5056 + cMax - The first hybrid cell
5057 . fMax - The first hybrid face
5058 . eMax - The first hybrid edge
5059 - vMax - The first hybrid vertex
5060 
5061   Level: developer
5062 
5063 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
5064 @*/
5065 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5066 {
5067   DM_Plex       *mesh = (DM_Plex*) dm->data;
5068   PetscInt       dim;
5069   PetscErrorCode ierr;
5070 
5071   PetscFunctionBegin;
5072   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5073   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5074   if (cMax) *cMax = mesh->hybridPointMax[dim];
5075   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5076   if (eMax) *eMax = mesh->hybridPointMax[1];
5077   if (vMax) *vMax = mesh->hybridPointMax[0];
5078   PetscFunctionReturn(0);
5079 }
5080 
5081 #undef __FUNCT__
5082 #define __FUNCT__ "DMPlexSetHybridBounds"
5083 /*@
5084   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
5085 
5086   Input Parameters:
5087 . dm   - The DMPlex object
5088 . cMax - The first hybrid cell
5089 . fMax - The first hybrid face
5090 . eMax - The first hybrid edge
5091 - vMax - The first hybrid vertex
5092 
5093   Level: developer
5094 
5095 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
5096 @*/
5097 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5098 {
5099   DM_Plex       *mesh = (DM_Plex*) dm->data;
5100   PetscInt       dim;
5101   PetscErrorCode ierr;
5102 
5103   PetscFunctionBegin;
5104   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5105   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5106   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5107   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5108   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5109   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5110   PetscFunctionReturn(0);
5111 }
5112 
5113 #undef __FUNCT__
5114 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5115 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5116 {
5117   DM_Plex *mesh = (DM_Plex*) dm->data;
5118 
5119   PetscFunctionBegin;
5120   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5121   PetscValidPointer(cellHeight, 2);
5122   *cellHeight = mesh->vtkCellHeight;
5123   PetscFunctionReturn(0);
5124 }
5125 
5126 #undef __FUNCT__
5127 #define __FUNCT__ "DMPlexSetVTKCellHeight"
5128 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5129 {
5130   DM_Plex *mesh = (DM_Plex*) dm->data;
5131 
5132   PetscFunctionBegin;
5133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5134   mesh->vtkCellHeight = cellHeight;
5135   PetscFunctionReturn(0);
5136 }
5137 
5138 #undef __FUNCT__
5139 #define __FUNCT__ "DMPlexCreateNumbering_Private"
5140 /* We can easily have a form that takes an IS instead */
5141 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
5142 {
5143   PetscSection   section, globalSection;
5144   PetscInt      *numbers, p;
5145   PetscErrorCode ierr;
5146 
5147   PetscFunctionBegin;
5148   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
5149   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
5150   for (p = pStart; p < pEnd; ++p) {
5151     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
5152   }
5153   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
5154   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
5155   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
5156   for (p = pStart; p < pEnd; ++p) {
5157     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
5158     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
5159     else                       numbers[p-pStart] += shift;
5160   }
5161   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
5162   if (globalSize) {
5163     PetscLayout layout;
5164     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
5165     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
5166     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
5167   }
5168   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5169   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
5170   PetscFunctionReturn(0);
5171 }
5172 
5173 #undef __FUNCT__
5174 #define __FUNCT__ "DMPlexGetCellNumbering"
5175 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
5176 {
5177   DM_Plex       *mesh = (DM_Plex*) dm->data;
5178   PetscInt       cellHeight, cStart, cEnd, cMax;
5179   PetscErrorCode ierr;
5180 
5181   PetscFunctionBegin;
5182   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5183   if (!mesh->globalCellNumbers) {
5184     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
5185     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5186     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5187     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
5188     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
5189   }
5190   *globalCellNumbers = mesh->globalCellNumbers;
5191   PetscFunctionReturn(0);
5192 }
5193 
5194 #undef __FUNCT__
5195 #define __FUNCT__ "DMPlexGetVertexNumbering"
5196 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
5197 {
5198   DM_Plex       *mesh = (DM_Plex*) dm->data;
5199   PetscInt       vStart, vEnd, vMax;
5200   PetscErrorCode ierr;
5201 
5202   PetscFunctionBegin;
5203   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5204   if (!mesh->globalVertexNumbers) {
5205     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5206     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
5207     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
5208     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
5209   }
5210   *globalVertexNumbers = mesh->globalVertexNumbers;
5211   PetscFunctionReturn(0);
5212 }
5213 
5214 #undef __FUNCT__
5215 #define __FUNCT__ "DMPlexCreatePointNumbering"
5216 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
5217 {
5218   IS             nums[4];
5219   PetscInt       depths[4];
5220   PetscInt       depth, d, shift = 0;
5221   PetscErrorCode ierr;
5222 
5223   PetscFunctionBegin;
5224   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5225   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5226   depths[0] = depth; depths[1] = 0;
5227   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
5228   for (d = 0; d <= depth; ++d) {
5229     PetscInt pStart, pEnd, gsize;
5230 
5231     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
5232     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
5233     shift += gsize;
5234   }
5235   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);
5236   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
5237   PetscFunctionReturn(0);
5238 }
5239 
5240 
5241 #undef __FUNCT__
5242 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
5243 /*@C
5244   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
5245   the local section and an SF describing the section point overlap.
5246 
5247   Input Parameters:
5248   + s - The PetscSection for the local field layout
5249   . sf - The SF describing parallel layout of the section points
5250   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
5251   . label - The label specifying the points
5252   - labelValue - The label stratum specifying the points
5253 
5254   Output Parameter:
5255   . gsection - The PetscSection for the global field layout
5256 
5257   Note: This gives negative sizes and offsets to points not owned by this process
5258 
5259   Level: developer
5260 
5261 .seealso: PetscSectionCreate()
5262 @*/
5263 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
5264 {
5265   PetscInt      *neg = NULL, *tmpOff = NULL;
5266   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
5267   PetscErrorCode ierr;
5268 
5269   PetscFunctionBegin;
5270   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) s), gsection);CHKERRQ(ierr);
5271   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
5272   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
5273   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
5274   if (nroots >= 0) {
5275     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
5276     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
5277     if (nroots > pEnd-pStart) {
5278       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
5279     } else {
5280       tmpOff = &(*gsection)->atlasDof[-pStart];
5281     }
5282   }
5283   /* Mark ghost points with negative dof */
5284   for (p = pStart; p < pEnd; ++p) {
5285     PetscInt value;
5286 
5287     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
5288     if (value != labelValue) continue;
5289     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
5290     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
5291     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
5292     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
5293     if (neg) neg[p] = -(dof+1);
5294   }
5295   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
5296   if (nroots >= 0) {
5297     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5298     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5299     if (nroots > pEnd-pStart) {
5300       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
5301     }
5302   }
5303   /* Calculate new sizes, get proccess offset, and calculate point offsets */
5304   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5305     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
5306     (*gsection)->atlasOff[p] = off;
5307     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
5308   }
5309   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) s));CHKERRQ(ierr);
5310   globalOff -= off;
5311   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5312     (*gsection)->atlasOff[p] += globalOff;
5313     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
5314   }
5315   /* Put in negative offsets for ghost points */
5316   if (nroots >= 0) {
5317     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5318     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5319     if (nroots > pEnd-pStart) {
5320       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
5321     }
5322   }
5323   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
5324   ierr = PetscFree(neg);CHKERRQ(ierr);
5325   PetscFunctionReturn(0);
5326 }
5327 
5328 #undef __FUNCT__
5329 #define __FUNCT__ "DMPlexCheckSymmetry"
5330 /*@
5331   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
5332 
5333   Input Parameters:
5334   + dm - The DMPlex object
5335 
5336   Note: This is a useful diagnostic when creating meshes programmatically.
5337 
5338   Level: developer
5339 
5340 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
5341 @*/
5342 PetscErrorCode DMPlexCheckSymmetry(DM dm)
5343 {
5344   PetscSection    coneSection, supportSection;
5345   const PetscInt *cone, *support;
5346   PetscInt        coneSize, c, supportSize, s;
5347   PetscInt        pStart, pEnd, p, csize, ssize;
5348   PetscErrorCode  ierr;
5349 
5350   PetscFunctionBegin;
5351   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5352   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
5353   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
5354   /* Check that point p is found in the support of its cone points, and vice versa */
5355   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
5356   for (p = pStart; p < pEnd; ++p) {
5357     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
5358     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
5359     for (c = 0; c < coneSize; ++c) {
5360       PetscBool dup = PETSC_FALSE;
5361       PetscInt  d;
5362       for (d = c-1; d >= 0; --d) {
5363         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
5364       }
5365       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
5366       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
5367       for (s = 0; s < supportSize; ++s) {
5368         if (support[s] == p) break;
5369       }
5370       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
5371         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
5372         for (s = 0; s < coneSize; ++s) {
5373           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
5374         }
5375         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5376         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
5377         for (s = 0; s < supportSize; ++s) {
5378           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
5379         }
5380         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5381         if (dup) {
5382           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
5383         } else {
5384           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
5385         }
5386       }
5387     }
5388     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
5389     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
5390     for (s = 0; s < supportSize; ++s) {
5391       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5392       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5393       for (c = 0; c < coneSize; ++c) {
5394         if (cone[c] == p) break;
5395       }
5396       if (c >= coneSize) {
5397         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
5398         for (c = 0; c < supportSize; ++c) {
5399           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
5400         }
5401         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5402         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
5403         for (c = 0; c < coneSize; ++c) {
5404           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
5405         }
5406         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5407         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
5408       }
5409     }
5410   }
5411   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
5412   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
5413   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
5414   PetscFunctionReturn(0);
5415 }
5416 
5417 #undef __FUNCT__
5418 #define __FUNCT__ "DMPlexCheckSkeleton"
5419 /*@
5420   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
5421 
5422   Input Parameters:
5423 + dm - The DMPlex object
5424 . isSimplex - Are the cells simplices or tensor products
5425 - cellHeight - Normally 0
5426 
5427   Note: This is a useful diagnostic when creating meshes programmatically.
5428 
5429   Level: developer
5430 
5431 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
5432 @*/
5433 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5434 {
5435   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
5436   PetscErrorCode ierr;
5437 
5438   PetscFunctionBegin;
5439   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5440   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5441   switch (dim) {
5442   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
5443   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
5444   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
5445   default:
5446     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
5447   }
5448   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5449   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5450   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5451   cMax = cMax >= 0 ? cMax : cEnd;
5452   for (c = cStart; c < cMax; ++c) {
5453     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5454 
5455     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5456     for (cl = 0; cl < closureSize*2; cl += 2) {
5457       const PetscInt p = closure[cl];
5458       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5459     }
5460     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5461     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
5462   }
5463   for (c = cMax; c < cEnd; ++c) {
5464     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5465 
5466     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5467     for (cl = 0; cl < closureSize*2; cl += 2) {
5468       const PetscInt p = closure[cl];
5469       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5470     }
5471     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5472     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
5473   }
5474   PetscFunctionReturn(0);
5475 }
5476 
5477 #undef __FUNCT__
5478 #define __FUNCT__ "DMPlexCheckFaces"
5479 /*@
5480   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
5481 
5482   Input Parameters:
5483 + dm - The DMPlex object
5484 . isSimplex - Are the cells simplices or tensor products
5485 - cellHeight - Normally 0
5486 
5487   Note: This is a useful diagnostic when creating meshes programmatically.
5488 
5489   Level: developer
5490 
5491 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
5492 @*/
5493 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5494 {
5495   PetscInt       pMax[4];
5496   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
5497   PetscErrorCode ierr;
5498 
5499   PetscFunctionBegin;
5500   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5501   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5502   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5503   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
5504   for (h = cellHeight; h < dim; ++h) {
5505     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
5506     for (c = cStart; c < cEnd; ++c) {
5507       const PetscInt *cone, *ornt, *faces;
5508       PetscInt        numFaces, faceSize, coneSize,f;
5509       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
5510 
5511       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
5512       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
5513       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5514       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5515       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5516       for (cl = 0; cl < closureSize*2; cl += 2) {
5517         const PetscInt p = closure[cl];
5518         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
5519       }
5520       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5521       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
5522       for (f = 0; f < numFaces; ++f) {
5523         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
5524 
5525         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5526         for (cl = 0; cl < fclosureSize*2; cl += 2) {
5527           const PetscInt p = fclosure[cl];
5528           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
5529         }
5530         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);
5531         for (v = 0; v < fnumCorners; ++v) {
5532           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]);
5533         }
5534         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5535       }
5536       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5537       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5538     }
5539   }
5540   PetscFunctionReturn(0);
5541 }
5542 
5543 #undef __FUNCT__
5544 #define __FUNCT__ "DMCreateInterpolation_Plex"
5545 /* Pointwise interpolation
5546      Just code FEM for now
5547      u^f = I u^c
5548      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
5549      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
5550      I_{ij} = psi^f_i phi^c_j
5551 */
5552 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
5553 {
5554   PetscSection   gsc, gsf;
5555   PetscInt       m, n;
5556   void          *ctx;
5557   PetscErrorCode ierr;
5558 
5559   PetscFunctionBegin;
5560   /*
5561   Loop over coarse cells
5562     Loop over coarse basis functions
5563       Loop over fine cells in coarse cell
5564         Loop over fine dual basis functions
5565           Evaluate coarse basis on fine dual basis quad points
5566           Sum
5567           Update local element matrix
5568     Accumulate to interpolation matrix
5569 
5570    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
5571   */
5572   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
5573   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
5574   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
5575   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
5576   /* We need to preallocate properly */
5577   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
5578   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
5579   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
5580   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
5581   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
5582   /* Use naive scaling */
5583   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
5584   PetscFunctionReturn(0);
5585 }
5586 
5587 #undef __FUNCT__
5588 #define __FUNCT__ "DMCreateInjection_Plex"
5589 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
5590 {
5591   PetscErrorCode ierr;
5592 
5593   PetscFunctionBegin;
5594   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, ctx, NULL);CHKERRQ(ierr);
5595   PetscFunctionReturn(0);
5596 }
5597 
5598 #undef __FUNCT__
5599 #define __FUNCT__ "DMCreateDefaultSection_Plex"
5600 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
5601 {
5602   PetscSection   section;
5603   IS            *bcPoints;
5604   PetscBool     *isFE;
5605   PetscInt      *bcFields, *numComp, *numDof;
5606   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
5607   PetscInt       cStart, cEnd, cEndInterior;
5608   PetscErrorCode ierr;
5609 
5610   PetscFunctionBegin;
5611   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
5612   /* FE and FV boundary conditions are handled slightly differently */
5613   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
5614   for (f = 0; f < numFields; ++f) {
5615     PetscObject  obj;
5616     PetscClassId id;
5617 
5618     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5619     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
5620     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
5621     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
5622     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
5623   }
5624   /* Allocate boundary point storage */
5625   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5626   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5627   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5628   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
5629   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
5630   for (bd = 0; bd < numBd; ++bd) {
5631     PetscBool isEssential;
5632     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5633     if (isEssential) ++numBC;
5634   }
5635   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
5636   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
5637   /* Constrain ghost cells for FV */
5638   for (f = 0; f < numFields; ++f) {
5639     PetscInt *newidx, c;
5640 
5641     if (isFE[f] || cEndInterior < 0) continue;
5642     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
5643     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
5644     bcFields[bc] = f;
5645     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5646   }
5647   /* Handle FEM Dirichlet boundaries */
5648   for (bd = 0; bd < numBd; ++bd) {
5649     const char     *bdLabel;
5650     DMLabel         label;
5651     const PetscInt *values;
5652     PetscInt        bd2, field, numValues;
5653     PetscBool       isEssential, duplicate = PETSC_FALSE;
5654 
5655     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
5656     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
5657     /* Only want to modify label once */
5658     for (bd2 = 0; bd2 < bd; ++bd2) {
5659       const char *bdname;
5660       ierr = DMPlexGetBoundary(dm, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5661       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
5662       if (duplicate) break;
5663     }
5664     if (!duplicate && (isFE[field])) {
5665       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
5666       ierr = DMPlexLabelAddCells(dm, label);CHKERRQ(ierr);
5667     }
5668     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
5669     if (isEssential) {
5670       PetscInt       *newidx;
5671       PetscInt        n, newn = 0, p, v;
5672 
5673       bcFields[bc] = field;
5674       for (v = 0; v < numValues; ++v) {
5675         IS              tmp;
5676         const PetscInt *idx;
5677 
5678         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5679         if (!tmp) continue;
5680         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5681         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5682         if (isFE[field]) {
5683           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
5684         } else {
5685           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
5686         }
5687         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5688         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5689       }
5690       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
5691       newn = 0;
5692       for (v = 0; v < numValues; ++v) {
5693         IS              tmp;
5694         const PetscInt *idx;
5695 
5696         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5697         if (!tmp) continue;
5698         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5699         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5700         if (isFE[field]) {
5701           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
5702         } else {
5703           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
5704         }
5705         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5706         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5707       }
5708       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5709     }
5710   }
5711   /* Handle discretization */
5712   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
5713   for (f = 0; f < numFields; ++f) {
5714     PetscObject obj;
5715 
5716     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5717     if (isFE[f]) {
5718       PetscFE         fe = (PetscFE) obj;
5719       const PetscInt *numFieldDof;
5720       PetscInt        d;
5721 
5722       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
5723       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
5724       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
5725     } else {
5726       PetscFV fv = (PetscFV) obj;
5727 
5728       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
5729       numDof[f*(dim+1)+dim] = numComp[f];
5730     }
5731   }
5732   for (f = 0; f < numFields; ++f) {
5733     PetscInt d;
5734     for (d = 1; d < dim; ++d) {
5735       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.");
5736     }
5737   }
5738   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, NULL, &section);CHKERRQ(ierr);
5739   for (f = 0; f < numFields; ++f) {
5740     PetscFE     fe;
5741     const char *name;
5742 
5743     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
5744     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
5745     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
5746   }
5747   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
5748   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5749   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
5750   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
5751   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
5752   ierr = PetscFree(isFE);CHKERRQ(ierr);
5753   PetscFunctionReturn(0);
5754 }
5755 
5756 #undef __FUNCT__
5757 #define __FUNCT__ "DMPlexGetCoarseDM"
5758 /*@
5759   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
5760 
5761   Input Parameter:
5762 . dm - The DMPlex object
5763 
5764   Output Parameter:
5765 . cdm - The coarse DM
5766 
5767   Level: intermediate
5768 
5769 .seealso: DMPlexSetCoarseDM()
5770 @*/
5771 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
5772 {
5773   PetscFunctionBegin;
5774   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5775   PetscValidPointer(cdm, 2);
5776   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
5777   PetscFunctionReturn(0);
5778 }
5779 
5780 #undef __FUNCT__
5781 #define __FUNCT__ "DMPlexSetCoarseDM"
5782 /*@
5783   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
5784 
5785   Input Parameters:
5786 + dm - The DMPlex object
5787 - cdm - The coarse DM
5788 
5789   Level: intermediate
5790 
5791 .seealso: DMPlexGetCoarseDM()
5792 @*/
5793 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
5794 {
5795   DM_Plex       *mesh;
5796   PetscErrorCode ierr;
5797 
5798   PetscFunctionBegin;
5799   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5800   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
5801   mesh = (DM_Plex *) dm->data;
5802   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
5803   mesh->coarseMesh = cdm;
5804   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
5805   PetscFunctionReturn(0);
5806 }
5807 
5808 /* anchors */
5809 #undef __FUNCT__
5810 #define __FUNCT__ "DMPlexGetAnchors"
5811 /*@
5812   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
5813   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
5814 
5815   not collective
5816 
5817   Input Parameters:
5818 . dm - The DMPlex object
5819 
5820   Output Parameters:
5821 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
5822 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
5823 
5824 
5825   Level: intermediate
5826 
5827 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
5828 @*/
5829 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
5830 {
5831   DM_Plex *plex = (DM_Plex *)dm->data;
5832   PetscErrorCode ierr;
5833 
5834   PetscFunctionBegin;
5835   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5836   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
5837   if (anchorSection) *anchorSection = plex->anchorSection;
5838   if (anchorIS) *anchorIS = plex->anchorIS;
5839   PetscFunctionReturn(0);
5840 }
5841 
5842 #undef __FUNCT__
5843 #define __FUNCT__ "DMPlexSetAnchors"
5844 /*@
5845   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
5846   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
5847   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
5848 
5849   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
5850   DMGetConstraints() and filling in the entries in the constraint matrix.
5851 
5852   collective on dm
5853 
5854   Input Parameters:
5855 + dm - The DMPlex object
5856 . 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).
5857 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
5858 
5859   The reference counts of anchorSection and anchorIS are incremented.
5860 
5861   Level: intermediate
5862 
5863 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
5864 @*/
5865 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
5866 {
5867   DM_Plex *plex = (DM_Plex *)dm->data;
5868   PetscMPIInt result;
5869   PetscErrorCode ierr;
5870 
5871   PetscFunctionBegin;
5872   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5873   if (anchorSection) {
5874     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
5875     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
5876     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
5877   }
5878   if (anchorIS) {
5879     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
5880     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
5881     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
5882   }
5883 
5884   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
5885   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
5886   plex->anchorSection = anchorSection;
5887 
5888   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
5889   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
5890   plex->anchorIS = anchorIS;
5891 
5892 #if defined(PETSC_USE_DEBUG)
5893   if (anchorIS && anchorSection) {
5894     PetscInt size, a, pStart, pEnd;
5895     const PetscInt *anchors;
5896 
5897     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5898     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
5899     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
5900     for (a = 0; a < size; a++) {
5901       PetscInt p;
5902 
5903       p = anchors[a];
5904       if (p >= pStart && p < pEnd) {
5905         PetscInt dof;
5906 
5907         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5908         if (dof) {
5909           PetscErrorCode ierr2;
5910 
5911           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
5912           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %d cannot be constrained and an anchor",p);
5913         }
5914       }
5915     }
5916     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
5917   }
5918 #endif
5919   /* reset the generic constraints */
5920   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
5921   PetscFunctionReturn(0);
5922 }
5923 
5924 #undef __FUNCT__
5925 #define __FUNCT__ "DMPlexCreateConstraintSection_Anchors"
5926 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
5927 {
5928   PetscSection anchorSection;
5929   PetscInt pStart, pEnd, p, dof, numFields, f;
5930   PetscErrorCode ierr;
5931 
5932   PetscFunctionBegin;
5933   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5934   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
5935   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
5936   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5937   ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
5938   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5939   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
5940   for (p = pStart; p < pEnd; p++) {
5941     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5942     if (dof) {
5943       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
5944       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
5945       for (f = 0; f < numFields; f++) {
5946         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
5947         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
5948       }
5949     }
5950   }
5951   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
5952   PetscFunctionReturn(0);
5953 }
5954 
5955 #undef __FUNCT__
5956 #define __FUNCT__ "DMPlexCreateConstraintMatrix_Anchors"
5957 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
5958 {
5959   PetscSection aSec;
5960   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
5961   const PetscInt *anchors;
5962   PetscInt numFields, f;
5963   IS aIS;
5964   PetscErrorCode ierr;
5965 
5966   PetscFunctionBegin;
5967   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5968   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
5969   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
5970   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
5971   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
5972   ierr = MatSetType(*cMat,MATSEQAIJ);
5973   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
5974   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5975   ierr = PetscSectionGetChart(aSec,&pStart,&pEnd);CHKERRQ(ierr);
5976   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
5977   i[0] = 0;
5978   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5979   for (p = pStart; p < pEnd; p++) {
5980     ierr = PetscSectionGetDof(aSec,p,&dof);CHKERRQ(ierr);
5981     if (!dof) continue;
5982     ierr = PetscSectionGetOffset(aSec,p,&off);CHKERRQ(ierr);
5983     if (numFields) {
5984       for (f = 0; f < numFields; f++) {
5985         annz = 0;
5986         for (q = 0; q < dof; q++) {
5987           a = anchors[off + q];
5988           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
5989           annz += aDof;
5990         }
5991         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
5992         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
5993         for (q = 0; q < dof; q++) {
5994           i[off + q + 1] = i[off + q] + annz;
5995         }
5996       }
5997     }
5998     else {
5999       annz = 0;
6000       for (q = 0; q < dof; q++) {
6001         a = anchors[off + q];
6002         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6003         annz += aDof;
6004       }
6005       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6006       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
6007       for (q = 0; q < dof; q++) {
6008         i[off + q + 1] = i[off + q] + annz;
6009       }
6010     }
6011   }
6012   nnz = i[m];
6013   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
6014   offset = 0;
6015   for (p = pStart; p < pEnd; p++) {
6016     if (numFields) {
6017       for (f = 0; f < numFields; f++) {
6018         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6019         for (q = 0; q < dof; q++) {
6020           PetscInt rDof, rOff, r;
6021           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6022           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6023           for (r = 0; r < rDof; r++) {
6024             PetscInt s;
6025 
6026             a = anchors[rOff + r];
6027 
6028             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6029             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
6030             for (s = 0; s < aDof; s++) {
6031               j[offset++] = aOff + s;
6032             }
6033           }
6034         }
6035       }
6036     }
6037     else {
6038       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6039       for (q = 0; q < dof; q++) {
6040         PetscInt rDof, rOff, r;
6041         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6042         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6043         for (r = 0; r < rDof; r++) {
6044           PetscInt s;
6045 
6046           a = anchors[rOff + r];
6047 
6048           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6049           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
6050           for (s = 0; s < aDof; s++) {
6051             j[offset++] = aOff + s;
6052           }
6053         }
6054       }
6055     }
6056   }
6057   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
6058   ierr = PetscFree2(i,j);CHKERRQ(ierr);
6059   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
6060   PetscFunctionReturn(0);
6061 }
6062 
6063 #undef __FUNCT__
6064 #define __FUNCT__ "DMCreateDefaultConstraints_Plex"
6065 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
6066 {
6067   DM_Plex        *plex = (DM_Plex *)dm->data;
6068   PetscSection   anchorSection, section, cSec;
6069   Mat            cMat;
6070   PetscErrorCode ierr;
6071 
6072   PetscFunctionBegin;
6073   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6074   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
6075   if (anchorSection) {
6076     PetscDS  ds;
6077     PetscInt nf;
6078 
6079     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
6080     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
6081     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
6082     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
6083     ierr = PetscDSGetNumFields(ds,&nf);
6084     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
6085     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
6086     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
6087     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
6088   }
6089   PetscFunctionReturn(0);
6090 }
6091