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