xref: /petsc/src/dm/impls/plex/plex.c (revision 84961fc4fc4a46e3b2f3a646ca2b61bc0ce370e6)
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, PETSCPARTITIONER_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeOverlap, 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 \\vbox{\n");CHKERRQ(ierr);
281     ierr = PetscViewerASCIIPrintf(viewer, "%s for process ", name);CHKERRQ(ierr);
282     for (p = 0; p < size; ++p) {
283       if (p > 0 && p == size-1) {
284         ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
285       } else if (p > 0) {
286         ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
287       }
288       ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
289     }
290     ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n\
291 \\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n", 8.0/scale);CHKERRQ(ierr);
292     /* Plot vertices */
293     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
294     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
295     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
296     for (v = vStart; v < vEnd; ++v) {
297       PetscInt off, dof, d;
298 
299       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
300       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
301       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
302       for (d = 0; d < dof; ++d) {
303         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
304         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*PetscRealPart(coords[off+d])));CHKERRQ(ierr);
305       }
306       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", v, rank, colors[rank%numColors], v);CHKERRQ(ierr);
307     }
308     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
309     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
310     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
311     /* Plot edges */
312     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
313     ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
314     if (depth > 1) {ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);}
315     for (e = eStart; e < eEnd; ++e) {
316       const PetscInt *cone;
317       PetscInt        coneSize, offA, offB, dof, d;
318 
319       ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
320       if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %d cone should have two vertices, not %d", e, coneSize);
321       ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
322       ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
323       ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
324       ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
325       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
326       for (d = 0; d < dof; ++d) {
327         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
328         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)(scale*0.5*PetscRealPart(coords[offA+d]+coords[offB+d])));CHKERRQ(ierr);
329       }
330       ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%D) [draw,shape=circle,color=%s] {%D} --\n", e, rank, colors[rank%numColors], e);CHKERRQ(ierr);
331     }
332     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
333     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
334     ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
335     /* Plot cells */
336     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
337     for (c = cStart; c < cEnd; ++c) {
338       PetscInt *closure = NULL;
339       PetscInt  closureSize, firstPoint = -1;
340 
341       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
342       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
343       for (p = 0; p < closureSize*2; p += 2) {
344         const PetscInt point = closure[p];
345 
346         if ((point < vStart) || (point >= vEnd)) continue;
347         if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
348         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%D)", point, rank);CHKERRQ(ierr);
349         if (firstPoint < 0) firstPoint = point;
350       }
351       /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
352       ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%D);\n", firstPoint, rank);CHKERRQ(ierr);
353       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
354     }
355     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
356     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n}\n");CHKERRQ(ierr);
357     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
358   } else {
359     MPI_Comm    comm;
360     PetscInt   *sizes, *hybsizes;
361     PetscInt    locDepth, depth, dim, d, pMax[4];
362     PetscInt    pStart, pEnd, p;
363     PetscInt    numLabels, l;
364     const char *name;
365     PetscMPIInt size;
366 
367     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
368     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
369     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
370     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
371     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimensions:\n", name, dim);CHKERRQ(ierr);}
372     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimensions:\n", dim);CHKERRQ(ierr);}
373     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
374     ierr = MPI_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
375     ierr = DMPlexGetHybridBounds(dm, &pMax[depth], depth > 0 ? &pMax[depth-1] : NULL, &pMax[1], &pMax[0]);CHKERRQ(ierr);
376     ierr = PetscMalloc2(size,&sizes,size,&hybsizes);CHKERRQ(ierr);
377     if (depth == 1) {
378       ierr = DMPlexGetDepthStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
379       pEnd = pEnd - pStart;
380       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
381       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", 0);CHKERRQ(ierr);
382       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
383       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
384       ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
385       pEnd = pEnd - pStart;
386       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
387       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", dim);CHKERRQ(ierr);
388       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
389       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
390     } else {
391       for (d = 0; d <= dim; d++) {
392         ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
393         pEnd    -= pStart;
394         pMax[d] -= pStart;
395         ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
396         ierr = MPI_Gather(&pMax[d], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
397         ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", d);CHKERRQ(ierr);
398         for (p = 0; p < size; ++p) {
399           if (hybsizes[p] >= 0) {ierr = PetscViewerASCIIPrintf(viewer, " %D (%D)", sizes[p], sizes[p] - hybsizes[p]);CHKERRQ(ierr);}
400           else                  {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
401         }
402         ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
403       }
404     }
405     ierr = PetscFree2(sizes,hybsizes);CHKERRQ(ierr);
406     ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
407     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
408     for (l = 0; l < numLabels; ++l) {
409       DMLabel         label;
410       const char     *name;
411       IS              valueIS;
412       const PetscInt *values;
413       PetscInt        numValues, v;
414 
415       ierr = DMPlexGetLabelName(dm, l, &name);CHKERRQ(ierr);
416       ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
417       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
418       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %d strata of sizes (", name, numValues);CHKERRQ(ierr);
419       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
420       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
421       for (v = 0; v < numValues; ++v) {
422         PetscInt size;
423 
424         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
425         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
426         ierr = PetscViewerASCIIPrintf(viewer, "%d", size);CHKERRQ(ierr);
427       }
428       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
429       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
430       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
431     }
432   }
433   PetscFunctionReturn(0);
434 }
435 
436 #undef __FUNCT__
437 #define __FUNCT__ "DMView_Plex"
438 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
439 {
440   PetscBool      iascii, ishdf5, isvtk;
441   PetscErrorCode ierr;
442 
443   PetscFunctionBegin;
444   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
445   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
446   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
447   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
448   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
449   if (iascii) {
450     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
451   } else if (ishdf5) {
452 #if defined(PETSC_HAVE_HDF5)
453     ierr = PetscViewerPushFormat(viewer, PETSC_VIEWER_HDF5_VIZ);CHKERRQ(ierr);
454     ierr = DMPlexView_HDF5(dm, viewer);CHKERRQ(ierr);
455     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
456 #else
457     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
458 #endif
459   }
460   else if (isvtk) {
461     ierr = DMPlexVTKWriteAll((PetscObject) dm,viewer);CHKERRQ(ierr);
462   }
463   PetscFunctionReturn(0);
464 }
465 
466 #undef __FUNCT__
467 #define __FUNCT__ "DMLoad_Plex"
468 PetscErrorCode DMLoad_Plex(DM dm, PetscViewer viewer)
469 {
470   PetscBool      isbinary, ishdf5;
471   PetscErrorCode ierr;
472 
473   PetscFunctionBegin;
474   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
475   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
476   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
477   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,   &ishdf5);CHKERRQ(ierr);
478   if (isbinary) {SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Do not yet support binary viewers");}
479   else if (ishdf5) {
480 #if defined(PETSC_HAVE_HDF5)
481     ierr = DMPlexLoad_HDF5(dm, viewer);CHKERRQ(ierr);
482 #else
483     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
484 #endif
485   }
486   PetscFunctionReturn(0);
487 }
488 
489 #undef __FUNCT__
490 #define __FUNCT__ "BoundaryDestroy"
491 static PetscErrorCode BoundaryDestroy(DMBoundary *boundary)
492 {
493   DMBoundary     b, next;
494   PetscErrorCode ierr;
495 
496   PetscFunctionBegin;
497   if (!boundary) PetscFunctionReturn(0);
498   b = *boundary;
499   *boundary = NULL;
500   for (; b; b = next) {
501     next = b->next;
502     ierr = PetscFree(b->ids);CHKERRQ(ierr);
503     ierr = PetscFree(b->name);CHKERRQ(ierr);
504     ierr = PetscFree(b->labelname);CHKERRQ(ierr);
505     ierr = PetscFree(b);CHKERRQ(ierr);
506   }
507   PetscFunctionReturn(0);
508 }
509 
510 #undef __FUNCT__
511 #define __FUNCT__ "DMDestroy_Plex"
512 PetscErrorCode DMDestroy_Plex(DM dm)
513 {
514   DM_Plex       *mesh = (DM_Plex*) dm->data;
515   PlexLabel      next = mesh->labels;
516   PetscErrorCode ierr;
517 
518   PetscFunctionBegin;
519   if (--mesh->refct > 0) PetscFunctionReturn(0);
520   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
521   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
522   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
523   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
524   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
525   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
526   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
527   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
528   ierr = PetscPartitionerDestroy(&mesh->partitioner);CHKERRQ(ierr);
529   while (next) {
530     PlexLabel tmp = next->next;
531 
532     ierr = DMLabelDestroy(&next->label);CHKERRQ(ierr);
533     ierr = PetscFree(next);CHKERRQ(ierr);
534     next = tmp;
535   }
536   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
537   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
538   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
539   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
540   ierr = BoundaryDestroy(&mesh->boundary);CHKERRQ(ierr);
541   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
542   ierr = ISDestroy(&mesh->anchorIS);CHKERRQ(ierr);
543   ierr = PetscSectionDestroy(&mesh->parentSection);CHKERRQ(ierr);
544   ierr = PetscFree(mesh->parents);CHKERRQ(ierr);
545   ierr = PetscFree(mesh->childIDs);CHKERRQ(ierr);
546   ierr = PetscSectionDestroy(&mesh->childSection);CHKERRQ(ierr);
547   ierr = PetscFree(mesh->children);CHKERRQ(ierr);
548   ierr = DMDestroy(&mesh->referenceTree);CHKERRQ(ierr);
549   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
550   ierr = PetscFree(mesh);CHKERRQ(ierr);
551   PetscFunctionReturn(0);
552 }
553 
554 #undef __FUNCT__
555 #define __FUNCT__ "DMCreateMatrix_Plex"
556 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
557 {
558   PetscSection   section, sectionGlobal;
559   PetscInt       bs = -1;
560   PetscInt       localSize;
561   PetscBool      isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock;
562   PetscErrorCode ierr;
563   MatType        mtype;
564 
565   PetscFunctionBegin;
566   ierr = MatInitializePackage();CHKERRQ(ierr);
567   mtype = dm->mattype;
568   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
569   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
570   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
571   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
572   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
573   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
574   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
575   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
576   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
577   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
578   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
579   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
580   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
581   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
582   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
583   if (!isShell) {
584     PetscBool fillMatrix = (PetscBool) !dm->prealloc_only;
585     PetscInt *dnz, *onz, *dnzu, *onzu, bsLocal, bsMax, bsMin;
586 
587     if (bs < 0) {
588       if (isBlock || isSeqBlock || isMPIBlock || isSymBlock || isSymSeqBlock || isSymMPIBlock) {
589         PetscInt pStart, pEnd, p, dof, cdof;
590 
591         ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
592         for (p = pStart; p < pEnd; ++p) {
593           ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
594           ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
595           if (dof-cdof) {
596             if (bs < 0) {
597               bs = dof-cdof;
598             } else if (bs != dof-cdof) {
599               /* Layout does not admit a pointwise block size */
600               bs = 1;
601               break;
602             }
603           }
604         }
605         /* Must have same blocksize on all procs (some might have no points) */
606         bsLocal = bs;
607         ierr = MPI_Allreduce(&bsLocal, &bsMax, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
608         bsLocal = bs < 0 ? bsMax : bs;
609         ierr = MPI_Allreduce(&bsLocal, &bsMin, 1, MPIU_INT, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
610         if (bsMin != bsMax) {
611           bs = 1;
612         } else {
613           bs = bsMax;
614         }
615       } else {
616         bs = 1;
617       }
618     }
619     ierr = PetscCalloc4(localSize/bs, &dnz, localSize/bs, &onz, localSize/bs, &dnzu, localSize/bs, &onzu);CHKERRQ(ierr);
620     ierr = DMPlexPreallocateOperator(dm, bs, section, sectionGlobal, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
621     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
622   }
623   PetscFunctionReturn(0);
624 }
625 
626 #undef __FUNCT__
627 #define __FUNCT__ "DMPlexGetChart"
628 /*@
629   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
630 
631   Not collective
632 
633   Input Parameter:
634 . mesh - The DMPlex
635 
636   Output Parameters:
637 + pStart - The first mesh point
638 - pEnd   - The upper bound for mesh points
639 
640   Level: beginner
641 
642 .seealso: DMPlexCreate(), DMPlexSetChart()
643 @*/
644 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
645 {
646   DM_Plex       *mesh = (DM_Plex*) dm->data;
647   PetscErrorCode ierr;
648 
649   PetscFunctionBegin;
650   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
651   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
652   PetscFunctionReturn(0);
653 }
654 
655 #undef __FUNCT__
656 #define __FUNCT__ "DMPlexSetChart"
657 /*@
658   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
659 
660   Not collective
661 
662   Input Parameters:
663 + mesh - The DMPlex
664 . pStart - The first mesh point
665 - pEnd   - The upper bound for mesh points
666 
667   Output Parameters:
668 
669   Level: beginner
670 
671 .seealso: DMPlexCreate(), DMPlexGetChart()
672 @*/
673 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
674 {
675   DM_Plex       *mesh = (DM_Plex*) dm->data;
676   PetscErrorCode ierr;
677 
678   PetscFunctionBegin;
679   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
680   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
681   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
682   PetscFunctionReturn(0);
683 }
684 
685 #undef __FUNCT__
686 #define __FUNCT__ "DMPlexGetConeSize"
687 /*@
688   DMPlexGetConeSize - Return the number of in-edges for this point in the Sieve DAG
689 
690   Not collective
691 
692   Input Parameters:
693 + mesh - The DMPlex
694 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
695 
696   Output Parameter:
697 . size - The cone size for point p
698 
699   Level: beginner
700 
701 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
702 @*/
703 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
704 {
705   DM_Plex       *mesh = (DM_Plex*) dm->data;
706   PetscErrorCode ierr;
707 
708   PetscFunctionBegin;
709   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
710   PetscValidPointer(size, 3);
711   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
712   PetscFunctionReturn(0);
713 }
714 
715 #undef __FUNCT__
716 #define __FUNCT__ "DMPlexSetConeSize"
717 /*@
718   DMPlexSetConeSize - Set the number of in-edges for this point in the Sieve DAG
719 
720   Not collective
721 
722   Input Parameters:
723 + mesh - The DMPlex
724 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
725 - size - The cone size for point p
726 
727   Output Parameter:
728 
729   Note:
730   This should be called after DMPlexSetChart().
731 
732   Level: beginner
733 
734 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
735 @*/
736 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
737 {
738   DM_Plex       *mesh = (DM_Plex*) dm->data;
739   PetscErrorCode ierr;
740 
741   PetscFunctionBegin;
742   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
743   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
744 
745   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
746   PetscFunctionReturn(0);
747 }
748 
749 #undef __FUNCT__
750 #define __FUNCT__ "DMPlexAddConeSize"
751 /*@
752   DMPlexAddConeSize - Add the given number of in-edges to this point in the Sieve DAG
753 
754   Not collective
755 
756   Input Parameters:
757 + mesh - The DMPlex
758 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
759 - size - The additional cone size for point p
760 
761   Output Parameter:
762 
763   Note:
764   This should be called after DMPlexSetChart().
765 
766   Level: beginner
767 
768 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexGetConeSize(), DMPlexSetChart()
769 @*/
770 PetscErrorCode DMPlexAddConeSize(DM dm, PetscInt p, PetscInt size)
771 {
772   DM_Plex       *mesh = (DM_Plex*) dm->data;
773   PetscInt       csize;
774   PetscErrorCode ierr;
775 
776   PetscFunctionBegin;
777   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
778   ierr = PetscSectionAddDof(mesh->coneSection, p, size);CHKERRQ(ierr);
779   ierr = PetscSectionGetDof(mesh->coneSection, p, &csize);CHKERRQ(ierr);
780 
781   mesh->maxConeSize = PetscMax(mesh->maxConeSize, csize);
782   PetscFunctionReturn(0);
783 }
784 
785 #undef __FUNCT__
786 #define __FUNCT__ "DMPlexGetCone"
787 /*@C
788   DMPlexGetCone - Return the points on the in-edges for this point in the Sieve DAG
789 
790   Not collective
791 
792   Input Parameters:
793 + mesh - The DMPlex
794 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
795 
796   Output Parameter:
797 . cone - An array of points which are on the in-edges for point p
798 
799   Level: beginner
800 
801   Fortran Notes:
802   Since it returns an array, this routine is only available in Fortran 90, and you must
803   include petsc.h90 in your code.
804 
805   You must also call DMPlexRestoreCone() after you finish using the returned array.
806 
807 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart()
808 @*/
809 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
810 {
811   DM_Plex       *mesh = (DM_Plex*) dm->data;
812   PetscInt       off;
813   PetscErrorCode ierr;
814 
815   PetscFunctionBegin;
816   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
817   PetscValidPointer(cone, 3);
818   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
819   *cone = &mesh->cones[off];
820   PetscFunctionReturn(0);
821 }
822 
823 #undef __FUNCT__
824 #define __FUNCT__ "DMPlexSetCone"
825 /*@
826   DMPlexSetCone - Set the points on the in-edges for this point in the Sieve DAG
827 
828   Not collective
829 
830   Input Parameters:
831 + mesh - The DMPlex
832 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
833 - cone - An array of points which are on the in-edges for point p
834 
835   Output Parameter:
836 
837   Note:
838   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
839 
840   Level: beginner
841 
842 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
843 @*/
844 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
845 {
846   DM_Plex       *mesh = (DM_Plex*) dm->data;
847   PetscInt       pStart, pEnd;
848   PetscInt       dof, off, c;
849   PetscErrorCode ierr;
850 
851   PetscFunctionBegin;
852   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
853   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
854   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
855   if (dof) PetscValidPointer(cone, 3);
856   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
857   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);
858   for (c = 0; c < dof; ++c) {
859     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);
860     mesh->cones[off+c] = cone[c];
861   }
862   PetscFunctionReturn(0);
863 }
864 
865 #undef __FUNCT__
866 #define __FUNCT__ "DMPlexGetConeOrientation"
867 /*@C
868   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the Sieve DAG
869 
870   Not collective
871 
872   Input Parameters:
873 + mesh - The DMPlex
874 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
875 
876   Output Parameter:
877 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
878                     integer giving the prescription for cone traversal. If it is negative, the cone is
879                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
880                     the index of the cone point on which to start.
881 
882   Level: beginner
883 
884   Fortran Notes:
885   Since it returns an array, this routine is only available in Fortran 90, and you must
886   include petsc.h90 in your code.
887 
888   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
889 
890 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
891 @*/
892 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
893 {
894   DM_Plex       *mesh = (DM_Plex*) dm->data;
895   PetscInt       off;
896   PetscErrorCode ierr;
897 
898   PetscFunctionBegin;
899   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
900 #if defined(PETSC_USE_DEBUG)
901   {
902     PetscInt dof;
903     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
904     if (dof) PetscValidPointer(coneOrientation, 3);
905   }
906 #endif
907   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
908 
909   *coneOrientation = &mesh->coneOrientations[off];
910   PetscFunctionReturn(0);
911 }
912 
913 #undef __FUNCT__
914 #define __FUNCT__ "DMPlexSetConeOrientation"
915 /*@
916   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the Sieve DAG
917 
918   Not collective
919 
920   Input Parameters:
921 + mesh - The DMPlex
922 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
923 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
924                     integer giving the prescription for cone traversal. If it is negative, the cone is
925                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
926                     the index of the cone point on which to start.
927 
928   Output Parameter:
929 
930   Note:
931   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
932 
933   Level: beginner
934 
935 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
936 @*/
937 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
938 {
939   DM_Plex       *mesh = (DM_Plex*) dm->data;
940   PetscInt       pStart, pEnd;
941   PetscInt       dof, off, c;
942   PetscErrorCode ierr;
943 
944   PetscFunctionBegin;
945   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
946   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
947   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
948   if (dof) PetscValidPointer(coneOrientation, 3);
949   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
950   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);
951   for (c = 0; c < dof; ++c) {
952     PetscInt cdof, o = coneOrientation[c];
953 
954     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
955     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);
956     mesh->coneOrientations[off+c] = o;
957   }
958   PetscFunctionReturn(0);
959 }
960 
961 #undef __FUNCT__
962 #define __FUNCT__ "DMPlexInsertCone"
963 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
964 {
965   DM_Plex       *mesh = (DM_Plex*) dm->data;
966   PetscInt       pStart, pEnd;
967   PetscInt       dof, off;
968   PetscErrorCode ierr;
969 
970   PetscFunctionBegin;
971   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
972   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
973   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);
974   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);
975   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
976   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
977   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);
978   mesh->cones[off+conePos] = conePoint;
979   PetscFunctionReturn(0);
980 }
981 
982 #undef __FUNCT__
983 #define __FUNCT__ "DMPlexInsertConeOrientation"
984 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
985 {
986   DM_Plex       *mesh = (DM_Plex*) dm->data;
987   PetscInt       pStart, pEnd;
988   PetscInt       dof, off;
989   PetscErrorCode ierr;
990 
991   PetscFunctionBegin;
992   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
993   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
994   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);
995   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
996   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
997   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);
998   mesh->coneOrientations[off+conePos] = coneOrientation;
999   PetscFunctionReturn(0);
1000 }
1001 
1002 #undef __FUNCT__
1003 #define __FUNCT__ "DMPlexGetSupportSize"
1004 /*@
1005   DMPlexGetSupportSize - Return the number of out-edges for this point in the Sieve DAG
1006 
1007   Not collective
1008 
1009   Input Parameters:
1010 + mesh - The DMPlex
1011 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1012 
1013   Output Parameter:
1014 . size - The support size for point p
1015 
1016   Level: beginner
1017 
1018 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
1019 @*/
1020 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
1021 {
1022   DM_Plex       *mesh = (DM_Plex*) dm->data;
1023   PetscErrorCode ierr;
1024 
1025   PetscFunctionBegin;
1026   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1027   PetscValidPointer(size, 3);
1028   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1029   PetscFunctionReturn(0);
1030 }
1031 
1032 #undef __FUNCT__
1033 #define __FUNCT__ "DMPlexSetSupportSize"
1034 /*@
1035   DMPlexSetSupportSize - Set the number of out-edges for this point in the Sieve DAG
1036 
1037   Not collective
1038 
1039   Input Parameters:
1040 + mesh - The DMPlex
1041 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1042 - size - The support size for point p
1043 
1044   Output Parameter:
1045 
1046   Note:
1047   This should be called after DMPlexSetChart().
1048 
1049   Level: beginner
1050 
1051 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
1052 @*/
1053 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
1054 {
1055   DM_Plex       *mesh = (DM_Plex*) dm->data;
1056   PetscErrorCode ierr;
1057 
1058   PetscFunctionBegin;
1059   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1060   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1061 
1062   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
1063   PetscFunctionReturn(0);
1064 }
1065 
1066 #undef __FUNCT__
1067 #define __FUNCT__ "DMPlexGetSupport"
1068 /*@C
1069   DMPlexGetSupport - Return the points on the out-edges for this point in the Sieve DAG
1070 
1071   Not collective
1072 
1073   Input Parameters:
1074 + mesh - The DMPlex
1075 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1076 
1077   Output Parameter:
1078 . support - An array of points which are on the out-edges for point p
1079 
1080   Level: beginner
1081 
1082   Fortran Notes:
1083   Since it returns an array, this routine is only available in Fortran 90, and you must
1084   include petsc.h90 in your code.
1085 
1086   You must also call DMPlexRestoreSupport() after you finish using the returned array.
1087 
1088 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1089 @*/
1090 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
1091 {
1092   DM_Plex       *mesh = (DM_Plex*) dm->data;
1093   PetscInt       off;
1094   PetscErrorCode ierr;
1095 
1096   PetscFunctionBegin;
1097   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1098   PetscValidPointer(support, 3);
1099   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1100   *support = &mesh->supports[off];
1101   PetscFunctionReturn(0);
1102 }
1103 
1104 #undef __FUNCT__
1105 #define __FUNCT__ "DMPlexSetSupport"
1106 /*@
1107   DMPlexSetSupport - Set the points on the out-edges for this point in the Sieve DAG
1108 
1109   Not collective
1110 
1111   Input Parameters:
1112 + mesh - The DMPlex
1113 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1114 - support - An array of points which are on the in-edges for point p
1115 
1116   Output Parameter:
1117 
1118   Note:
1119   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
1120 
1121   Level: beginner
1122 
1123 .seealso: DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
1124 @*/
1125 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
1126 {
1127   DM_Plex       *mesh = (DM_Plex*) dm->data;
1128   PetscInt       pStart, pEnd;
1129   PetscInt       dof, off, c;
1130   PetscErrorCode ierr;
1131 
1132   PetscFunctionBegin;
1133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1134   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1135   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1136   if (dof) PetscValidPointer(support, 3);
1137   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1138   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);
1139   for (c = 0; c < dof; ++c) {
1140     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);
1141     mesh->supports[off+c] = support[c];
1142   }
1143   PetscFunctionReturn(0);
1144 }
1145 
1146 #undef __FUNCT__
1147 #define __FUNCT__ "DMPlexInsertSupport"
1148 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
1149 {
1150   DM_Plex       *mesh = (DM_Plex*) dm->data;
1151   PetscInt       pStart, pEnd;
1152   PetscInt       dof, off;
1153   PetscErrorCode ierr;
1154 
1155   PetscFunctionBegin;
1156   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1157   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1158   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1159   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1160   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);
1161   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);
1162   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);
1163   mesh->supports[off+supportPos] = supportPoint;
1164   PetscFunctionReturn(0);
1165 }
1166 
1167 #undef __FUNCT__
1168 #define __FUNCT__ "DMPlexGetTransitiveClosure"
1169 /*@C
1170   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1171 
1172   Not collective
1173 
1174   Input Parameters:
1175 + mesh - The DMPlex
1176 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1177 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1178 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1179 
1180   Output Parameters:
1181 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1182 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1183 
1184   Note:
1185   If using internal storage (points is NULL on input), each call overwrites the last output.
1186 
1187   Fortran Notes:
1188   Since it returns an array, this routine is only available in Fortran 90, and you must
1189   include petsc.h90 in your code.
1190 
1191   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1192 
1193   Level: beginner
1194 
1195 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1196 @*/
1197 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1198 {
1199   DM_Plex        *mesh = (DM_Plex*) dm->data;
1200   PetscInt       *closure, *fifo;
1201   const PetscInt *tmp = NULL, *tmpO = NULL;
1202   PetscInt        tmpSize, t;
1203   PetscInt        depth       = 0, maxSize;
1204   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1205   PetscErrorCode  ierr;
1206 
1207   PetscFunctionBegin;
1208   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1209   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1210   /* This is only 1-level */
1211   if (useCone) {
1212     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1213     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1214     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1215   } else {
1216     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1217     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1218   }
1219   if (depth == 1) {
1220     if (*points) {
1221       closure = *points;
1222     } else {
1223       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1224       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1225     }
1226     closure[0] = p; closure[1] = 0;
1227     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1228       closure[closureSize]   = tmp[t];
1229       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
1230     }
1231     if (numPoints) *numPoints = closureSize/2;
1232     if (points)    *points    = closure;
1233     PetscFunctionReturn(0);
1234   }
1235   {
1236     PetscInt c, coneSeries, s,supportSeries;
1237 
1238     c = mesh->maxConeSize;
1239     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
1240     s = mesh->maxSupportSize;
1241     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
1242     maxSize = 2*PetscMax(coneSeries,supportSeries);
1243   }
1244   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1245   if (*points) {
1246     closure = *points;
1247   } else {
1248     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1249   }
1250   closure[0] = p; closure[1] = 0;
1251   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1252     const PetscInt cp = tmp[t];
1253     const PetscInt co = tmpO ? tmpO[t] : 0;
1254 
1255     closure[closureSize]   = cp;
1256     closure[closureSize+1] = co;
1257     fifo[fifoSize]         = cp;
1258     fifo[fifoSize+1]       = co;
1259   }
1260   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1261   while (fifoSize - fifoStart) {
1262     const PetscInt q   = fifo[fifoStart];
1263     const PetscInt o   = fifo[fifoStart+1];
1264     const PetscInt rev = o >= 0 ? 0 : 1;
1265     const PetscInt off = rev ? -(o+1) : o;
1266 
1267     if (useCone) {
1268       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1269       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1270       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1271     } else {
1272       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1273       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1274       tmpO = NULL;
1275     }
1276     for (t = 0; t < tmpSize; ++t) {
1277       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1278       const PetscInt cp = tmp[i];
1279       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1280       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1281        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1282       PetscInt       co = tmpO ? tmpO[i] : 0;
1283       PetscInt       c;
1284 
1285       if (rev) {
1286         PetscInt childSize, coff;
1287         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1288         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1289         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1290       }
1291       /* Check for duplicate */
1292       for (c = 0; c < closureSize; c += 2) {
1293         if (closure[c] == cp) break;
1294       }
1295       if (c == closureSize) {
1296         closure[closureSize]   = cp;
1297         closure[closureSize+1] = co;
1298         fifo[fifoSize]         = cp;
1299         fifo[fifoSize+1]       = co;
1300         closureSize           += 2;
1301         fifoSize              += 2;
1302       }
1303     }
1304     fifoStart += 2;
1305   }
1306   if (numPoints) *numPoints = closureSize/2;
1307   if (points)    *points    = closure;
1308   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1309   PetscFunctionReturn(0);
1310 }
1311 
1312 #undef __FUNCT__
1313 #define __FUNCT__ "DMPlexGetTransitiveClosure_Internal"
1314 /*@C
1315   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
1316 
1317   Not collective
1318 
1319   Input Parameters:
1320 + mesh - The DMPlex
1321 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1322 . orientation - The orientation of the point
1323 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1324 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1325 
1326   Output Parameters:
1327 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1328 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1329 
1330   Note:
1331   If using internal storage (points is NULL on input), each call overwrites the last output.
1332 
1333   Fortran Notes:
1334   Since it returns an array, this routine is only available in Fortran 90, and you must
1335   include petsc.h90 in your code.
1336 
1337   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1338 
1339   Level: beginner
1340 
1341 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1342 @*/
1343 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM dm, PetscInt p, PetscInt ornt, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1344 {
1345   DM_Plex        *mesh = (DM_Plex*) dm->data;
1346   PetscInt       *closure, *fifo;
1347   const PetscInt *tmp = NULL, *tmpO = NULL;
1348   PetscInt        tmpSize, t;
1349   PetscInt        depth       = 0, maxSize;
1350   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1351   PetscErrorCode  ierr;
1352 
1353   PetscFunctionBegin;
1354   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1355   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1356   /* This is only 1-level */
1357   if (useCone) {
1358     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1359     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1360     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1361   } else {
1362     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1363     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1364   }
1365   if (depth == 1) {
1366     if (*points) {
1367       closure = *points;
1368     } else {
1369       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1370       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1371     }
1372     closure[0] = p; closure[1] = ornt;
1373     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1374       const PetscInt i = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1375       closure[closureSize]   = tmp[i];
1376       closure[closureSize+1] = tmpO ? tmpO[i] : 0;
1377     }
1378     if (numPoints) *numPoints = closureSize/2;
1379     if (points)    *points    = closure;
1380     PetscFunctionReturn(0);
1381   }
1382   {
1383     PetscInt c, coneSeries, s,supportSeries;
1384 
1385     c = mesh->maxConeSize;
1386     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
1387     s = mesh->maxSupportSize;
1388     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
1389     maxSize = 2*PetscMax(coneSeries,supportSeries);
1390   }
1391   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1392   if (*points) {
1393     closure = *points;
1394   } else {
1395     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1396   }
1397   closure[0] = p; closure[1] = ornt;
1398   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1399     const PetscInt i  = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1400     const PetscInt cp = tmp[i];
1401     PetscInt       co = tmpO ? tmpO[i] : 0;
1402 
1403     if (ornt < 0) {
1404       PetscInt childSize, coff;
1405       ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1406       coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1407       co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1408     }
1409     closure[closureSize]   = cp;
1410     closure[closureSize+1] = co;
1411     fifo[fifoSize]         = cp;
1412     fifo[fifoSize+1]       = co;
1413   }
1414   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1415   while (fifoSize - fifoStart) {
1416     const PetscInt q   = fifo[fifoStart];
1417     const PetscInt o   = fifo[fifoStart+1];
1418     const PetscInt rev = o >= 0 ? 0 : 1;
1419     const PetscInt off = rev ? -(o+1) : o;
1420 
1421     if (useCone) {
1422       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1423       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1424       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1425     } else {
1426       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1427       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1428       tmpO = NULL;
1429     }
1430     for (t = 0; t < tmpSize; ++t) {
1431       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1432       const PetscInt cp = tmp[i];
1433       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1434       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1435        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1436       PetscInt       co = tmpO ? tmpO[i] : 0;
1437       PetscInt       c;
1438 
1439       if (rev) {
1440         PetscInt childSize, coff;
1441         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1442         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1443         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1444       }
1445       /* Check for duplicate */
1446       for (c = 0; c < closureSize; c += 2) {
1447         if (closure[c] == cp) break;
1448       }
1449       if (c == closureSize) {
1450         closure[closureSize]   = cp;
1451         closure[closureSize+1] = co;
1452         fifo[fifoSize]         = cp;
1453         fifo[fifoSize+1]       = co;
1454         closureSize           += 2;
1455         fifoSize              += 2;
1456       }
1457     }
1458     fifoStart += 2;
1459   }
1460   if (numPoints) *numPoints = closureSize/2;
1461   if (points)    *points    = closure;
1462   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1463   PetscFunctionReturn(0);
1464 }
1465 
1466 #undef __FUNCT__
1467 #define __FUNCT__ "DMPlexRestoreTransitiveClosure"
1468 /*@C
1469   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1470 
1471   Not collective
1472 
1473   Input Parameters:
1474 + mesh - The DMPlex
1475 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1476 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1477 . numPoints - The number of points in the closure, so points[] is of size 2*numPoints, zeroed on exit
1478 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...], zeroed on exit
1479 
1480   Note:
1481   If not using internal storage (points is not NULL on input), this call is unnecessary
1482 
1483   Fortran Notes:
1484   Since it returns an array, this routine is only available in Fortran 90, and you must
1485   include petsc.h90 in your code.
1486 
1487   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1488 
1489   Level: beginner
1490 
1491 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1492 @*/
1493 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1494 {
1495   PetscErrorCode ierr;
1496 
1497   PetscFunctionBegin;
1498   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1499   if (numPoints) PetscValidIntPointer(numPoints,4);
1500   if (points) PetscValidPointer(points,5);
1501   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, points);CHKERRQ(ierr);
1502   if (numPoints) *numPoints = 0;
1503   PetscFunctionReturn(0);
1504 }
1505 
1506 #undef __FUNCT__
1507 #define __FUNCT__ "DMPlexGetMaxSizes"
1508 /*@
1509   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the Sieve DAG
1510 
1511   Not collective
1512 
1513   Input Parameter:
1514 . mesh - The DMPlex
1515 
1516   Output Parameters:
1517 + maxConeSize - The maximum number of in-edges
1518 - maxSupportSize - The maximum number of out-edges
1519 
1520   Level: beginner
1521 
1522 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1523 @*/
1524 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
1525 {
1526   DM_Plex *mesh = (DM_Plex*) dm->data;
1527 
1528   PetscFunctionBegin;
1529   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1530   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
1531   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
1532   PetscFunctionReturn(0);
1533 }
1534 
1535 #undef __FUNCT__
1536 #define __FUNCT__ "DMSetUp_Plex"
1537 PetscErrorCode DMSetUp_Plex(DM dm)
1538 {
1539   DM_Plex       *mesh = (DM_Plex*) dm->data;
1540   PetscInt       size;
1541   PetscErrorCode ierr;
1542 
1543   PetscFunctionBegin;
1544   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1545   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
1546   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
1547   ierr = PetscMalloc1(size, &mesh->cones);CHKERRQ(ierr);
1548   ierr = PetscCalloc1(size, &mesh->coneOrientations);CHKERRQ(ierr);
1549   if (mesh->maxSupportSize) {
1550     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1551     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
1552     ierr = PetscMalloc1(size, &mesh->supports);CHKERRQ(ierr);
1553   }
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 #undef __FUNCT__
1558 #define __FUNCT__ "DMCreateSubDM_Plex"
1559 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
1560 {
1561   PetscErrorCode ierr;
1562 
1563   PetscFunctionBegin;
1564   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
1565   ierr = DMCreateSubDM_Section_Private(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
1566   PetscFunctionReturn(0);
1567 }
1568 
1569 #undef __FUNCT__
1570 #define __FUNCT__ "DMPlexSymmetrize"
1571 /*@
1572   DMPlexSymmetrize - Creates support (out-edge) information from cone (in-edge) inoformation
1573 
1574   Not collective
1575 
1576   Input Parameter:
1577 . mesh - The DMPlex
1578 
1579   Output Parameter:
1580 
1581   Note:
1582   This should be called after all calls to DMPlexSetCone()
1583 
1584   Level: beginner
1585 
1586 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
1587 @*/
1588 PetscErrorCode DMPlexSymmetrize(DM dm)
1589 {
1590   DM_Plex       *mesh = (DM_Plex*) dm->data;
1591   PetscInt      *offsets;
1592   PetscInt       supportSize;
1593   PetscInt       pStart, pEnd, p;
1594   PetscErrorCode ierr;
1595 
1596   PetscFunctionBegin;
1597   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1598   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
1599   /* Calculate support sizes */
1600   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1601   for (p = pStart; p < pEnd; ++p) {
1602     PetscInt dof, off, c;
1603 
1604     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1605     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1606     for (c = off; c < off+dof; ++c) {
1607       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
1608     }
1609   }
1610   for (p = pStart; p < pEnd; ++p) {
1611     PetscInt dof;
1612 
1613     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1614 
1615     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
1616   }
1617   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1618   /* Calculate supports */
1619   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
1620   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
1621   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
1622   for (p = pStart; p < pEnd; ++p) {
1623     PetscInt dof, off, c;
1624 
1625     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1626     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1627     for (c = off; c < off+dof; ++c) {
1628       const PetscInt q = mesh->cones[c];
1629       PetscInt       offS;
1630 
1631       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
1632 
1633       mesh->supports[offS+offsets[q]] = p;
1634       ++offsets[q];
1635     }
1636   }
1637   ierr = PetscFree(offsets);CHKERRQ(ierr);
1638   PetscFunctionReturn(0);
1639 }
1640 
1641 #undef __FUNCT__
1642 #define __FUNCT__ "DMPlexStratify"
1643 /*@
1644   DMPlexStratify - The Sieve DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
1645   can be illustrated by Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
1646   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
1647   the DAG.
1648 
1649   Not collective
1650 
1651   Input Parameter:
1652 . mesh - The DMPlex
1653 
1654   Output Parameter:
1655 
1656   Notes:
1657   Concretely, DMPlexStratify() creates a new label named "depth" containing the dimension of each element: 0 for vertices,
1658   1 for edges, and so on.  The depth label can be accessed through DMPlexGetDepthLabel() or DMPlexGetDepthStratum(), or
1659   manually via DMPlexGetLabel().  The height is defined implicitly by height = maxDimension - depth, and can be accessed
1660   via DMPlexGetHeightStratum().  For example, cells have height 0 and faces have height 1.
1661 
1662   DMPlexStratify() should be called after all calls to DMPlexSymmetrize()
1663 
1664   Level: beginner
1665 
1666 .seealso: DMPlexCreate(), DMPlexSymmetrize()
1667 @*/
1668 PetscErrorCode DMPlexStratify(DM dm)
1669 {
1670   DMLabel        label;
1671   PetscInt       pStart, pEnd, p;
1672   PetscInt       numRoots = 0, numLeaves = 0;
1673   PetscErrorCode ierr;
1674 
1675   PetscFunctionBegin;
1676   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1677   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1678   /* Calculate depth */
1679   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1680   ierr = DMPlexCreateLabel(dm, "depth");CHKERRQ(ierr);
1681   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
1682   /* Initialize roots and count leaves */
1683   for (p = pStart; p < pEnd; ++p) {
1684     PetscInt coneSize, supportSize;
1685 
1686     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1687     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1688     if (!coneSize && supportSize) {
1689       ++numRoots;
1690       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1691     } else if (!supportSize && coneSize) {
1692       ++numLeaves;
1693     } else if (!supportSize && !coneSize) {
1694       /* Isolated points */
1695       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
1696     }
1697   }
1698   if (numRoots + numLeaves == (pEnd - pStart)) {
1699     for (p = pStart; p < pEnd; ++p) {
1700       PetscInt coneSize, supportSize;
1701 
1702       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1703       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
1704       if (!supportSize && coneSize) {
1705         ierr = DMLabelSetValue(label, p, 1);CHKERRQ(ierr);
1706       }
1707     }
1708   } else {
1709     IS       pointIS;
1710     PetscInt numPoints = 0, level = 0;
1711 
1712     ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1713     if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1714     while (numPoints) {
1715       const PetscInt *points;
1716       const PetscInt  newLevel = level+1;
1717 
1718       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1719       for (p = 0; p < numPoints; ++p) {
1720         const PetscInt  point = points[p];
1721         const PetscInt *support;
1722         PetscInt        supportSize, s;
1723 
1724         ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
1725         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
1726         for (s = 0; s < supportSize; ++s) {
1727           ierr = DMLabelSetValue(label, support[s], newLevel);CHKERRQ(ierr);
1728         }
1729       }
1730       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1731       ++level;
1732       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1733       ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
1734       if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
1735       else         {numPoints = 0;}
1736     }
1737     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1738   }
1739   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
1740   PetscFunctionReturn(0);
1741 }
1742 
1743 #undef __FUNCT__
1744 #define __FUNCT__ "DMPlexGetJoin"
1745 /*@C
1746   DMPlexGetJoin - Get an array for the join of the set of points
1747 
1748   Not Collective
1749 
1750   Input Parameters:
1751 + dm - The DMPlex object
1752 . numPoints - The number of input points for the join
1753 - points - The input points
1754 
1755   Output Parameters:
1756 + numCoveredPoints - The number of points in the join
1757 - coveredPoints - The points in the join
1758 
1759   Level: intermediate
1760 
1761   Note: Currently, this is restricted to a single level join
1762 
1763   Fortran Notes:
1764   Since it returns an array, this routine is only available in Fortran 90, and you must
1765   include petsc.h90 in your code.
1766 
1767   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1768 
1769 .keywords: mesh
1770 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
1771 @*/
1772 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1773 {
1774   DM_Plex       *mesh = (DM_Plex*) dm->data;
1775   PetscInt      *join[2];
1776   PetscInt       joinSize, i = 0;
1777   PetscInt       dof, off, p, c, m;
1778   PetscErrorCode ierr;
1779 
1780   PetscFunctionBegin;
1781   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1782   PetscValidPointer(points, 2);
1783   PetscValidPointer(numCoveredPoints, 3);
1784   PetscValidPointer(coveredPoints, 4);
1785   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
1786   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
1787   /* Copy in support of first point */
1788   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
1789   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
1790   for (joinSize = 0; joinSize < dof; ++joinSize) {
1791     join[i][joinSize] = mesh->supports[off+joinSize];
1792   }
1793   /* Check each successive support */
1794   for (p = 1; p < numPoints; ++p) {
1795     PetscInt newJoinSize = 0;
1796 
1797     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
1798     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
1799     for (c = 0; c < dof; ++c) {
1800       const PetscInt point = mesh->supports[off+c];
1801 
1802       for (m = 0; m < joinSize; ++m) {
1803         if (point == join[i][m]) {
1804           join[1-i][newJoinSize++] = point;
1805           break;
1806         }
1807       }
1808     }
1809     joinSize = newJoinSize;
1810     i        = 1-i;
1811   }
1812   *numCoveredPoints = joinSize;
1813   *coveredPoints    = join[i];
1814   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
1815   PetscFunctionReturn(0);
1816 }
1817 
1818 #undef __FUNCT__
1819 #define __FUNCT__ "DMPlexRestoreJoin"
1820 /*@C
1821   DMPlexRestoreJoin - Restore an array for the join of the set of points
1822 
1823   Not Collective
1824 
1825   Input Parameters:
1826 + dm - The DMPlex object
1827 . numPoints - The number of input points for the join
1828 - points - The input points
1829 
1830   Output Parameters:
1831 + numCoveredPoints - The number of points in the join
1832 - coveredPoints - The points in the join
1833 
1834   Fortran Notes:
1835   Since it returns an array, this routine is only available in Fortran 90, and you must
1836   include petsc.h90 in your code.
1837 
1838   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1839 
1840   Level: intermediate
1841 
1842 .keywords: mesh
1843 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
1844 @*/
1845 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1846 {
1847   PetscErrorCode ierr;
1848 
1849   PetscFunctionBegin;
1850   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1851   if (points) PetscValidIntPointer(points,3);
1852   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
1853   PetscValidPointer(coveredPoints, 5);
1854   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
1855   if (numCoveredPoints) *numCoveredPoints = 0;
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 #undef __FUNCT__
1860 #define __FUNCT__ "DMPlexGetFullJoin"
1861 /*@C
1862   DMPlexGetFullJoin - Get an array for the join of the set of points
1863 
1864   Not Collective
1865 
1866   Input Parameters:
1867 + dm - The DMPlex object
1868 . numPoints - The number of input points for the join
1869 - points - The input points
1870 
1871   Output Parameters:
1872 + numCoveredPoints - The number of points in the join
1873 - coveredPoints - The points in the join
1874 
1875   Fortran Notes:
1876   Since it returns an array, this routine is only available in Fortran 90, and you must
1877   include petsc.h90 in your code.
1878 
1879   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1880 
1881   Level: intermediate
1882 
1883 .keywords: mesh
1884 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
1885 @*/
1886 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
1887 {
1888   DM_Plex       *mesh = (DM_Plex*) dm->data;
1889   PetscInt      *offsets, **closures;
1890   PetscInt      *join[2];
1891   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
1892   PetscInt       p, d, c, m, ms;
1893   PetscErrorCode ierr;
1894 
1895   PetscFunctionBegin;
1896   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1897   PetscValidPointer(points, 2);
1898   PetscValidPointer(numCoveredPoints, 3);
1899   PetscValidPointer(coveredPoints, 4);
1900 
1901   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1902   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
1903   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1904   ms      = mesh->maxSupportSize;
1905   maxSize = (ms > 1) ? ((PetscPowInt(ms,depth+1)-1)/(ms-1)) : depth + 1;
1906   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
1907   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
1908 
1909   for (p = 0; p < numPoints; ++p) {
1910     PetscInt closureSize;
1911 
1912     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
1913 
1914     offsets[p*(depth+2)+0] = 0;
1915     for (d = 0; d < depth+1; ++d) {
1916       PetscInt pStart, pEnd, i;
1917 
1918       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
1919       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
1920         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
1921           offsets[p*(depth+2)+d+1] = i;
1922           break;
1923         }
1924       }
1925       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
1926     }
1927     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);
1928   }
1929   for (d = 0; d < depth+1; ++d) {
1930     PetscInt dof;
1931 
1932     /* Copy in support of first point */
1933     dof = offsets[d+1] - offsets[d];
1934     for (joinSize = 0; joinSize < dof; ++joinSize) {
1935       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
1936     }
1937     /* Check each successive cone */
1938     for (p = 1; p < numPoints && joinSize; ++p) {
1939       PetscInt newJoinSize = 0;
1940 
1941       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
1942       for (c = 0; c < dof; ++c) {
1943         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
1944 
1945         for (m = 0; m < joinSize; ++m) {
1946           if (point == join[i][m]) {
1947             join[1-i][newJoinSize++] = point;
1948             break;
1949           }
1950         }
1951       }
1952       joinSize = newJoinSize;
1953       i        = 1-i;
1954     }
1955     if (joinSize) break;
1956   }
1957   *numCoveredPoints = joinSize;
1958   *coveredPoints    = join[i];
1959   for (p = 0; p < numPoints; ++p) {
1960     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
1961   }
1962   ierr = PetscFree(closures);CHKERRQ(ierr);
1963   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
1964   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
1965   PetscFunctionReturn(0);
1966 }
1967 
1968 #undef __FUNCT__
1969 #define __FUNCT__ "DMPlexGetMeet"
1970 /*@C
1971   DMPlexGetMeet - Get an array for the meet of the set of points
1972 
1973   Not Collective
1974 
1975   Input Parameters:
1976 + dm - The DMPlex object
1977 . numPoints - The number of input points for the meet
1978 - points - The input points
1979 
1980   Output Parameters:
1981 + numCoveredPoints - The number of points in the meet
1982 - coveredPoints - The points in the meet
1983 
1984   Level: intermediate
1985 
1986   Note: Currently, this is restricted to a single level meet
1987 
1988   Fortran Notes:
1989   Since it returns an array, this routine is only available in Fortran 90, and you must
1990   include petsc.h90 in your code.
1991 
1992   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1993 
1994 .keywords: mesh
1995 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
1996 @*/
1997 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
1998 {
1999   DM_Plex       *mesh = (DM_Plex*) dm->data;
2000   PetscInt      *meet[2];
2001   PetscInt       meetSize, i = 0;
2002   PetscInt       dof, off, p, c, m;
2003   PetscErrorCode ierr;
2004 
2005   PetscFunctionBegin;
2006   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2007   PetscValidPointer(points, 2);
2008   PetscValidPointer(numCoveringPoints, 3);
2009   PetscValidPointer(coveringPoints, 4);
2010   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2011   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2012   /* Copy in cone of first point */
2013   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
2014   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
2015   for (meetSize = 0; meetSize < dof; ++meetSize) {
2016     meet[i][meetSize] = mesh->cones[off+meetSize];
2017   }
2018   /* Check each successive cone */
2019   for (p = 1; p < numPoints; ++p) {
2020     PetscInt newMeetSize = 0;
2021 
2022     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
2023     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
2024     for (c = 0; c < dof; ++c) {
2025       const PetscInt point = mesh->cones[off+c];
2026 
2027       for (m = 0; m < meetSize; ++m) {
2028         if (point == meet[i][m]) {
2029           meet[1-i][newMeetSize++] = point;
2030           break;
2031         }
2032       }
2033     }
2034     meetSize = newMeetSize;
2035     i        = 1-i;
2036   }
2037   *numCoveringPoints = meetSize;
2038   *coveringPoints    = meet[i];
2039   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2040   PetscFunctionReturn(0);
2041 }
2042 
2043 #undef __FUNCT__
2044 #define __FUNCT__ "DMPlexRestoreMeet"
2045 /*@C
2046   DMPlexRestoreMeet - Restore an array for the meet of the set of points
2047 
2048   Not Collective
2049 
2050   Input Parameters:
2051 + dm - The DMPlex object
2052 . numPoints - The number of input points for the meet
2053 - points - The input points
2054 
2055   Output Parameters:
2056 + numCoveredPoints - The number of points in the meet
2057 - coveredPoints - The points in the meet
2058 
2059   Level: intermediate
2060 
2061   Fortran Notes:
2062   Since it returns an array, this routine is only available in Fortran 90, and you must
2063   include petsc.h90 in your code.
2064 
2065   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2066 
2067 .keywords: mesh
2068 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
2069 @*/
2070 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2071 {
2072   PetscErrorCode ierr;
2073 
2074   PetscFunctionBegin;
2075   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2076   if (points) PetscValidIntPointer(points,3);
2077   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2078   PetscValidPointer(coveredPoints,5);
2079   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2080   if (numCoveredPoints) *numCoveredPoints = 0;
2081   PetscFunctionReturn(0);
2082 }
2083 
2084 #undef __FUNCT__
2085 #define __FUNCT__ "DMPlexGetFullMeet"
2086 /*@C
2087   DMPlexGetFullMeet - Get an array for the meet of the set of points
2088 
2089   Not Collective
2090 
2091   Input Parameters:
2092 + dm - The DMPlex object
2093 . numPoints - The number of input points for the meet
2094 - points - The input points
2095 
2096   Output Parameters:
2097 + numCoveredPoints - The number of points in the meet
2098 - coveredPoints - The points in the meet
2099 
2100   Level: intermediate
2101 
2102   Fortran Notes:
2103   Since it returns an array, this routine is only available in Fortran 90, and you must
2104   include petsc.h90 in your code.
2105 
2106   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2107 
2108 .keywords: mesh
2109 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
2110 @*/
2111 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2112 {
2113   DM_Plex       *mesh = (DM_Plex*) dm->data;
2114   PetscInt      *offsets, **closures;
2115   PetscInt      *meet[2];
2116   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
2117   PetscInt       p, h, c, m, mc;
2118   PetscErrorCode ierr;
2119 
2120   PetscFunctionBegin;
2121   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2122   PetscValidPointer(points, 2);
2123   PetscValidPointer(numCoveredPoints, 3);
2124   PetscValidPointer(coveredPoints, 4);
2125 
2126   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
2127   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
2128   ierr    = DMGetWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2129   mc      = mesh->maxConeSize;
2130   maxSize = (mc > 1) ? ((PetscPowInt(mc,height+1)-1)/(mc-1)) : height + 1;
2131   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2132   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2133 
2134   for (p = 0; p < numPoints; ++p) {
2135     PetscInt closureSize;
2136 
2137     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
2138 
2139     offsets[p*(height+2)+0] = 0;
2140     for (h = 0; h < height+1; ++h) {
2141       PetscInt pStart, pEnd, i;
2142 
2143       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
2144       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
2145         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2146           offsets[p*(height+2)+h+1] = i;
2147           break;
2148         }
2149       }
2150       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
2151     }
2152     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);
2153   }
2154   for (h = 0; h < height+1; ++h) {
2155     PetscInt dof;
2156 
2157     /* Copy in cone of first point */
2158     dof = offsets[h+1] - offsets[h];
2159     for (meetSize = 0; meetSize < dof; ++meetSize) {
2160       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
2161     }
2162     /* Check each successive cone */
2163     for (p = 1; p < numPoints && meetSize; ++p) {
2164       PetscInt newMeetSize = 0;
2165 
2166       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
2167       for (c = 0; c < dof; ++c) {
2168         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
2169 
2170         for (m = 0; m < meetSize; ++m) {
2171           if (point == meet[i][m]) {
2172             meet[1-i][newMeetSize++] = point;
2173             break;
2174           }
2175         }
2176       }
2177       meetSize = newMeetSize;
2178       i        = 1-i;
2179     }
2180     if (meetSize) break;
2181   }
2182   *numCoveredPoints = meetSize;
2183   *coveredPoints    = meet[i];
2184   for (p = 0; p < numPoints; ++p) {
2185     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
2186   }
2187   ierr = PetscFree(closures);CHKERRQ(ierr);
2188   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2189   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2190   PetscFunctionReturn(0);
2191 }
2192 
2193 #undef __FUNCT__
2194 #define __FUNCT__ "DMPlexEqual"
2195 /*@C
2196   DMPlexEqual - Determine if two DMs have the same topology
2197 
2198   Not Collective
2199 
2200   Input Parameters:
2201 + dmA - A DMPlex object
2202 - dmB - A DMPlex object
2203 
2204   Output Parameters:
2205 . equal - PETSC_TRUE if the topologies are identical
2206 
2207   Level: intermediate
2208 
2209   Notes:
2210   We are not solving graph isomorphism, so we do not permutation.
2211 
2212 .keywords: mesh
2213 .seealso: DMPlexGetCone()
2214 @*/
2215 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
2216 {
2217   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
2218   PetscErrorCode ierr;
2219 
2220   PetscFunctionBegin;
2221   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
2222   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
2223   PetscValidPointer(equal, 3);
2224 
2225   *equal = PETSC_FALSE;
2226   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
2227   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
2228   if (depth != depthB) PetscFunctionReturn(0);
2229   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
2230   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
2231   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
2232   for (p = pStart; p < pEnd; ++p) {
2233     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
2234     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
2235 
2236     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
2237     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
2238     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
2239     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
2240     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
2241     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
2242     if (coneSize != coneSizeB) PetscFunctionReturn(0);
2243     for (c = 0; c < coneSize; ++c) {
2244       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
2245       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
2246     }
2247     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
2248     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
2249     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
2250     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
2251     if (supportSize != supportSizeB) PetscFunctionReturn(0);
2252     for (s = 0; s < supportSize; ++s) {
2253       if (support[s] != supportB[s]) PetscFunctionReturn(0);
2254     }
2255   }
2256   *equal = PETSC_TRUE;
2257   PetscFunctionReturn(0);
2258 }
2259 
2260 #undef __FUNCT__
2261 #define __FUNCT__ "DMPlexGetNumFaceVertices"
2262 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
2263 {
2264   MPI_Comm       comm;
2265   PetscErrorCode ierr;
2266 
2267   PetscFunctionBegin;
2268   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2269   PetscValidPointer(numFaceVertices,3);
2270   switch (cellDim) {
2271   case 0:
2272     *numFaceVertices = 0;
2273     break;
2274   case 1:
2275     *numFaceVertices = 1;
2276     break;
2277   case 2:
2278     switch (numCorners) {
2279     case 3: /* triangle */
2280       *numFaceVertices = 2; /* Edge has 2 vertices */
2281       break;
2282     case 4: /* quadrilateral */
2283       *numFaceVertices = 2; /* Edge has 2 vertices */
2284       break;
2285     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
2286       *numFaceVertices = 3; /* Edge has 3 vertices */
2287       break;
2288     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
2289       *numFaceVertices = 3; /* Edge has 3 vertices */
2290       break;
2291     default:
2292       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2293     }
2294     break;
2295   case 3:
2296     switch (numCorners) {
2297     case 4: /* tetradehdron */
2298       *numFaceVertices = 3; /* Face has 3 vertices */
2299       break;
2300     case 6: /* tet cohesive cells */
2301       *numFaceVertices = 4; /* Face has 4 vertices */
2302       break;
2303     case 8: /* hexahedron */
2304       *numFaceVertices = 4; /* Face has 4 vertices */
2305       break;
2306     case 9: /* tet cohesive Lagrange cells */
2307       *numFaceVertices = 6; /* Face has 6 vertices */
2308       break;
2309     case 10: /* quadratic tetrahedron */
2310       *numFaceVertices = 6; /* Face has 6 vertices */
2311       break;
2312     case 12: /* hex cohesive Lagrange cells */
2313       *numFaceVertices = 6; /* Face has 6 vertices */
2314       break;
2315     case 18: /* quadratic tet cohesive Lagrange cells */
2316       *numFaceVertices = 6; /* Face has 6 vertices */
2317       break;
2318     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
2319       *numFaceVertices = 9; /* Face has 9 vertices */
2320       break;
2321     default:
2322       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %d for dimension %d", numCorners, cellDim);
2323     }
2324     break;
2325   default:
2326     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %d", cellDim);
2327   }
2328   PetscFunctionReturn(0);
2329 }
2330 
2331 #undef __FUNCT__
2332 #define __FUNCT__ "DMPlexLocalizeCoordinate_Internal"
2333 PetscErrorCode DMPlexLocalizeCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
2334 {
2335   PetscInt d;
2336 
2337   PetscFunctionBegin;
2338   if (!dm->maxCell) {
2339     for (d = 0; d < dim; ++d) out[d] = in[d];
2340   } else {
2341     for (d = 0; d < dim; ++d) {
2342       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
2343         out[d] = PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
2344       } else {
2345         out[d] = in[d];
2346       }
2347     }
2348   }
2349   PetscFunctionReturn(0);
2350 }
2351 
2352 #undef __FUNCT__
2353 #define __FUNCT__ "DMPlexLocalizeAddCoordinate_Internal"
2354 PetscErrorCode DMPlexLocalizeAddCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
2355 {
2356   PetscInt d;
2357 
2358   PetscFunctionBegin;
2359   if (!dm->maxCell) {
2360     for (d = 0; d < dim; ++d) out[d] += in[d];
2361   } else {
2362     for (d = 0; d < dim; ++d) {
2363       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
2364         out[d] += PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
2365       } else {
2366         out[d] += in[d];
2367       }
2368     }
2369   }
2370   PetscFunctionReturn(0);
2371 }
2372 
2373 #undef __FUNCT__
2374 #define __FUNCT__ "DMPlexLocalizeCoordinates"
2375 PetscErrorCode DMPlexLocalizeCoordinates(DM dm)
2376 {
2377   PetscSection   coordSection, cSection;
2378   Vec            coordinates,  cVec;
2379   PetscScalar   *coords, *coords2, *anchor;
2380   PetscInt       Nc, cStart, cEnd, c, vStart, vEnd, v, dof, d, off, off2, bs, coordSize;
2381   PetscErrorCode ierr;
2382 
2383   PetscFunctionBegin;
2384   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2385   if (!dm->maxCell) PetscFunctionReturn(0);
2386   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2387   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
2388   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2389   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2390   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &cSection);CHKERRQ(ierr);
2391   ierr = PetscSectionSetNumFields(cSection, 1);CHKERRQ(ierr);
2392   ierr = PetscSectionGetFieldComponents(coordSection, 0, &Nc);CHKERRQ(ierr);
2393   ierr = PetscSectionSetFieldComponents(cSection, 0, Nc);CHKERRQ(ierr);
2394   ierr = PetscSectionSetChart(cSection, cStart, vEnd);CHKERRQ(ierr);
2395   for (v = vStart; v < vEnd; ++v) {
2396     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2397     ierr = PetscSectionSetDof(cSection,     v,  dof);CHKERRQ(ierr);
2398     ierr = PetscSectionSetFieldDof(cSection, v, 0, dof);CHKERRQ(ierr);
2399   }
2400   for (c = cStart; c < cEnd; ++c) {
2401     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, NULL);CHKERRQ(ierr);
2402     ierr = PetscSectionSetDof(cSection, c, dof);CHKERRQ(ierr);
2403     ierr = PetscSectionSetFieldDof(cSection, c, 0, dof);CHKERRQ(ierr);
2404   }
2405   ierr = PetscSectionSetUp(cSection);CHKERRQ(ierr);
2406   ierr = PetscSectionGetStorageSize(cSection, &coordSize);CHKERRQ(ierr);
2407   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cVec);CHKERRQ(ierr);
2408   ierr = VecGetBlockSize(coordinates, &bs);CHKERRQ(ierr);
2409   ierr = VecSetBlockSize(cVec,         bs);CHKERRQ(ierr);
2410   ierr = VecSetSizes(cVec, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2411   ierr = VecSetType(cVec,VECSTANDARD);CHKERRQ(ierr);
2412   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
2413   ierr = VecGetArray(cVec,        &coords2);CHKERRQ(ierr);
2414   for (v = vStart; v < vEnd; ++v) {
2415     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2416     ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
2417     ierr = PetscSectionGetOffset(cSection,     v, &off2);CHKERRQ(ierr);
2418     for (d = 0; d < dof; ++d) coords2[off2+d] = coords[off+d];
2419   }
2420   ierr = DMGetWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2421   for (c = cStart; c < cEnd; ++c) {
2422     PetscScalar *cellCoords = NULL;
2423     PetscInt     b;
2424 
2425     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2426     ierr = PetscSectionGetOffset(cSection, c, &off2);CHKERRQ(ierr);
2427     for (b = 0; b < bs; ++b) anchor[b] = cellCoords[b];
2428     for (d = 0; d < dof/bs; ++d) {ierr = DMPlexLocalizeCoordinate_Internal(dm, bs, anchor, &cellCoords[d*bs], &coords2[off2+d*bs]);CHKERRQ(ierr);}
2429     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2430   }
2431   ierr = DMRestoreWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2432   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
2433   ierr = VecRestoreArray(cVec,        &coords2);CHKERRQ(ierr);
2434   ierr = DMSetCoordinateSection(dm, PETSC_DETERMINE, cSection);CHKERRQ(ierr);
2435   ierr = DMSetCoordinatesLocal(dm, cVec);CHKERRQ(ierr);
2436   ierr = VecDestroy(&cVec);CHKERRQ(ierr);
2437   ierr = PetscSectionDestroy(&cSection);CHKERRQ(ierr);
2438   PetscFunctionReturn(0);
2439 }
2440 
2441 #undef __FUNCT__
2442 #define __FUNCT__ "DMPlexGetDepthLabel"
2443 /*@
2444   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
2445 
2446   Not Collective
2447 
2448   Input Parameter:
2449 . dm    - The DMPlex object
2450 
2451   Output Parameter:
2452 . depthLabel - The DMLabel recording point depth
2453 
2454   Level: developer
2455 
2456 .keywords: mesh, points
2457 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2458 @*/
2459 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
2460 {
2461   DM_Plex       *mesh = (DM_Plex*) dm->data;
2462   PetscErrorCode ierr;
2463 
2464   PetscFunctionBegin;
2465   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2466   PetscValidPointer(depthLabel, 2);
2467   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
2468   *depthLabel = mesh->depthLabel;
2469   PetscFunctionReturn(0);
2470 }
2471 
2472 #undef __FUNCT__
2473 #define __FUNCT__ "DMPlexGetDepth"
2474 /*@
2475   DMPlexGetDepth - Get the depth of the DAG representing this mesh
2476 
2477   Not Collective
2478 
2479   Input Parameter:
2480 . dm    - The DMPlex object
2481 
2482   Output Parameter:
2483 . depth - The number of strata (breadth first levels) in the DAG
2484 
2485   Level: developer
2486 
2487 .keywords: mesh, points
2488 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2489 @*/
2490 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
2491 {
2492   DMLabel        label;
2493   PetscInt       d = 0;
2494   PetscErrorCode ierr;
2495 
2496   PetscFunctionBegin;
2497   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2498   PetscValidPointer(depth, 2);
2499   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2500   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
2501   *depth = d-1;
2502   PetscFunctionReturn(0);
2503 }
2504 
2505 #undef __FUNCT__
2506 #define __FUNCT__ "DMPlexGetDepthStratum"
2507 /*@
2508   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
2509 
2510   Not Collective
2511 
2512   Input Parameters:
2513 + dm           - The DMPlex object
2514 - stratumValue - The requested depth
2515 
2516   Output Parameters:
2517 + start - The first point at this depth
2518 - end   - One beyond the last point at this depth
2519 
2520   Level: developer
2521 
2522 .keywords: mesh, points
2523 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
2524 @*/
2525 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2526 {
2527   DMLabel        label;
2528   PetscInt       pStart, pEnd;
2529   PetscErrorCode ierr;
2530 
2531   PetscFunctionBegin;
2532   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2533   if (start) {PetscValidPointer(start, 3); *start = 0;}
2534   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2535   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2536   if (pStart == pEnd) PetscFunctionReturn(0);
2537   if (stratumValue < 0) {
2538     if (start) *start = pStart;
2539     if (end)   *end   = pEnd;
2540     PetscFunctionReturn(0);
2541   }
2542   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2543   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
2544   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
2545   PetscFunctionReturn(0);
2546 }
2547 
2548 #undef __FUNCT__
2549 #define __FUNCT__ "DMPlexGetHeightStratum"
2550 /*@
2551   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
2552 
2553   Not Collective
2554 
2555   Input Parameters:
2556 + dm           - The DMPlex object
2557 - stratumValue - The requested height
2558 
2559   Output Parameters:
2560 + start - The first point at this height
2561 - end   - One beyond the last point at this height
2562 
2563   Level: developer
2564 
2565 .keywords: mesh, points
2566 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
2567 @*/
2568 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2569 {
2570   DMLabel        label;
2571   PetscInt       depth, pStart, pEnd;
2572   PetscErrorCode ierr;
2573 
2574   PetscFunctionBegin;
2575   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2576   if (start) {PetscValidPointer(start, 3); *start = 0;}
2577   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2578   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2579   if (pStart == pEnd) PetscFunctionReturn(0);
2580   if (stratumValue < 0) {
2581     if (start) *start = pStart;
2582     if (end)   *end   = pEnd;
2583     PetscFunctionReturn(0);
2584   }
2585   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2586   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
2587   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
2588   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
2589   PetscFunctionReturn(0);
2590 }
2591 
2592 #undef __FUNCT__
2593 #define __FUNCT__ "DMPlexCreateSectionInitial"
2594 /* Set the number of dof on each point and separate by fields */
2595 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
2596 {
2597   PetscInt      *numDofTot;
2598   PetscInt       depth, pStart = 0, pEnd = 0;
2599   PetscInt       p, d, dep, f;
2600   PetscErrorCode ierr;
2601 
2602   PetscFunctionBegin;
2603   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
2604   for (d = 0; d <= dim; ++d) {
2605     numDofTot[d] = 0;
2606     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
2607   }
2608   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2609   if (numFields > 0) {
2610     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
2611     if (numComp) {
2612       for (f = 0; f < numFields; ++f) {
2613         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
2614       }
2615     }
2616   }
2617   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2618   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
2619   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2620   for (dep = 0; dep <= depth; ++dep) {
2621     d    = dim == depth ? dep : (!dep ? 0 : dim);
2622     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
2623     for (p = pStart; p < pEnd; ++p) {
2624       for (f = 0; f < numFields; ++f) {
2625         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
2626       }
2627       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
2628     }
2629   }
2630   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
2631   PetscFunctionReturn(0);
2632 }
2633 
2634 #undef __FUNCT__
2635 #define __FUNCT__ "DMPlexCreateSectionBCDof"
2636 /* Set the number of dof on each point and separate by fields
2637    If constDof is PETSC_DETERMINE, constrain every dof on the point
2638 */
2639 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
2640 {
2641   PetscInt       numFields;
2642   PetscInt       bc;
2643   PetscSection   aSec;
2644   PetscErrorCode ierr;
2645 
2646   PetscFunctionBegin;
2647   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2648   for (bc = 0; bc < numBC; ++bc) {
2649     PetscInt        field = 0;
2650     const PetscInt *idx;
2651     PetscInt        n, i;
2652 
2653     if (numFields) field = bcField[bc];
2654     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
2655     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2656     for (i = 0; i < n; ++i) {
2657       const PetscInt p        = idx[i];
2658       PetscInt       numConst = constDof;
2659 
2660       /* Constrain every dof on the point */
2661       if (numConst < 0) {
2662         if (numFields) {
2663           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
2664         } else {
2665           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
2666         }
2667       }
2668       if (numFields) {
2669         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
2670       }
2671       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
2672     }
2673     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2674   }
2675   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
2676   if (aSec) {
2677     PetscInt aStart, aEnd, a;
2678 
2679     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
2680     for (a = aStart; a < aEnd; a++) {
2681       PetscInt dof;
2682 
2683       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
2684       if (dof) {
2685         /* if there are point-to-point constraints, then all dofs are constrained */
2686         ierr = PetscSectionGetDof(section, a, &dof);CHKERRQ(ierr);
2687         ierr = PetscSectionSetConstraintDof(section, a, dof);CHKERRQ(ierr);
2688         if (numFields) {
2689           PetscInt f;
2690 
2691           for (f = 0; f < numFields; f++) {
2692             ierr = PetscSectionGetFieldDof(section, a, f, &dof);CHKERRQ(ierr);
2693             ierr = PetscSectionSetFieldConstraintDof(section, a, f, dof);CHKERRQ(ierr);
2694           }
2695         }
2696       }
2697     }
2698   }
2699   PetscFunctionReturn(0);
2700 }
2701 
2702 #undef __FUNCT__
2703 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
2704 /* Set the constrained indices on each point and separate by fields */
2705 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
2706 {
2707   PetscInt      *maxConstraints;
2708   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
2709   PetscErrorCode ierr;
2710 
2711   PetscFunctionBegin;
2712   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2713   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
2714   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
2715   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
2716   for (p = pStart; p < pEnd; ++p) {
2717     PetscInt cdof;
2718 
2719     if (numFields) {
2720       for (f = 0; f < numFields; ++f) {
2721         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
2722         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
2723       }
2724     } else {
2725       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
2726       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
2727     }
2728   }
2729   for (f = 0; f < numFields; ++f) {
2730     maxConstraints[numFields] += maxConstraints[f];
2731   }
2732   if (maxConstraints[numFields]) {
2733     PetscInt *indices;
2734 
2735     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
2736     for (p = pStart; p < pEnd; ++p) {
2737       PetscInt cdof, d;
2738 
2739       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
2740       if (cdof) {
2741         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
2742         if (numFields) {
2743           PetscInt numConst = 0, foff = 0;
2744 
2745           for (f = 0; f < numFields; ++f) {
2746             PetscInt cfdof, fdof;
2747 
2748             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
2749             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
2750             /* Change constraint numbering from absolute local dof number to field relative local dof number */
2751             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
2752             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
2753             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
2754             numConst += cfdof;
2755             foff     += fdof;
2756           }
2757           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
2758         } else {
2759           for (d = 0; d < cdof; ++d) indices[d] = d;
2760         }
2761         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
2762       }
2763     }
2764     ierr = PetscFree(indices);CHKERRQ(ierr);
2765   }
2766   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
2767   PetscFunctionReturn(0);
2768 }
2769 
2770 #undef __FUNCT__
2771 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
2772 /* Set the constrained field indices on each point */
2773 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
2774 {
2775   const PetscInt *points, *indices;
2776   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
2777   PetscErrorCode  ierr;
2778 
2779   PetscFunctionBegin;
2780   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2781   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
2782 
2783   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
2784   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
2785   if (!constraintIndices) {
2786     PetscInt *idx, i;
2787 
2788     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
2789     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
2790     for (i = 0; i < maxDof; ++i) idx[i] = i;
2791     for (p = 0; p < numPoints; ++p) {
2792       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
2793     }
2794     ierr = PetscFree(idx);CHKERRQ(ierr);
2795   } else {
2796     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
2797     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
2798     for (p = 0; p < numPoints; ++p) {
2799       PetscInt fcdof;
2800 
2801       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
2802       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);
2803       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
2804     }
2805     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
2806   }
2807   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
2808   PetscFunctionReturn(0);
2809 }
2810 
2811 #undef __FUNCT__
2812 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
2813 /* Set the constrained indices on each point and separate by fields */
2814 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
2815 {
2816   PetscInt      *indices;
2817   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
2818   PetscErrorCode ierr;
2819 
2820   PetscFunctionBegin;
2821   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
2822   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
2823   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2824   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
2825   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
2826   for (p = pStart; p < pEnd; ++p) {
2827     PetscInt cdof, d;
2828 
2829     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
2830     if (cdof) {
2831       PetscInt numConst = 0, foff = 0;
2832 
2833       for (f = 0; f < numFields; ++f) {
2834         const PetscInt *fcind;
2835         PetscInt        fdof, fcdof;
2836 
2837         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
2838         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
2839         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
2840         /* Change constraint numbering from field relative local dof number to absolute local dof number */
2841         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
2842         foff     += fdof;
2843         numConst += fcdof;
2844       }
2845       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
2846       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
2847     }
2848   }
2849   ierr = PetscFree(indices);CHKERRQ(ierr);
2850   PetscFunctionReturn(0);
2851 }
2852 
2853 #undef __FUNCT__
2854 #define __FUNCT__ "DMPlexCreateSection"
2855 /*@C
2856   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
2857 
2858   Not Collective
2859 
2860   Input Parameters:
2861 + dm        - The DMPlex object
2862 . dim       - The spatial dimension of the problem
2863 . numFields - The number of fields in the problem
2864 . numComp   - An array of size numFields that holds the number of components for each field
2865 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
2866 . numBC     - The number of boundary conditions
2867 . bcField   - An array of size numBC giving the field number for each boundry condition
2868 . bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
2869 - perm      - Optional permutation of the chart, or NULL
2870 
2871   Output Parameter:
2872 . section - The PetscSection object
2873 
2874   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
2875   number of dof for field 0 on each edge.
2876 
2877   The chart permutation is the same one set using PetscSectionSetPermutation()
2878 
2879   Level: developer
2880 
2881   Fortran Notes:
2882   A Fortran 90 version is available as DMPlexCreateSectionF90()
2883 
2884 .keywords: mesh, elements
2885 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
2886 @*/
2887 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)
2888 {
2889   PetscSection   aSec;
2890   PetscErrorCode ierr;
2891 
2892   PetscFunctionBegin;
2893   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
2894   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
2895   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
2896   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
2897   ierr = DMPlexGetAnchors(dm,&aSec,NULL);CHKERRQ(ierr);
2898   if (numBC || aSec) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
2899   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
2900   PetscFunctionReturn(0);
2901 }
2902 
2903 #undef __FUNCT__
2904 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
2905 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
2906 {
2907   PetscSection   section;
2908   PetscErrorCode ierr;
2909 
2910   PetscFunctionBegin;
2911   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
2912   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
2913   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
2914   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2915   PetscFunctionReturn(0);
2916 }
2917 
2918 #undef __FUNCT__
2919 #define __FUNCT__ "DMPlexGetConeSection"
2920 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
2921 {
2922   DM_Plex *mesh = (DM_Plex*) dm->data;
2923 
2924   PetscFunctionBegin;
2925   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2926   if (section) *section = mesh->coneSection;
2927   PetscFunctionReturn(0);
2928 }
2929 
2930 #undef __FUNCT__
2931 #define __FUNCT__ "DMPlexGetSupportSection"
2932 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
2933 {
2934   DM_Plex *mesh = (DM_Plex*) dm->data;
2935 
2936   PetscFunctionBegin;
2937   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2938   if (section) *section = mesh->supportSection;
2939   PetscFunctionReturn(0);
2940 }
2941 
2942 #undef __FUNCT__
2943 #define __FUNCT__ "DMPlexGetCones"
2944 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
2945 {
2946   DM_Plex *mesh = (DM_Plex*) dm->data;
2947 
2948   PetscFunctionBegin;
2949   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2950   if (cones) *cones = mesh->cones;
2951   PetscFunctionReturn(0);
2952 }
2953 
2954 #undef __FUNCT__
2955 #define __FUNCT__ "DMPlexGetConeOrientations"
2956 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
2957 {
2958   DM_Plex *mesh = (DM_Plex*) dm->data;
2959 
2960   PetscFunctionBegin;
2961   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2962   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
2963   PetscFunctionReturn(0);
2964 }
2965 
2966 /******************************** FEM Support **********************************/
2967 
2968 #undef __FUNCT__
2969 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
2970 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
2971 {
2972   PetscScalar    *array, *vArray;
2973   const PetscInt *cone, *coneO;
2974   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
2975   PetscErrorCode  ierr;
2976 
2977   PetscFunctionBeginHot;
2978   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
2979   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
2980   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
2981   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
2982   if (!values || !*values) {
2983     if ((point >= pStart) && (point < pEnd)) {
2984       PetscInt dof;
2985 
2986       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
2987       size += dof;
2988     }
2989     for (p = 0; p < numPoints; ++p) {
2990       const PetscInt cp = cone[p];
2991       PetscInt       dof;
2992 
2993       if ((cp < pStart) || (cp >= pEnd)) continue;
2994       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
2995       size += dof;
2996     }
2997     if (!values) {
2998       if (csize) *csize = size;
2999       PetscFunctionReturn(0);
3000     }
3001     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
3002   } else {
3003     array = *values;
3004   }
3005   size = 0;
3006   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3007   if ((point >= pStart) && (point < pEnd)) {
3008     PetscInt     dof, off, d;
3009     PetscScalar *varr;
3010 
3011     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3012     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3013     varr = &vArray[off];
3014     for (d = 0; d < dof; ++d, ++offset) {
3015       array[offset] = varr[d];
3016     }
3017     size += dof;
3018   }
3019   for (p = 0; p < numPoints; ++p) {
3020     const PetscInt cp = cone[p];
3021     PetscInt       o  = coneO[p];
3022     PetscInt       dof, off, d;
3023     PetscScalar   *varr;
3024 
3025     if ((cp < pStart) || (cp >= pEnd)) continue;
3026     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3027     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3028     varr = &vArray[off];
3029     if (o >= 0) {
3030       for (d = 0; d < dof; ++d, ++offset) {
3031         array[offset] = varr[d];
3032       }
3033     } else {
3034       for (d = dof-1; d >= 0; --d, ++offset) {
3035         array[offset] = varr[d];
3036       }
3037     }
3038     size += dof;
3039   }
3040   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3041   if (!*values) {
3042     if (csize) *csize = size;
3043     *values = array;
3044   } else {
3045     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3046     *csize = size;
3047   }
3048   PetscFunctionReturn(0);
3049 }
3050 
3051 #undef __FUNCT__
3052 #define __FUNCT__ "DMPlexVecGetClosure_Static"
3053 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3054 {
3055   PetscInt       offset = 0, p;
3056   PetscErrorCode ierr;
3057 
3058   PetscFunctionBeginHot;
3059   *size = 0;
3060   for (p = 0; p < numPoints*2; p += 2) {
3061     const PetscInt point = points[p];
3062     const PetscInt o     = points[p+1];
3063     PetscInt       dof, off, d;
3064     const PetscScalar *varr;
3065 
3066     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3067     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3068     varr = &vArray[off];
3069     if (o >= 0) {
3070       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
3071     } else {
3072       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
3073     }
3074   }
3075   *size = offset;
3076   PetscFunctionReturn(0);
3077 }
3078 
3079 #undef __FUNCT__
3080 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
3081 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3082 {
3083   PetscInt       offset = 0, f;
3084   PetscErrorCode ierr;
3085 
3086   PetscFunctionBeginHot;
3087   *size = 0;
3088   for (f = 0; f < numFields; ++f) {
3089     PetscInt fcomp, p;
3090 
3091     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3092     for (p = 0; p < numPoints*2; p += 2) {
3093       const PetscInt point = points[p];
3094       const PetscInt o     = points[p+1];
3095       PetscInt       fdof, foff, d, c;
3096       const PetscScalar *varr;
3097 
3098       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3099       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3100       varr = &vArray[foff];
3101       if (o >= 0) {
3102         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
3103       } else {
3104         for (d = fdof/fcomp-1; d >= 0; --d) {
3105           for (c = 0; c < fcomp; ++c, ++offset) {
3106             array[offset] = varr[d*fcomp+c];
3107           }
3108         }
3109       }
3110     }
3111   }
3112   *size = offset;
3113   PetscFunctionReturn(0);
3114 }
3115 
3116 #undef __FUNCT__
3117 #define __FUNCT__ "DMPlexVecGetClosure"
3118 /*@C
3119   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
3120 
3121   Not collective
3122 
3123   Input Parameters:
3124 + dm - The DM
3125 . section - The section describing the layout in v, or NULL to use the default section
3126 . v - The local vector
3127 - point - The sieve point in the DM
3128 
3129   Output Parameters:
3130 + csize - The number of values in the closure, or NULL
3131 - values - The array of values, which is a borrowed array and should not be freed
3132 
3133   Fortran Notes:
3134   Since it returns an array, this routine is only available in Fortran 90, and you must
3135   include petsc.h90 in your code.
3136 
3137   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3138 
3139   Level: intermediate
3140 
3141 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3142 @*/
3143 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3144 {
3145   PetscSection    clSection;
3146   IS              clPoints;
3147   PetscScalar    *array, *vArray;
3148   PetscInt       *points = NULL;
3149   const PetscInt *clp;
3150   PetscInt        depth, numFields, numPoints, size;
3151   PetscErrorCode  ierr;
3152 
3153   PetscFunctionBeginHot;
3154   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3155   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3156   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3157   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3158   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3159   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3160   if (depth == 1 && numFields < 2) {
3161     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
3162     PetscFunctionReturn(0);
3163   }
3164   /* Get points */
3165   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3166   if (!clPoints) {
3167     PetscInt pStart, pEnd, p, q;
3168 
3169     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3170     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3171     /* Compress out points not in the section */
3172     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3173       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3174         points[q*2]   = points[p];
3175         points[q*2+1] = points[p+1];
3176         ++q;
3177       }
3178     }
3179     numPoints = q;
3180   } else {
3181     PetscInt dof, off;
3182 
3183     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3184     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3185     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3186     numPoints = dof/2;
3187     points    = (PetscInt *) &clp[off];
3188   }
3189   /* Get array */
3190   if (!values || !*values) {
3191     PetscInt asize = 0, dof, p;
3192 
3193     for (p = 0; p < numPoints*2; p += 2) {
3194       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3195       asize += dof;
3196     }
3197     if (!values) {
3198       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3199       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3200       if (csize) *csize = asize;
3201       PetscFunctionReturn(0);
3202     }
3203     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
3204   } else {
3205     array = *values;
3206   }
3207   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3208   /* Get values */
3209   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
3210   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
3211   /* Cleanup points */
3212   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3213   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3214   /* Cleanup array */
3215   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3216   if (!*values) {
3217     if (csize) *csize = size;
3218     *values = array;
3219   } else {
3220     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3221     *csize = size;
3222   }
3223   PetscFunctionReturn(0);
3224 }
3225 
3226 #undef __FUNCT__
3227 #define __FUNCT__ "DMPlexVecRestoreClosure"
3228 /*@C
3229   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
3230 
3231   Not collective
3232 
3233   Input Parameters:
3234 + dm - The DM
3235 . section - The section describing the layout in v, or NULL to use the default section
3236 . v - The local vector
3237 . point - The sieve point in the DM
3238 . csize - The number of values in the closure, or NULL
3239 - values - The array of values, which is a borrowed array and should not be freed
3240 
3241   Fortran Notes:
3242   Since it returns an array, this routine is only available in Fortran 90, and you must
3243   include petsc.h90 in your code.
3244 
3245   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3246 
3247   Level: intermediate
3248 
3249 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3250 @*/
3251 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3252 {
3253   PetscInt       size = 0;
3254   PetscErrorCode ierr;
3255 
3256   PetscFunctionBegin;
3257   /* Should work without recalculating size */
3258   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
3259   PetscFunctionReturn(0);
3260 }
3261 
3262 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
3263 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
3264 
3265 #undef __FUNCT__
3266 #define __FUNCT__ "updatePoint_private"
3267 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[])
3268 {
3269   PetscInt        cdof;   /* The number of constraints on this point */
3270   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3271   PetscScalar    *a;
3272   PetscInt        off, cind = 0, k;
3273   PetscErrorCode  ierr;
3274 
3275   PetscFunctionBegin;
3276   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3277   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3278   a    = &array[off];
3279   if (!cdof || setBC) {
3280     if (orientation >= 0) {
3281       for (k = 0; k < dof; ++k) {
3282         fuse(&a[k], values[k]);
3283       }
3284     } else {
3285       for (k = 0; k < dof; ++k) {
3286         fuse(&a[k], values[dof-k-1]);
3287       }
3288     }
3289   } else {
3290     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3291     if (orientation >= 0) {
3292       for (k = 0; k < dof; ++k) {
3293         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3294         fuse(&a[k], values[k]);
3295       }
3296     } else {
3297       for (k = 0; k < dof; ++k) {
3298         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3299         fuse(&a[k], values[dof-k-1]);
3300       }
3301     }
3302   }
3303   PetscFunctionReturn(0);
3304 }
3305 
3306 #undef __FUNCT__
3307 #define __FUNCT__ "updatePointBC_private"
3308 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
3309 {
3310   PetscInt        cdof;   /* The number of constraints on this point */
3311   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3312   PetscScalar    *a;
3313   PetscInt        off, cind = 0, k;
3314   PetscErrorCode  ierr;
3315 
3316   PetscFunctionBegin;
3317   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3318   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3319   a    = &array[off];
3320   if (cdof) {
3321     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3322     if (orientation >= 0) {
3323       for (k = 0; k < dof; ++k) {
3324         if ((cind < cdof) && (k == cdofs[cind])) {
3325           fuse(&a[k], values[k]);
3326           ++cind;
3327         }
3328       }
3329     } else {
3330       for (k = 0; k < dof; ++k) {
3331         if ((cind < cdof) && (k == cdofs[cind])) {
3332           fuse(&a[k], values[dof-k-1]);
3333           ++cind;
3334         }
3335       }
3336     }
3337   }
3338   PetscFunctionReturn(0);
3339 }
3340 
3341 #undef __FUNCT__
3342 #define __FUNCT__ "updatePointFields_private"
3343 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[])
3344 {
3345   PetscScalar    *a;
3346   PetscInt        fdof, foff, fcdof, foffset = *offset;
3347   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3348   PetscInt        cind = 0, k, c;
3349   PetscErrorCode  ierr;
3350 
3351   PetscFunctionBegin;
3352   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3353   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3354   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3355   a    = &array[foff];
3356   if (!fcdof || setBC) {
3357     if (o >= 0) {
3358       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
3359     } else {
3360       for (k = fdof/fcomp-1; k >= 0; --k) {
3361         for (c = 0; c < fcomp; ++c) {
3362           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3363         }
3364       }
3365     }
3366   } else {
3367     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3368     if (o >= 0) {
3369       for (k = 0; k < fdof; ++k) {
3370         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
3371         fuse(&a[k], values[foffset+k]);
3372       }
3373     } else {
3374       for (k = fdof/fcomp-1; k >= 0; --k) {
3375         for (c = 0; c < fcomp; ++c) {
3376           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
3377           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3378         }
3379       }
3380     }
3381   }
3382   *offset += fdof;
3383   PetscFunctionReturn(0);
3384 }
3385 
3386 #undef __FUNCT__
3387 #define __FUNCT__ "updatePointFieldsBC_private"
3388 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[])
3389 {
3390   PetscScalar    *a;
3391   PetscInt        fdof, foff, fcdof, foffset = *offset;
3392   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3393   PetscInt        cind = 0, k, c;
3394   PetscErrorCode  ierr;
3395 
3396   PetscFunctionBegin;
3397   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3398   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3399   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3400   a    = &array[foff];
3401   if (fcdof) {
3402     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3403     if (o >= 0) {
3404       for (k = 0; k < fdof; ++k) {
3405         if ((cind < fcdof) && (k == fcdofs[cind])) {
3406           fuse(&a[k], values[foffset+k]);
3407           ++cind;
3408         }
3409       }
3410     } else {
3411       for (k = fdof/fcomp-1; k >= 0; --k) {
3412         for (c = 0; c < fcomp; ++c) {
3413           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
3414             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3415             ++cind;
3416           }
3417         }
3418       }
3419     }
3420   }
3421   *offset += fdof;
3422   PetscFunctionReturn(0);
3423 }
3424 
3425 #undef __FUNCT__
3426 #define __FUNCT__ "DMPlexVecSetClosure_Static"
3427 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3428 {
3429   PetscScalar    *array;
3430   const PetscInt *cone, *coneO;
3431   PetscInt        pStart, pEnd, p, numPoints, off, dof;
3432   PetscErrorCode  ierr;
3433 
3434   PetscFunctionBeginHot;
3435   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3436   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3437   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3438   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3439   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3440   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
3441     const PetscInt cp = !p ? point : cone[p-1];
3442     const PetscInt o  = !p ? 0     : coneO[p-1];
3443 
3444     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
3445     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3446     /* ADD_VALUES */
3447     {
3448       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3449       PetscScalar    *a;
3450       PetscInt        cdof, coff, cind = 0, k;
3451 
3452       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
3453       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
3454       a    = &array[coff];
3455       if (!cdof) {
3456         if (o >= 0) {
3457           for (k = 0; k < dof; ++k) {
3458             a[k] += values[off+k];
3459           }
3460         } else {
3461           for (k = 0; k < dof; ++k) {
3462             a[k] += values[off+dof-k-1];
3463           }
3464         }
3465       } else {
3466         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
3467         if (o >= 0) {
3468           for (k = 0; k < dof; ++k) {
3469             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3470             a[k] += values[off+k];
3471           }
3472         } else {
3473           for (k = 0; k < dof; ++k) {
3474             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3475             a[k] += values[off+dof-k-1];
3476           }
3477         }
3478       }
3479     }
3480   }
3481   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3482   PetscFunctionReturn(0);
3483 }
3484 
3485 #undef __FUNCT__
3486 #define __FUNCT__ "DMPlexVecSetClosure"
3487 /*@C
3488   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
3489 
3490   Not collective
3491 
3492   Input Parameters:
3493 + dm - The DM
3494 . section - The section describing the layout in v, or NULL to use the default section
3495 . v - The local vector
3496 . point - The sieve point in the DM
3497 . values - The array of values
3498 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
3499 
3500   Fortran Notes:
3501   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
3502 
3503   Level: intermediate
3504 
3505 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
3506 @*/
3507 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3508 {
3509   PetscSection    clSection;
3510   IS              clPoints;
3511   PetscScalar    *array;
3512   PetscInt       *points = NULL;
3513   const PetscInt *clp;
3514   PetscInt        depth, numFields, numPoints, p;
3515   PetscErrorCode  ierr;
3516 
3517   PetscFunctionBeginHot;
3518   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3519   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3520   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3521   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3522   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3523   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3524   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
3525     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
3526     PetscFunctionReturn(0);
3527   }
3528   /* Get points */
3529   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3530   if (!clPoints) {
3531     PetscInt pStart, pEnd, q;
3532 
3533     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3534     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3535     /* Compress out points not in the section */
3536     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3537       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3538         points[q*2]   = points[p];
3539         points[q*2+1] = points[p+1];
3540         ++q;
3541       }
3542     }
3543     numPoints = q;
3544   } else {
3545     PetscInt dof, off;
3546 
3547     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3548     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3549     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3550     numPoints = dof/2;
3551     points    = (PetscInt *) &clp[off];
3552   }
3553   /* Get array */
3554   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3555   /* Get values */
3556   if (numFields > 0) {
3557     PetscInt offset = 0, fcomp, f;
3558     for (f = 0; f < numFields; ++f) {
3559       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3560       switch (mode) {
3561       case INSERT_VALUES:
3562         for (p = 0; p < numPoints*2; p += 2) {
3563           const PetscInt point = points[p];
3564           const PetscInt o     = points[p+1];
3565           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
3566         } break;
3567       case INSERT_ALL_VALUES:
3568         for (p = 0; p < numPoints*2; p += 2) {
3569           const PetscInt point = points[p];
3570           const PetscInt o     = points[p+1];
3571           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
3572         } break;
3573       case INSERT_BC_VALUES:
3574         for (p = 0; p < numPoints*2; p += 2) {
3575           const PetscInt point = points[p];
3576           const PetscInt o     = points[p+1];
3577           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
3578         } break;
3579       case ADD_VALUES:
3580         for (p = 0; p < numPoints*2; p += 2) {
3581           const PetscInt point = points[p];
3582           const PetscInt o     = points[p+1];
3583           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
3584         } break;
3585       case ADD_ALL_VALUES:
3586         for (p = 0; p < numPoints*2; p += 2) {
3587           const PetscInt point = points[p];
3588           const PetscInt o     = points[p+1];
3589           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
3590         } break;
3591       default:
3592         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3593       }
3594     }
3595   } else {
3596     PetscInt dof, off;
3597 
3598     switch (mode) {
3599     case INSERT_VALUES:
3600       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3601         PetscInt o = points[p+1];
3602         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3603         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
3604       } break;
3605     case INSERT_ALL_VALUES:
3606       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3607         PetscInt o = points[p+1];
3608         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3609         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
3610       } break;
3611     case INSERT_BC_VALUES:
3612       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3613         PetscInt o = points[p+1];
3614         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3615         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
3616       } break;
3617     case ADD_VALUES:
3618       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3619         PetscInt o = points[p+1];
3620         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3621         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
3622       } break;
3623     case ADD_ALL_VALUES:
3624       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3625         PetscInt o = points[p+1];
3626         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3627         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
3628       } break;
3629     default:
3630       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3631     }
3632   }
3633   /* Cleanup points */
3634   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3635   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3636   /* Cleanup array */
3637   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3638   PetscFunctionReturn(0);
3639 }
3640 
3641 #undef __FUNCT__
3642 #define __FUNCT__ "DMPlexVecSetFieldClosure_Internal"
3643 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, const PetscScalar values[], InsertMode mode)
3644 {
3645   PetscSection    clSection;
3646   IS              clPoints;
3647   PetscScalar    *array;
3648   PetscInt       *points = NULL;
3649   const PetscInt *clp;
3650   PetscInt        numFields, numPoints, p;
3651   PetscInt        offset = 0, fcomp, f;
3652   PetscErrorCode  ierr;
3653 
3654   PetscFunctionBeginHot;
3655   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3656   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3657   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3658   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3659   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3660   /* Get points */
3661   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3662   if (!clPoints) {
3663     PetscInt pStart, pEnd, q;
3664 
3665     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3666     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3667     /* Compress out points not in the section */
3668     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3669       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3670         points[q*2]   = points[p];
3671         points[q*2+1] = points[p+1];
3672         ++q;
3673       }
3674     }
3675     numPoints = q;
3676   } else {
3677     PetscInt dof, off;
3678 
3679     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3680     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3681     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3682     numPoints = dof/2;
3683     points    = (PetscInt *) &clp[off];
3684   }
3685   /* Get array */
3686   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3687   /* Get values */
3688   for (f = 0; f < numFields; ++f) {
3689     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3690     if (!fieldActive[f]) {
3691       for (p = 0; p < numPoints*2; p += 2) {
3692         PetscInt fdof;
3693         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
3694         offset += fdof;
3695       }
3696       continue;
3697     }
3698     switch (mode) {
3699     case INSERT_VALUES:
3700       for (p = 0; p < numPoints*2; p += 2) {
3701         const PetscInt point = points[p];
3702         const PetscInt o     = points[p+1];
3703         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
3704       } break;
3705     case INSERT_ALL_VALUES:
3706       for (p = 0; p < numPoints*2; p += 2) {
3707         const PetscInt point = points[p];
3708         const PetscInt o     = points[p+1];
3709         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
3710         } break;
3711     case INSERT_BC_VALUES:
3712       for (p = 0; p < numPoints*2; p += 2) {
3713         const PetscInt point = points[p];
3714         const PetscInt o     = points[p+1];
3715         updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
3716       } break;
3717     case ADD_VALUES:
3718       for (p = 0; p < numPoints*2; p += 2) {
3719         const PetscInt point = points[p];
3720         const PetscInt o     = points[p+1];
3721         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
3722       } break;
3723     case ADD_ALL_VALUES:
3724       for (p = 0; p < numPoints*2; p += 2) {
3725         const PetscInt point = points[p];
3726         const PetscInt o     = points[p+1];
3727         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
3728       } break;
3729     default:
3730       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3731     }
3732   }
3733   /* Cleanup points */
3734   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3735   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3736   /* Cleanup array */
3737   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3738   PetscFunctionReturn(0);
3739 }
3740 
3741 #undef __FUNCT__
3742 #define __FUNCT__ "DMPlexPrintMatSetValues"
3743 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
3744 {
3745   PetscMPIInt    rank;
3746   PetscInt       i, j;
3747   PetscErrorCode ierr;
3748 
3749   PetscFunctionBegin;
3750   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
3751   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
3752   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
3753   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
3754   numCIndices = numCIndices ? numCIndices : numRIndices;
3755   for (i = 0; i < numRIndices; i++) {
3756     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
3757     for (j = 0; j < numCIndices; j++) {
3758 #if defined(PETSC_USE_COMPLEX)
3759       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
3760 #else
3761       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
3762 #endif
3763     }
3764     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
3765   }
3766   PetscFunctionReturn(0);
3767 }
3768 
3769 #undef __FUNCT__
3770 #define __FUNCT__ "indicesPoint_private"
3771 /* . off - The global offset of this point */
3772 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
3773 {
3774   PetscInt        dof;    /* The number of unknowns on this point */
3775   PetscInt        cdof;   /* The number of constraints on this point */
3776   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3777   PetscInt        cind = 0, k;
3778   PetscErrorCode  ierr;
3779 
3780   PetscFunctionBegin;
3781   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3782   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3783   if (!cdof || setBC) {
3784     if (orientation >= 0) {
3785       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
3786     } else {
3787       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
3788     }
3789   } else {
3790     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3791     if (orientation >= 0) {
3792       for (k = 0; k < dof; ++k) {
3793         if ((cind < cdof) && (k == cdofs[cind])) {
3794           /* Insert check for returning constrained indices */
3795           indices[*loff+k] = -(off+k+1);
3796           ++cind;
3797         } else {
3798           indices[*loff+k] = off+k-cind;
3799         }
3800       }
3801     } else {
3802       for (k = 0; k < dof; ++k) {
3803         if ((cind < cdof) && (k == cdofs[cind])) {
3804           /* Insert check for returning constrained indices */
3805           indices[*loff+dof-k-1] = -(off+k+1);
3806           ++cind;
3807         } else {
3808           indices[*loff+dof-k-1] = off+k-cind;
3809         }
3810       }
3811     }
3812   }
3813   *loff += dof;
3814   PetscFunctionReturn(0);
3815 }
3816 
3817 #undef __FUNCT__
3818 #define __FUNCT__ "indicesPointFields_private"
3819 /* . off - The global offset of this point */
3820 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
3821 {
3822   PetscInt       numFields, foff, f;
3823   PetscErrorCode ierr;
3824 
3825   PetscFunctionBegin;
3826   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3827   for (f = 0, foff = 0; f < numFields; ++f) {
3828     PetscInt        fdof, fcomp, cfdof;
3829     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3830     PetscInt        cind = 0, k, c;
3831 
3832     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3833     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3834     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
3835     if (!cfdof || setBC) {
3836       if (orientation >= 0) {
3837         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
3838       } else {
3839         for (k = fdof/fcomp-1; k >= 0; --k) {
3840           for (c = 0; c < fcomp; ++c) {
3841             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
3842           }
3843         }
3844       }
3845     } else {
3846       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3847       if (orientation >= 0) {
3848         for (k = 0; k < fdof; ++k) {
3849           if ((cind < cfdof) && (k == fcdofs[cind])) {
3850             indices[foffs[f]+k] = -(off+foff+k+1);
3851             ++cind;
3852           } else {
3853             indices[foffs[f]+k] = off+foff+k-cind;
3854           }
3855         }
3856       } else {
3857         for (k = fdof/fcomp-1; k >= 0; --k) {
3858           for (c = 0; c < fcomp; ++c) {
3859             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
3860               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
3861               ++cind;
3862             } else {
3863               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
3864             }
3865           }
3866         }
3867       }
3868     }
3869     foff     += fdof - cfdof;
3870     foffs[f] += fdof;
3871   }
3872   PetscFunctionReturn(0);
3873 }
3874 
3875 #undef __FUNCT__
3876 #define __FUNCT__ "DMPlexAnchorsModifyMat"
3877 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[])
3878 {
3879   Mat             cMat;
3880   PetscSection    aSec, cSec;
3881   IS              aIS;
3882   PetscInt        aStart = -1, aEnd = -1;
3883   const PetscInt  *anchors;
3884   PetscInt        numFields, f, p, q, newP = 0;
3885   PetscInt        newNumPoints = 0, newNumIndices = 0;
3886   PetscInt        *newPoints, *indices, *newIndices;
3887   PetscInt        maxAnchor, maxDof;
3888   PetscInt        newOffsets[32];
3889   PetscInt        *pointMatOffsets[32];
3890   PetscInt        *newPointOffsets[32];
3891   PetscScalar     *pointMat[32];
3892   PetscScalar     *newValues,*tmpValues;
3893   PetscBool       anyConstrained = PETSC_FALSE;
3894   PetscErrorCode  ierr;
3895 
3896   PetscFunctionBegin;
3897   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3898   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3899   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3900 
3901   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
3902   /* if there are point-to-point constraints */
3903   if (aSec) {
3904     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
3905     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
3906     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
3907     /* figure out how many points are going to be in the new element matrix
3908      * (we allow double counting, because it's all just going to be summed
3909      * into the global matrix anyway) */
3910     for (p = 0; p < 2*numPoints; p+=2) {
3911       PetscInt b    = points[p];
3912       PetscInt bDof = 0;
3913 
3914       if (b >= aStart && b < aEnd) {
3915         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
3916       }
3917       if (bDof) {
3918         /* this point is constrained */
3919         /* it is going to be replaced by its anchors */
3920         PetscInt bOff, q;
3921 
3922         anyConstrained = PETSC_TRUE;
3923         newNumPoints  += bDof;
3924         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
3925         for (q = 0; q < bDof; q++) {
3926           PetscInt a = anchors[bOff + q];
3927           PetscInt aDof;
3928 
3929           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
3930           newNumIndices += aDof;
3931           for (f = 0; f < numFields; ++f) {
3932             PetscInt fDof;
3933 
3934             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
3935             newOffsets[f+1] += fDof;
3936           }
3937         }
3938       }
3939       else {
3940         /* this point is not constrained */
3941         newNumPoints++;
3942         ierr           = PetscSectionGetDof(section,b,&bDof);CHKERRQ(ierr);
3943         newNumIndices += bDof;
3944         for (f = 0; f < numFields; ++f) {
3945           PetscInt fDof;
3946 
3947           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
3948           newOffsets[f+1] += fDof;
3949         }
3950       }
3951     }
3952   }
3953   if (!anyConstrained) {
3954     *outNumPoints  = 0;
3955     *outNumIndices = 0;
3956     *outPoints     = NULL;
3957     *outValues     = NULL;
3958     if (aSec) {
3959       ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
3960     }
3961     PetscFunctionReturn(0);
3962   }
3963 
3964   for (f = 1; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
3965 
3966   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", newOffsets[numFields], newNumIndices);
3967 
3968   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
3969 
3970   /* output arrays */
3971   ierr = DMGetWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
3972   ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
3973 
3974   /* workspaces */
3975   ierr = DMGetWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
3976   if (numFields) {
3977     for (f = 0; f < numFields; f++) {
3978       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
3979       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
3980     }
3981   }
3982   else {
3983     ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
3984     ierr = DMGetWorkArray(dm,numPoints,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
3985   }
3986 
3987   /* get workspaces for the point-to-point matrices */
3988   if (numFields) {
3989     for (p = 0; p < numPoints; p++) {
3990       PetscInt b    = points[2*p];
3991       PetscInt bDof = 0;
3992 
3993       if (b >= aStart && b < aEnd) {
3994         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
3995       }
3996       if (bDof) {
3997         for (f = 0; f < numFields; f++) {
3998           PetscInt fDof, q, bOff, allFDof = 0;
3999 
4000           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4001           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4002           for (q = 0; q < bDof; q++) {
4003             PetscInt a = anchors[bOff + q];
4004             PetscInt aFDof;
4005 
4006             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4007             allFDof += aFDof;
4008           }
4009           newPointOffsets[f][p+1] = allFDof;
4010           pointMatOffsets[f][p+1] = fDof * allFDof;
4011         }
4012       }
4013       else {
4014         for (f = 0; f < numFields; f++) {
4015           PetscInt fDof;
4016 
4017           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4018           newPointOffsets[f][p+1] = fDof;
4019           pointMatOffsets[f][p+1] = 0;
4020         }
4021       }
4022     }
4023     for (f = 0; f < numFields; f++) {
4024       newPointOffsets[f][0] = 0;
4025       pointMatOffsets[f][0] = 0;
4026       for (p = 0; p < numPoints; p++) {
4027         newPointOffsets[f][p+1] += newPointOffsets[f][p];
4028         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
4029       }
4030       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4031     }
4032   }
4033   else {
4034     for (p = 0; p < numPoints; p++) {
4035       PetscInt b    = points[2*p];
4036       PetscInt bDof = 0;
4037 
4038       if (b >= aStart && b < aEnd) {
4039         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4040       }
4041       if (bDof) {
4042         PetscInt dof, bOff, q, allDof = 0;
4043 
4044         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4045         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4046         for (q = 0; q < bDof; q++) {
4047           PetscInt a = anchors[bOff + q], aDof;
4048 
4049           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
4050           allDof += aDof;
4051         }
4052         newPointOffsets[0][p+1] = allDof;
4053         pointMatOffsets[0][p+1] = dof * allDof;
4054       }
4055       else {
4056         PetscInt dof;
4057 
4058         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4059         newPointOffsets[0][p+1] = dof;
4060         pointMatOffsets[0][p+1] = 0;
4061       }
4062     }
4063     newPointOffsets[0][0] = 0;
4064     pointMatOffsets[0][0] = 0;
4065     for (p = 0; p < numPoints; p++) {
4066       newPointOffsets[0][p+1] += newPointOffsets[0][p];
4067       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
4068     }
4069     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4070   }
4071 
4072   /* get the point-to-point matrices; construct newPoints */
4073   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
4074   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4075   ierr = DMGetWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4076   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4077   if (numFields) {
4078     for (p = 0, newP = 0; p < numPoints; p++) {
4079       PetscInt b    = points[2*p];
4080       PetscInt o    = points[2*p+1];
4081       PetscInt bDof = 0;
4082 
4083       if (b >= aStart && b < aEnd) {
4084         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4085       }
4086       if (bDof) {
4087         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
4088 
4089         fStart[0] = 0;
4090         fEnd[0]   = 0;
4091         for (f = 0; f < numFields; f++) {
4092           PetscInt fDof;
4093 
4094           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
4095           fStart[f+1] = fStart[f] + fDof;
4096           fEnd[f+1]   = fStart[f+1];
4097         }
4098         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4099         ierr = indicesPointFields_private(cSec, b, bOff, fEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4100 
4101         fAnchorStart[0] = 0;
4102         fAnchorEnd[0]   = 0;
4103         for (f = 0; f < numFields; f++) {
4104           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
4105 
4106           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
4107           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
4108         }
4109         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4110         for (q = 0; q < bDof; q++) {
4111           PetscInt a = anchors[bOff + q], aOff;
4112 
4113           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4114           newPoints[2*(newP + q)]     = a;
4115           newPoints[2*(newP + q) + 1] = 0;
4116           ierr = PetscSectionGetOffset(section, a, &aOff);
4117           ierr = indicesPointFields_private(section, a, aOff, fAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4118         }
4119         newP += bDof;
4120 
4121         /* get the point-to-point submatrix */
4122         for (f = 0; f < numFields; f++) {
4123           ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
4124         }
4125       }
4126       else {
4127         newPoints[2 * newP]     = b;
4128         newPoints[2 * newP + 1] = o;
4129         newP++;
4130       }
4131     }
4132   } else {
4133     for (p = 0; p < numPoints; p++) {
4134       PetscInt b    = points[2*p];
4135       PetscInt o    = points[2*p+1];
4136       PetscInt bDof = 0;
4137 
4138       if (b >= aStart && b < aEnd) {
4139         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4140       }
4141       if (bDof) {
4142         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
4143 
4144         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4145         ierr = indicesPoint_private(cSec, b, bOff, &bEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4146 
4147         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4148         for (q = 0; q < bDof; q++) {
4149           PetscInt a = anchors[bOff + q], aOff;
4150 
4151           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4152 
4153           newPoints[2*(newP + q)]     = a;
4154           newPoints[2*(newP + q) + 1] = 0;
4155           ierr = PetscSectionGetOffset(section, a, &aOff);
4156           ierr = indicesPoint_private(section, a, aOff, &bAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4157         }
4158         newP += bDof;
4159 
4160         /* get the point-to-point submatrix */
4161         ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
4162       }
4163       else {
4164         newPoints[2 * newP]     = b;
4165         newPoints[2 * newP + 1] = o;
4166         newP++;
4167       }
4168     }
4169   }
4170 
4171   ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
4172   /* multiply constraints on the right */
4173   if (numFields) {
4174     for (f = 0; f < numFields; f++) {
4175       PetscInt oldOff = offsets[f];
4176 
4177       for (p = 0; p < numPoints; p++) {
4178         PetscInt cStart = newPointOffsets[f][p];
4179         PetscInt b      = points[2 * p];
4180         PetscInt c, r, k;
4181         PetscInt dof;
4182 
4183         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4184         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4185           PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
4186           const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
4187 
4188           for (r = 0; r < numIndices; r++) {
4189             for (c = 0; c < nCols; c++) {
4190               for (k = 0; k < dof; k++) {
4191                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4192               }
4193             }
4194           }
4195         }
4196         else {
4197           /* copy this column as is */
4198           for (r = 0; r < numIndices; r++) {
4199             for (c = 0; c < dof; c++) {
4200               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4201             }
4202           }
4203         }
4204         oldOff += dof;
4205       }
4206     }
4207   }
4208   else {
4209     PetscInt oldOff = 0;
4210     for (p = 0; p < numPoints; p++) {
4211       PetscInt cStart = newPointOffsets[0][p];
4212       PetscInt b      = points[2 * p];
4213       PetscInt c, r, k;
4214       PetscInt dof;
4215 
4216       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4217       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4218         PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
4219         const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
4220 
4221         for (r = 0; r < numIndices; r++) {
4222           for (c = 0; c < nCols; c++) {
4223             for (k = 0; k < dof; k++) {
4224               tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4225             }
4226           }
4227         }
4228       }
4229       else {
4230         /* copy this column as is */
4231         for (r = 0; r < numIndices; r++) {
4232           for (c = 0; c < dof; c++) {
4233             tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4234           }
4235         }
4236       }
4237       oldOff += dof;
4238     }
4239   }
4240 
4241   ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
4242   /* multiply constraints transpose on the left */
4243   if (numFields) {
4244     for (f = 0; f < numFields; f++) {
4245       PetscInt oldOff = offsets[f];
4246 
4247       for (p = 0; p < numPoints; p++) {
4248         PetscInt rStart = newPointOffsets[f][p];
4249         PetscInt b      = points[2 * p];
4250         PetscInt c, r, k;
4251         PetscInt dof;
4252 
4253         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4254         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4255           PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
4256           const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
4257 
4258           for (r = 0; r < nRows; r++) {
4259             for (c = 0; c < newNumIndices; c++) {
4260               for (k = 0; k < dof; k++) {
4261                 newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4262               }
4263             }
4264           }
4265         }
4266         else {
4267           /* copy this row as is */
4268           for (r = 0; r < dof; r++) {
4269             for (c = 0; c < newNumIndices; c++) {
4270               newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4271             }
4272           }
4273         }
4274         oldOff += dof;
4275       }
4276     }
4277   }
4278   else {
4279     PetscInt oldOff = 0;
4280 
4281     for (p = 0; p < numPoints; p++) {
4282       PetscInt rStart = newPointOffsets[0][p];
4283       PetscInt b      = points[2 * p];
4284       PetscInt c, r, k;
4285       PetscInt dof;
4286 
4287       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4288       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4289         PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
4290         const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
4291 
4292         for (r = 0; r < nRows; r++) {
4293           for (c = 0; c < newNumIndices; c++) {
4294             for (k = 0; k < dof; k++) {
4295               newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4296             }
4297           }
4298         }
4299       }
4300       else {
4301         /* copy this row as is */
4302         for (r = 0; r < dof; c++) {
4303           for (c = 0; c < newNumIndices; c++) {
4304             newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4305           }
4306         }
4307       }
4308       oldOff += dof;
4309     }
4310   }
4311 
4312   /* clean up */
4313   ierr = DMRestoreWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4314   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4315   if (numFields) {
4316     for (f = 0; f < numFields; f++) {
4317       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4318       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4319       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4320     }
4321   }
4322   else {
4323     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4324     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4325     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4326   }
4327   ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4328   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
4329 
4330   /* output */
4331   *outNumPoints  = newNumPoints;
4332   *outNumIndices = newNumIndices;
4333   *outPoints     = newPoints;
4334   *outValues     = newValues;
4335   for (f = 0; f < numFields; f++) {
4336     offsets[f] = newOffsets[f];
4337   }
4338   PetscFunctionReturn(0);
4339 }
4340 
4341 #undef __FUNCT__
4342 #define __FUNCT__ "DMPlexMatSetClosure"
4343 /*@C
4344   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
4345 
4346   Not collective
4347 
4348   Input Parameters:
4349 + dm - The DM
4350 . section - The section describing the layout in v, or NULL to use the default section
4351 . globalSection - The section describing the layout in v, or NULL to use the default global section
4352 . A - The matrix
4353 . point - The sieve point in the DM
4354 . values - The array of values
4355 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
4356 
4357   Fortran Notes:
4358   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4359 
4360   Level: intermediate
4361 
4362 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
4363 @*/
4364 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4365 {
4366   DM_Plex        *mesh   = (DM_Plex*) dm->data;
4367   PetscSection    clSection;
4368   IS              clPoints;
4369   PetscInt       *points = NULL, *newPoints;
4370   const PetscInt *clp;
4371   PetscInt       *indices;
4372   PetscInt        offsets[32];
4373   PetscInt        numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
4374   PetscScalar    *newValues;
4375   PetscErrorCode  ierr;
4376 
4377   PetscFunctionBegin;
4378   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4379   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4380   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4381   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
4382   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
4383   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
4384   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4385   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4386   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4387   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
4388   if (!clPoints) {
4389     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4390     /* Compress out points not in the section */
4391     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4392     for (p = 0, q = 0; p < numPoints*2; p += 2) {
4393       if ((points[p] >= pStart) && (points[p] < pEnd)) {
4394         points[q*2]   = points[p];
4395         points[q*2+1] = points[p+1];
4396         ++q;
4397       }
4398     }
4399     numPoints = q;
4400   } else {
4401     PetscInt dof, off;
4402 
4403     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4404     numPoints = dof/2;
4405     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4406     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
4407     points = (PetscInt *) &clp[off];
4408   }
4409   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
4410     PetscInt fdof;
4411 
4412     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4413     for (f = 0; f < numFields; ++f) {
4414       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4415       offsets[f+1] += fdof;
4416     }
4417     numIndices += dof;
4418   }
4419   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
4420 
4421   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
4422   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets);CHKERRQ(ierr);
4423   if (newNumPoints) {
4424     if (!clPoints) {
4425       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4426     } else {
4427       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4428     }
4429     numPoints  = newNumPoints;
4430     numIndices = newNumIndices;
4431     points     = newPoints;
4432     values     = newValues;
4433   }
4434   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4435   if (numFields) {
4436     for (p = 0; p < numPoints*2; p += 2) {
4437       PetscInt o = points[p+1];
4438       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4439       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
4440     }
4441   } else {
4442     for (p = 0, off = 0; p < numPoints*2; p += 2) {
4443       PetscInt o = points[p+1];
4444       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4445       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
4446     }
4447   }
4448   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
4449   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
4450   if (ierr) {
4451     PetscMPIInt    rank;
4452     PetscErrorCode ierr2;
4453 
4454     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4455     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4456     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
4457     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
4458     CHKERRQ(ierr);
4459   }
4460   if (newNumPoints) {
4461     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4462     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4463   }
4464   else {
4465     if (!clPoints) {
4466       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4467     } else {
4468       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4469     }
4470   }
4471   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4472   PetscFunctionReturn(0);
4473 }
4474 
4475 #undef __FUNCT__
4476 #define __FUNCT__ "DMPlexMatSetClosureRefined"
4477 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4478 {
4479   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
4480   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
4481   PetscInt       *cpoints = NULL;
4482   PetscInt       *findices, *cindices;
4483   PetscInt        foffsets[32], coffsets[32];
4484   CellRefiner     cellRefiner;
4485   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4486   PetscErrorCode  ierr;
4487 
4488   PetscFunctionBegin;
4489   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4490   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4491   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4492   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4493   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4494   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4495   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4496   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4497   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4498   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4499   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
4500   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4501   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4502   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4503   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4504   /* Column indices */
4505   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4506   maxFPoints = numCPoints;
4507   /* Compress out points not in the section */
4508   /*   TODO: Squeeze out points with 0 dof as well */
4509   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4510   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4511     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4512       cpoints[q*2]   = cpoints[p];
4513       cpoints[q*2+1] = cpoints[p+1];
4514       ++q;
4515     }
4516   }
4517   numCPoints = q;
4518   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4519     PetscInt fdof;
4520 
4521     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4522     if (!dof) continue;
4523     for (f = 0; f < numFields; ++f) {
4524       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4525       coffsets[f+1] += fdof;
4526     }
4527     numCIndices += dof;
4528   }
4529   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4530   /* Row indices */
4531   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4532   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4533   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4534   for (r = 0, q = 0; r < numSubcells; ++r) {
4535     /* TODO Map from coarse to fine cells */
4536     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4537     /* Compress out points not in the section */
4538     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4539     for (p = 0; p < numFPoints*2; p += 2) {
4540       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4541         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4542         if (!dof) continue;
4543         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4544         if (s < q) continue;
4545         ftotpoints[q*2]   = fpoints[p];
4546         ftotpoints[q*2+1] = fpoints[p+1];
4547         ++q;
4548       }
4549     }
4550     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4551   }
4552   numFPoints = q;
4553   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
4554     PetscInt fdof;
4555 
4556     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
4557     if (!dof) continue;
4558     for (f = 0; f < numFields; ++f) {
4559       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
4560       foffsets[f+1] += fdof;
4561     }
4562     numFIndices += dof;
4563   }
4564   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
4565 
4566   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
4567   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
4568   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4569   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4570   if (numFields) {
4571     for (p = 0; p < numFPoints*2; p += 2) {
4572       PetscInt o = ftotpoints[p+1];
4573       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4574       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
4575     }
4576     for (p = 0; p < numCPoints*2; p += 2) {
4577       PetscInt o = cpoints[p+1];
4578       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4579       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
4580     }
4581   } else {
4582     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
4583       PetscInt o = ftotpoints[p+1];
4584       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4585       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
4586     }
4587     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
4588       PetscInt o = cpoints[p+1];
4589       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4590       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
4591     }
4592   }
4593   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
4594   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
4595   if (ierr) {
4596     PetscMPIInt    rank;
4597     PetscErrorCode ierr2;
4598 
4599     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4600     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4601     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
4602     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
4603     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
4604     CHKERRQ(ierr);
4605   }
4606   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4607   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4608   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4609   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4610   PetscFunctionReturn(0);
4611 }
4612 
4613 #undef __FUNCT__
4614 #define __FUNCT__ "DMPlexMatGetClosureIndicesRefined"
4615 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
4616 {
4617   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
4618   PetscInt      *cpoints = NULL;
4619   PetscInt       foffsets[32], coffsets[32];
4620   CellRefiner    cellRefiner;
4621   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4622   PetscErrorCode ierr;
4623 
4624   PetscFunctionBegin;
4625   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4626   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4627   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4628   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4629   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4630   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4631   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4632   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4633   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4634   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4635   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4636   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4637   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4638   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4639   /* Column indices */
4640   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4641   maxFPoints = numCPoints;
4642   /* Compress out points not in the section */
4643   /*   TODO: Squeeze out points with 0 dof as well */
4644   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4645   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4646     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4647       cpoints[q*2]   = cpoints[p];
4648       cpoints[q*2+1] = cpoints[p+1];
4649       ++q;
4650     }
4651   }
4652   numCPoints = q;
4653   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4654     PetscInt fdof;
4655 
4656     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4657     if (!dof) continue;
4658     for (f = 0; f < numFields; ++f) {
4659       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4660       coffsets[f+1] += fdof;
4661     }
4662     numCIndices += dof;
4663   }
4664   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4665   /* Row indices */
4666   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4667   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4668   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4669   for (r = 0, q = 0; r < numSubcells; ++r) {
4670     /* TODO Map from coarse to fine cells */
4671     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4672     /* Compress out points not in the section */
4673     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4674     for (p = 0; p < numFPoints*2; p += 2) {
4675       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4676         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4677         if (!dof) continue;
4678         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4679         if (s < q) continue;
4680         ftotpoints[q*2]   = fpoints[p];
4681         ftotpoints[q*2+1] = fpoints[p+1];
4682         ++q;
4683       }
4684     }
4685     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4686   }
4687   numFPoints = q;
4688   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
4689     PetscInt fdof;
4690 
4691     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
4692     if (!dof) continue;
4693     for (f = 0; f < numFields; ++f) {
4694       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
4695       foffsets[f+1] += fdof;
4696     }
4697     numFIndices += dof;
4698   }
4699   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
4700 
4701   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
4702   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
4703   if (numFields) {
4704     for (p = 0; p < numFPoints*2; p += 2) {
4705       PetscInt o = ftotpoints[p+1];
4706       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4707       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
4708     }
4709     for (p = 0; p < numCPoints*2; p += 2) {
4710       PetscInt o = cpoints[p+1];
4711       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4712       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
4713     }
4714   } else {
4715     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
4716       PetscInt o = ftotpoints[p+1];
4717       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4718       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
4719     }
4720     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
4721       PetscInt o = cpoints[p+1];
4722       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4723       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
4724     }
4725   }
4726   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4727   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4728   PetscFunctionReturn(0);
4729 }
4730 
4731 #undef __FUNCT__
4732 #define __FUNCT__ "DMPlexGetHybridBounds"
4733 /*@
4734   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
4735 
4736   Input Parameter:
4737 . dm - The DMPlex object
4738 
4739   Output Parameters:
4740 + cMax - The first hybrid cell
4741 . fMax - The first hybrid face
4742 . eMax - The first hybrid edge
4743 - vMax - The first hybrid vertex
4744 
4745   Level: developer
4746 
4747 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
4748 @*/
4749 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
4750 {
4751   DM_Plex       *mesh = (DM_Plex*) dm->data;
4752   PetscInt       dim;
4753   PetscErrorCode ierr;
4754 
4755   PetscFunctionBegin;
4756   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4757   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4758   if (cMax) *cMax = mesh->hybridPointMax[dim];
4759   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
4760   if (eMax) *eMax = mesh->hybridPointMax[1];
4761   if (vMax) *vMax = mesh->hybridPointMax[0];
4762   PetscFunctionReturn(0);
4763 }
4764 
4765 #undef __FUNCT__
4766 #define __FUNCT__ "DMPlexSetHybridBounds"
4767 /*@
4768   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
4769 
4770   Input Parameters:
4771 . dm   - The DMPlex object
4772 . cMax - The first hybrid cell
4773 . fMax - The first hybrid face
4774 . eMax - The first hybrid edge
4775 - vMax - The first hybrid vertex
4776 
4777   Level: developer
4778 
4779 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
4780 @*/
4781 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
4782 {
4783   DM_Plex       *mesh = (DM_Plex*) dm->data;
4784   PetscInt       dim;
4785   PetscErrorCode ierr;
4786 
4787   PetscFunctionBegin;
4788   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4789   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4790   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
4791   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
4792   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
4793   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
4794   PetscFunctionReturn(0);
4795 }
4796 
4797 #undef __FUNCT__
4798 #define __FUNCT__ "DMPlexGetVTKCellHeight"
4799 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
4800 {
4801   DM_Plex *mesh = (DM_Plex*) dm->data;
4802 
4803   PetscFunctionBegin;
4804   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4805   PetscValidPointer(cellHeight, 2);
4806   *cellHeight = mesh->vtkCellHeight;
4807   PetscFunctionReturn(0);
4808 }
4809 
4810 #undef __FUNCT__
4811 #define __FUNCT__ "DMPlexSetVTKCellHeight"
4812 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
4813 {
4814   DM_Plex *mesh = (DM_Plex*) dm->data;
4815 
4816   PetscFunctionBegin;
4817   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4818   mesh->vtkCellHeight = cellHeight;
4819   PetscFunctionReturn(0);
4820 }
4821 
4822 #undef __FUNCT__
4823 #define __FUNCT__ "DMPlexCreateNumbering_Private"
4824 /* We can easily have a form that takes an IS instead */
4825 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
4826 {
4827   PetscSection   section, globalSection;
4828   PetscInt      *numbers, p;
4829   PetscErrorCode ierr;
4830 
4831   PetscFunctionBegin;
4832   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4833   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
4834   for (p = pStart; p < pEnd; ++p) {
4835     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
4836   }
4837   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
4838   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
4839   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
4840   for (p = pStart; p < pEnd; ++p) {
4841     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
4842     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
4843     else                       numbers[p-pStart] += shift;
4844   }
4845   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
4846   if (globalSize) {
4847     PetscLayout layout;
4848     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
4849     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
4850     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
4851   }
4852   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4853   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
4854   PetscFunctionReturn(0);
4855 }
4856 
4857 #undef __FUNCT__
4858 #define __FUNCT__ "DMPlexGetCellNumbering"
4859 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
4860 {
4861   DM_Plex       *mesh = (DM_Plex*) dm->data;
4862   PetscInt       cellHeight, cStart, cEnd, cMax;
4863   PetscErrorCode ierr;
4864 
4865   PetscFunctionBegin;
4866   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4867   if (!mesh->globalCellNumbers) {
4868     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
4869     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
4870     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
4871     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
4872     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
4873   }
4874   *globalCellNumbers = mesh->globalCellNumbers;
4875   PetscFunctionReturn(0);
4876 }
4877 
4878 #undef __FUNCT__
4879 #define __FUNCT__ "DMPlexGetVertexNumbering"
4880 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
4881 {
4882   DM_Plex       *mesh = (DM_Plex*) dm->data;
4883   PetscInt       vStart, vEnd, vMax;
4884   PetscErrorCode ierr;
4885 
4886   PetscFunctionBegin;
4887   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4888   if (!mesh->globalVertexNumbers) {
4889     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4890     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
4891     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
4892     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
4893   }
4894   *globalVertexNumbers = mesh->globalVertexNumbers;
4895   PetscFunctionReturn(0);
4896 }
4897 
4898 #undef __FUNCT__
4899 #define __FUNCT__ "DMPlexCreatePointNumbering"
4900 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
4901 {
4902   IS             nums[4];
4903   PetscInt       depths[4];
4904   PetscInt       depth, d, shift = 0;
4905   PetscErrorCode ierr;
4906 
4907   PetscFunctionBegin;
4908   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4909   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4910   depths[0] = depth; depths[1] = 0;
4911   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
4912   for (d = 0; d <= depth; ++d) {
4913     PetscInt pStart, pEnd, gsize;
4914 
4915     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
4916     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
4917     shift += gsize;
4918   }
4919   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);
4920   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
4921   PetscFunctionReturn(0);
4922 }
4923 
4924 
4925 #undef __FUNCT__
4926 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
4927 /*@C
4928   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
4929   the local section and an SF describing the section point overlap.
4930 
4931   Input Parameters:
4932   + s - The PetscSection for the local field layout
4933   . sf - The SF describing parallel layout of the section points
4934   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
4935   . label - The label specifying the points
4936   - labelValue - The label stratum specifying the points
4937 
4938   Output Parameter:
4939   . gsection - The PetscSection for the global field layout
4940 
4941   Note: This gives negative sizes and offsets to points not owned by this process
4942 
4943   Level: developer
4944 
4945 .seealso: PetscSectionCreate()
4946 @*/
4947 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
4948 {
4949   PetscInt      *neg = NULL, *tmpOff = NULL;
4950   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
4951   PetscErrorCode ierr;
4952 
4953   PetscFunctionBegin;
4954   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) s), gsection);CHKERRQ(ierr);
4955   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
4956   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
4957   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
4958   if (nroots >= 0) {
4959     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
4960     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
4961     if (nroots > pEnd-pStart) {
4962       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
4963     } else {
4964       tmpOff = &(*gsection)->atlasDof[-pStart];
4965     }
4966   }
4967   /* Mark ghost points with negative dof */
4968   for (p = pStart; p < pEnd; ++p) {
4969     PetscInt value;
4970 
4971     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
4972     if (value != labelValue) continue;
4973     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
4974     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
4975     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
4976     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
4977     if (neg) neg[p] = -(dof+1);
4978   }
4979   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
4980   if (nroots >= 0) {
4981     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
4982     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
4983     if (nroots > pEnd-pStart) {
4984       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
4985     }
4986   }
4987   /* Calculate new sizes, get proccess offset, and calculate point offsets */
4988   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
4989     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
4990     (*gsection)->atlasOff[p] = off;
4991     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
4992   }
4993   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) s));CHKERRQ(ierr);
4994   globalOff -= off;
4995   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
4996     (*gsection)->atlasOff[p] += globalOff;
4997     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
4998   }
4999   /* Put in negative offsets for ghost points */
5000   if (nroots >= 0) {
5001     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5002     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5003     if (nroots > pEnd-pStart) {
5004       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
5005     }
5006   }
5007   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
5008   ierr = PetscFree(neg);CHKERRQ(ierr);
5009   PetscFunctionReturn(0);
5010 }
5011 
5012 #undef __FUNCT__
5013 #define __FUNCT__ "DMPlexCheckSymmetry"
5014 /*@
5015   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
5016 
5017   Input Parameters:
5018   + dm - The DMPlex object
5019 
5020   Note: This is a useful diagnostic when creating meshes programmatically.
5021 
5022   Level: developer
5023 
5024 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
5025 @*/
5026 PetscErrorCode DMPlexCheckSymmetry(DM dm)
5027 {
5028   PetscSection    coneSection, supportSection;
5029   const PetscInt *cone, *support;
5030   PetscInt        coneSize, c, supportSize, s;
5031   PetscInt        pStart, pEnd, p, csize, ssize;
5032   PetscErrorCode  ierr;
5033 
5034   PetscFunctionBegin;
5035   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5036   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
5037   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
5038   /* Check that point p is found in the support of its cone points, and vice versa */
5039   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
5040   for (p = pStart; p < pEnd; ++p) {
5041     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
5042     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
5043     for (c = 0; c < coneSize; ++c) {
5044       PetscBool dup = PETSC_FALSE;
5045       PetscInt  d;
5046       for (d = c-1; d >= 0; --d) {
5047         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
5048       }
5049       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
5050       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
5051       for (s = 0; s < supportSize; ++s) {
5052         if (support[s] == p) break;
5053       }
5054       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
5055         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
5056         for (s = 0; s < coneSize; ++s) {
5057           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
5058         }
5059         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5060         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
5061         for (s = 0; s < supportSize; ++s) {
5062           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
5063         }
5064         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5065         if (dup) {
5066           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
5067         } else {
5068           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
5069         }
5070       }
5071     }
5072     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
5073     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
5074     for (s = 0; s < supportSize; ++s) {
5075       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5076       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5077       for (c = 0; c < coneSize; ++c) {
5078         if (cone[c] == p) break;
5079       }
5080       if (c >= coneSize) {
5081         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
5082         for (c = 0; c < supportSize; ++c) {
5083           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
5084         }
5085         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5086         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
5087         for (c = 0; c < coneSize; ++c) {
5088           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
5089         }
5090         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
5091         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
5092       }
5093     }
5094   }
5095   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
5096   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
5097   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
5098   PetscFunctionReturn(0);
5099 }
5100 
5101 #undef __FUNCT__
5102 #define __FUNCT__ "DMPlexCheckSkeleton"
5103 /*@
5104   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
5105 
5106   Input Parameters:
5107 + dm - The DMPlex object
5108 . isSimplex - Are the cells simplices or tensor products
5109 - cellHeight - Normally 0
5110 
5111   Note: This is a useful diagnostic when creating meshes programmatically.
5112 
5113   Level: developer
5114 
5115 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
5116 @*/
5117 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5118 {
5119   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
5120   PetscErrorCode ierr;
5121 
5122   PetscFunctionBegin;
5123   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5124   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5125   switch (dim) {
5126   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
5127   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
5128   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
5129   default:
5130     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
5131   }
5132   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5133   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5134   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5135   cMax = cMax >= 0 ? cMax : cEnd;
5136   for (c = cStart; c < cMax; ++c) {
5137     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5138 
5139     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5140     for (cl = 0; cl < closureSize*2; cl += 2) {
5141       const PetscInt p = closure[cl];
5142       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5143     }
5144     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5145     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
5146   }
5147   for (c = cMax; c < cEnd; ++c) {
5148     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5149 
5150     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5151     for (cl = 0; cl < closureSize*2; cl += 2) {
5152       const PetscInt p = closure[cl];
5153       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5154     }
5155     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5156     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
5157   }
5158   PetscFunctionReturn(0);
5159 }
5160 
5161 #undef __FUNCT__
5162 #define __FUNCT__ "DMPlexCheckFaces"
5163 /*@
5164   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
5165 
5166   Input Parameters:
5167 + dm - The DMPlex object
5168 . isSimplex - Are the cells simplices or tensor products
5169 - cellHeight - Normally 0
5170 
5171   Note: This is a useful diagnostic when creating meshes programmatically.
5172 
5173   Level: developer
5174 
5175 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
5176 @*/
5177 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5178 {
5179   PetscInt       pMax[4];
5180   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
5181   PetscErrorCode ierr;
5182 
5183   PetscFunctionBegin;
5184   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5185   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5186   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5187   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
5188   for (h = cellHeight; h < dim; ++h) {
5189     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
5190     for (c = cStart; c < cEnd; ++c) {
5191       const PetscInt *cone, *ornt, *faces;
5192       PetscInt        numFaces, faceSize, coneSize,f;
5193       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
5194 
5195       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
5196       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
5197       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5198       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5199       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5200       for (cl = 0; cl < closureSize*2; cl += 2) {
5201         const PetscInt p = closure[cl];
5202         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
5203       }
5204       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5205       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
5206       for (f = 0; f < numFaces; ++f) {
5207         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
5208 
5209         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5210         for (cl = 0; cl < fclosureSize*2; cl += 2) {
5211           const PetscInt p = fclosure[cl];
5212           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
5213         }
5214         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);
5215         for (v = 0; v < fnumCorners; ++v) {
5216           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]);
5217         }
5218         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5219       }
5220       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5221       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5222     }
5223   }
5224   PetscFunctionReturn(0);
5225 }
5226 
5227 #undef __FUNCT__
5228 #define __FUNCT__ "DMCreateInterpolation_Plex"
5229 /* Pointwise interpolation
5230      Just code FEM for now
5231      u^f = I u^c
5232      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
5233      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
5234      I_{ij} = psi^f_i phi^c_j
5235 */
5236 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
5237 {
5238   PetscSection   gsc, gsf;
5239   PetscInt       m, n;
5240   void          *ctx;
5241   PetscErrorCode ierr;
5242 
5243   PetscFunctionBegin;
5244   /*
5245   Loop over coarse cells
5246     Loop over coarse basis functions
5247       Loop over fine cells in coarse cell
5248         Loop over fine dual basis functions
5249           Evaluate coarse basis on fine dual basis quad points
5250           Sum
5251           Update local element matrix
5252     Accumulate to interpolation matrix
5253 
5254    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
5255   */
5256   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
5257   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
5258   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
5259   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
5260   /* We need to preallocate properly */
5261   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
5262   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
5263   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
5264   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
5265   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
5266   /* Use naive scaling */
5267   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
5268   PetscFunctionReturn(0);
5269 }
5270 
5271 #undef __FUNCT__
5272 #define __FUNCT__ "DMCreateInjection_Plex"
5273 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
5274 {
5275   PetscErrorCode ierr;
5276 
5277   PetscFunctionBegin;
5278   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, ctx, NULL);CHKERRQ(ierr);
5279   PetscFunctionReturn(0);
5280 }
5281 
5282 #undef __FUNCT__
5283 #define __FUNCT__ "DMCreateDefaultSection_Plex"
5284 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
5285 {
5286   PetscSection   section;
5287   IS            *bcPoints;
5288   PetscBool     *isFE;
5289   PetscInt      *bcFields, *numComp, *numDof;
5290   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
5291   PetscInt       cStart, cEnd, cEndInterior;
5292   PetscErrorCode ierr;
5293 
5294   PetscFunctionBegin;
5295   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
5296   /* FE and FV boundary conditions are handled slightly differently */
5297   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
5298   for (f = 0; f < numFields; ++f) {
5299     PetscObject  obj;
5300     PetscClassId id;
5301 
5302     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5303     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
5304     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
5305     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
5306     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
5307   }
5308   /* Allocate boundary point storage */
5309   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5310   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5311   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5312   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
5313   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
5314   for (bd = 0; bd < numBd; ++bd) {
5315     PetscBool isEssential;
5316     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5317     if (isEssential) ++numBC;
5318   }
5319   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
5320   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
5321   /* Constrain ghost cells for FV */
5322   for (f = 0; f < numFields; ++f) {
5323     PetscInt *newidx, c;
5324 
5325     if (isFE[f] || cEndInterior < 0) continue;
5326     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
5327     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
5328     bcFields[bc] = f;
5329     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5330   }
5331   /* Handle FEM Dirichlet boundaries */
5332   for (bd = 0; bd < numBd; ++bd) {
5333     const char     *bdLabel;
5334     DMLabel         label;
5335     const PetscInt *values;
5336     PetscInt        bd2, field, numValues;
5337     PetscBool       isEssential, duplicate = PETSC_FALSE;
5338 
5339     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
5340     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
5341     /* Only want to modify label once */
5342     for (bd2 = 0; bd2 < bd; ++bd2) {
5343       const char *bdname;
5344       ierr = DMPlexGetBoundary(dm, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5345       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
5346       if (duplicate) break;
5347     }
5348     if (!duplicate && (isFE[field])) {
5349       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
5350       ierr = DMPlexLabelAddCells(dm, label);CHKERRQ(ierr);
5351     }
5352     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
5353     if (isEssential) {
5354       PetscInt       *newidx;
5355       PetscInt        n, newn = 0, p, v;
5356 
5357       bcFields[bc] = field;
5358       for (v = 0; v < numValues; ++v) {
5359         IS              tmp;
5360         const PetscInt *idx;
5361 
5362         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5363         if (!tmp) continue;
5364         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5365         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5366         if (isFE[field]) {
5367           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
5368         } else {
5369           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
5370         }
5371         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5372         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5373       }
5374       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
5375       newn = 0;
5376       for (v = 0; v < numValues; ++v) {
5377         IS              tmp;
5378         const PetscInt *idx;
5379 
5380         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5381         if (!tmp) continue;
5382         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5383         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5384         if (isFE[field]) {
5385           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
5386         } else {
5387           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
5388         }
5389         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5390         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5391       }
5392       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5393     }
5394   }
5395   /* Handle discretization */
5396   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
5397   for (f = 0; f < numFields; ++f) {
5398     PetscObject obj;
5399 
5400     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5401     if (isFE[f]) {
5402       PetscFE         fe = (PetscFE) obj;
5403       const PetscInt *numFieldDof;
5404       PetscInt        d;
5405 
5406       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
5407       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
5408       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
5409     } else {
5410       PetscFV fv = (PetscFV) obj;
5411 
5412       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
5413       numDof[f*(dim+1)+dim] = numComp[f];
5414     }
5415   }
5416   for (f = 0; f < numFields; ++f) {
5417     PetscInt d;
5418     for (d = 1; d < dim; ++d) {
5419       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.");
5420     }
5421   }
5422   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, NULL, &section);CHKERRQ(ierr);
5423   for (f = 0; f < numFields; ++f) {
5424     PetscFE     fe;
5425     const char *name;
5426 
5427     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
5428     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
5429     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
5430   }
5431   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
5432   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5433   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
5434   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
5435   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
5436   ierr = PetscFree(isFE);CHKERRQ(ierr);
5437   PetscFunctionReturn(0);
5438 }
5439 
5440 #undef __FUNCT__
5441 #define __FUNCT__ "DMPlexGetCoarseDM"
5442 /*@
5443   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
5444 
5445   Input Parameter:
5446 . dm - The DMPlex object
5447 
5448   Output Parameter:
5449 . cdm - The coarse DM
5450 
5451   Level: intermediate
5452 
5453 .seealso: DMPlexSetCoarseDM()
5454 @*/
5455 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
5456 {
5457   PetscFunctionBegin;
5458   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5459   PetscValidPointer(cdm, 2);
5460   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
5461   PetscFunctionReturn(0);
5462 }
5463 
5464 #undef __FUNCT__
5465 #define __FUNCT__ "DMPlexSetCoarseDM"
5466 /*@
5467   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
5468 
5469   Input Parameters:
5470 + dm - The DMPlex object
5471 - cdm - The coarse DM
5472 
5473   Level: intermediate
5474 
5475 .seealso: DMPlexGetCoarseDM()
5476 @*/
5477 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
5478 {
5479   DM_Plex       *mesh;
5480   PetscErrorCode ierr;
5481 
5482   PetscFunctionBegin;
5483   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5484   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
5485   mesh = (DM_Plex *) dm->data;
5486   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
5487   mesh->coarseMesh = cdm;
5488   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
5489   PetscFunctionReturn(0);
5490 }
5491 
5492 /* anchors */
5493 #undef __FUNCT__
5494 #define __FUNCT__ "DMPlexGetAnchors"
5495 /*@
5496   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
5497   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
5498 
5499   not collective
5500 
5501   Input Parameters:
5502 . dm - The DMPlex object
5503 
5504   Output Parameters:
5505 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
5506 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
5507 
5508 
5509   Level: intermediate
5510 
5511 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
5512 @*/
5513 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
5514 {
5515   DM_Plex *plex = (DM_Plex *)dm->data;
5516   PetscErrorCode ierr;
5517 
5518   PetscFunctionBegin;
5519   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5520   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
5521   if (anchorSection) *anchorSection = plex->anchorSection;
5522   if (anchorIS) *anchorIS = plex->anchorIS;
5523   PetscFunctionReturn(0);
5524 }
5525 
5526 #undef __FUNCT__
5527 #define __FUNCT__ "DMPlexSetAnchors"
5528 /*@
5529   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
5530   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
5531   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
5532 
5533   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
5534   DMGetConstraints() and filling in the entries in the constraint matrix.
5535 
5536   collective on dm
5537 
5538   Input Parameters:
5539 + dm - The DMPlex object
5540 . 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).
5541 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
5542 
5543   The reference counts of anchorSection and anchorIS are incremented.
5544 
5545   Level: intermediate
5546 
5547 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
5548 @*/
5549 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
5550 {
5551   DM_Plex *plex = (DM_Plex *)dm->data;
5552   PetscMPIInt result;
5553   PetscErrorCode ierr;
5554 
5555   PetscFunctionBegin;
5556   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5557   if (anchorSection) {
5558     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
5559     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
5560     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
5561   }
5562   if (anchorIS) {
5563     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
5564     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
5565     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
5566   }
5567 
5568   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
5569   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
5570   plex->anchorSection = anchorSection;
5571 
5572   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
5573   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
5574   plex->anchorIS = anchorIS;
5575 
5576 #if defined(PETSC_USE_DEBUG)
5577   if (anchorIS && anchorSection) {
5578     PetscInt size, a, pStart, pEnd;
5579     const PetscInt *anchors;
5580 
5581     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5582     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
5583     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
5584     for (a = 0; a < size; a++) {
5585       PetscInt p;
5586 
5587       p = anchors[a];
5588       if (p >= pStart && p < pEnd) {
5589         PetscInt dof;
5590 
5591         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5592         if (dof) {
5593           PetscErrorCode ierr2;
5594 
5595           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
5596           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %d cannot be constrained and an anchor",p);
5597         }
5598       }
5599     }
5600     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
5601   }
5602 #endif
5603   /* reset the generic constraints */
5604   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
5605   PetscFunctionReturn(0);
5606 }
5607 
5608 #undef __FUNCT__
5609 #define __FUNCT__ "DMPlexCreateConstraintSection_Anchors"
5610 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
5611 {
5612   PetscSection anchorSection;
5613   PetscInt pStart, pEnd, p, dof, numFields, f;
5614   PetscErrorCode ierr;
5615 
5616   PetscFunctionBegin;
5617   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5618   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
5619   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
5620   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5621   ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
5622   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5623   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
5624   for (p = pStart; p < pEnd; p++) {
5625     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5626     if (dof) {
5627       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
5628       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
5629       for (f = 0; f < numFields; f++) {
5630         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
5631         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
5632       }
5633     }
5634   }
5635   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
5636   PetscFunctionReturn(0);
5637 }
5638 
5639 #undef __FUNCT__
5640 #define __FUNCT__ "DMPlexCreateConstraintMatrix_Anchors"
5641 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
5642 {
5643   PetscSection aSec;
5644   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
5645   const PetscInt *anchors;
5646   PetscInt numFields, f;
5647   IS aIS;
5648   PetscErrorCode ierr;
5649 
5650   PetscFunctionBegin;
5651   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5652   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
5653   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
5654   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
5655   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
5656   ierr = MatSetType(*cMat,MATSEQAIJ);
5657   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
5658   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5659   ierr = PetscSectionGetChart(aSec,&pStart,&pEnd);CHKERRQ(ierr);
5660   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
5661   i[0] = 0;
5662   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5663   for (p = pStart; p < pEnd; p++) {
5664     ierr = PetscSectionGetDof(aSec,p,&dof);CHKERRQ(ierr);
5665     if (!dof) continue;
5666     ierr = PetscSectionGetOffset(aSec,p,&off);CHKERRQ(ierr);
5667     if (numFields) {
5668       for (f = 0; f < numFields; f++) {
5669         annz = 0;
5670         for (q = 0; q < dof; q++) {
5671           a = anchors[off + q];
5672           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
5673           annz += aDof;
5674         }
5675         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
5676         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
5677         for (q = 0; q < dof; q++) {
5678           i[off + q + 1] = i[off + q] + annz;
5679         }
5680       }
5681     }
5682     else {
5683       annz = 0;
5684       for (q = 0; q < dof; q++) {
5685         a = anchors[off + q];
5686         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5687         annz += aDof;
5688       }
5689       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
5690       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
5691       for (q = 0; q < dof; q++) {
5692         i[off + q + 1] = i[off + q] + annz;
5693       }
5694     }
5695   }
5696   nnz = i[m];
5697   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
5698   offset = 0;
5699   for (p = pStart; p < pEnd; p++) {
5700     if (numFields) {
5701       for (f = 0; f < numFields; f++) {
5702         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
5703         for (q = 0; q < dof; q++) {
5704           PetscInt rDof, rOff, r;
5705           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
5706           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
5707           for (r = 0; r < rDof; r++) {
5708             PetscInt s;
5709 
5710             a = anchors[rOff + r];
5711 
5712             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
5713             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
5714             for (s = 0; s < aDof; s++) {
5715               j[offset++] = aOff + s;
5716             }
5717           }
5718         }
5719       }
5720     }
5721     else {
5722       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
5723       for (q = 0; q < dof; q++) {
5724         PetscInt rDof, rOff, r;
5725         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
5726         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
5727         for (r = 0; r < rDof; r++) {
5728           PetscInt s;
5729 
5730           a = anchors[rOff + r];
5731 
5732           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5733           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
5734           for (s = 0; s < aDof; s++) {
5735             j[offset++] = aOff + s;
5736           }
5737         }
5738       }
5739     }
5740   }
5741   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
5742   ierr = PetscFree2(i,j);CHKERRQ(ierr);
5743   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5744   PetscFunctionReturn(0);
5745 }
5746 
5747 #undef __FUNCT__
5748 #define __FUNCT__ "DMCreateDefaultConstraints_Plex"
5749 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
5750 {
5751   DM_Plex        *plex = (DM_Plex *)dm->data;
5752   PetscSection   anchorSection, section, cSec;
5753   Mat            cMat;
5754   PetscErrorCode ierr;
5755 
5756   PetscFunctionBegin;
5757   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5758   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
5759   if (anchorSection) {
5760     PetscDS  ds;
5761     PetscInt nf;
5762 
5763     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
5764     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
5765     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
5766     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
5767     ierr = PetscDSGetNumFields(ds,&nf);
5768     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
5769     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
5770     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
5771     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
5772   }
5773   PetscFunctionReturn(0);
5774 }
5775