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