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