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