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