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