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