xref: /petsc/src/dm/impls/plex/plex.c (revision e6e75211d226c622f451867f53ce5d558649ff4f)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petsc/private/isimpl.h>
3 #include <petscsf.h>
4 #include <petscds.h>
5 
6 /* Logging support */
7 PetscLogEvent DMPLEX_Interpolate, PETSCPARTITIONER_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeOverlap, DMPLEX_DistributeField, DMPLEX_DistributeData, DMPLEX_Migrate, DMPLEX_Stratify, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM, DMPLEX_InterpolatorFEM, DMPLEX_InjectorFEM, DMPLEX_IntegralFEM, DMPLEX_CreateGmsh;
8 
9 PETSC_EXTERN PetscErrorCode VecView_Seq(Vec, PetscViewer);
10 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
11 PETSC_EXTERN PetscErrorCode VecLoad_Default(Vec, PetscViewer);
12 
13 #undef __FUNCT__
14 #define __FUNCT__ "DMPlexGetFieldType_Internal"
15 PetscErrorCode DMPlexGetFieldType_Internal(DM dm, PetscSection section, PetscInt field, PetscInt *sStart, PetscInt *sEnd, PetscViewerVTKFieldType *ft)
16 {
17   PetscInt       dim, pStart, pEnd, vStart, vEnd, cStart, cEnd, cEndInterior, vdof = 0, cdof = 0;
18   PetscErrorCode ierr;
19 
20   PetscFunctionBegin;
21   *ft  = PETSC_VTK_POINT_FIELD;
22   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
23   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
24   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
25   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
26   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
27   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
28   if (field >= 0) {
29     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, vStart, field, &vdof);CHKERRQ(ierr);}
30     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, cStart, field, &cdof);CHKERRQ(ierr);}
31   } else {
32     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vdof);CHKERRQ(ierr);}
33     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &cdof);CHKERRQ(ierr);}
34   }
35   if (vdof) {
36     *sStart = vStart;
37     *sEnd   = vEnd;
38     if (vdof == dim) *ft = PETSC_VTK_POINT_VECTOR_FIELD;
39     else             *ft = PETSC_VTK_POINT_FIELD;
40   } else if (cdof) {
41     *sStart = cStart;
42     *sEnd   = cEnd;
43     if (cdof == dim) *ft = PETSC_VTK_CELL_VECTOR_FIELD;
44     else             *ft = PETSC_VTK_CELL_FIELD;
45   } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Could not classify input Vec for VTK");
46   PetscFunctionReturn(0);
47 }
48 
49 #undef __FUNCT__
50 #define __FUNCT__ "VecView_Plex_Local"
51 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
52 {
53   DM             dm;
54   PetscBool      isvtk, ishdf5, isseq;
55   PetscErrorCode ierr;
56 
57   PetscFunctionBegin;
58   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
59   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
60   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
61   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
62   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
63   if (isvtk || ishdf5) {
64     PetscInt  numFields;
65     PetscBool fem = PETSC_FALSE;
66 
67     ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
68     if (numFields) {
69       PetscObject fe;
70 
71       ierr = DMGetField(dm, 0, &fe);CHKERRQ(ierr);
72       if (fe->classid == PETSCFE_CLASSID) fem = PETSC_TRUE;
73     }
74     if (fem) {ierr = DMPlexInsertBoundaryValues(dm, v, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);}
75   }
76   if (isvtk) {
77     PetscSection            section;
78     PetscViewerVTKFieldType ft;
79     PetscInt                pStart, pEnd;
80 
81     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
82     ierr = DMPlexGetFieldType_Internal(dm, section, PETSC_DETERMINE, &pStart, &pEnd, &ft);CHKERRQ(ierr);
83     ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr); /* viewer drops reference */
84     ierr = PetscObjectReference((PetscObject) v);CHKERRQ(ierr);  /* viewer drops reference */
85     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, ft, (PetscObject) v);CHKERRQ(ierr);
86   } else if (ishdf5) {
87 #if defined(PETSC_HAVE_HDF5)
88     ierr = VecView_Plex_Local_HDF5(v, viewer);CHKERRQ(ierr);
89 #else
90     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
91 #endif
92   } else {
93     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
94     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
95   }
96   PetscFunctionReturn(0);
97 }
98 
99 #undef __FUNCT__
100 #define __FUNCT__ "VecView_Plex"
101 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
102 {
103   DM             dm;
104   PetscBool      isvtk, ishdf5, isseq;
105   PetscErrorCode ierr;
106 
107   PetscFunctionBegin;
108   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
109   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
110   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
111   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
112   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
113   if (isvtk) {
114     Vec         locv;
115     const char *name;
116 
117     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
118     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
119     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
120     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
121     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
122     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
123     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
124   } else if (ishdf5) {
125 #if defined(PETSC_HAVE_HDF5)
126     ierr = VecView_Plex_HDF5(v, viewer);CHKERRQ(ierr);
127 #else
128     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
129 #endif
130   } else {
131     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
132     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
133   }
134   PetscFunctionReturn(0);
135 }
136 
137 #undef __FUNCT__
138 #define __FUNCT__ "VecLoad_Plex_Local"
139 PetscErrorCode VecLoad_Plex_Local(Vec v, PetscViewer viewer)
140 {
141   DM             dm;
142   PetscBool      ishdf5;
143   PetscErrorCode ierr;
144 
145   PetscFunctionBegin;
146   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
147   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
148   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
149   if (ishdf5) {
150     DM          dmBC;
151     Vec         gv;
152     const char *name;
153 
154     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
155     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
156     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
157     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
158     ierr = VecLoad_Default(gv, viewer);CHKERRQ(ierr);
159     ierr = DMGlobalToLocalBegin(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
160     ierr = DMGlobalToLocalEnd(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
161     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
162   } else {
163     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
164   }
165   PetscFunctionReturn(0);
166 }
167 
168 #undef __FUNCT__
169 #define __FUNCT__ "VecLoad_Plex"
170 PetscErrorCode VecLoad_Plex(Vec v, PetscViewer viewer)
171 {
172   DM             dm;
173   PetscBool      ishdf5;
174   PetscErrorCode ierr;
175 
176   PetscFunctionBegin;
177   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
178   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
179   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
180   if (ishdf5) {
181 #if defined(PETSC_HAVE_HDF5)
182     ierr = VecLoad_Plex_HDF5(v, viewer);CHKERRQ(ierr);
183 #else
184     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
185 #endif
186   } else {
187     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
188   }
189   PetscFunctionReturn(0);
190 }
191 
192 #undef __FUNCT__
193 #define __FUNCT__ "DMPlexView_Ascii_Geometry"
194 PetscErrorCode DMPlexView_Ascii_Geometry(DM dm, PetscViewer viewer)
195 {
196   PetscSection       coordSection;
197   Vec                coordinates;
198   DMLabel            depthLabel;
199   const char        *name[4];
200   const PetscScalar *a;
201   PetscInt           dim, pStart, pEnd, cStart, cEnd, c;
202   PetscErrorCode     ierr;
203 
204   PetscFunctionBegin;
205   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
206   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
207   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
208   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
209   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
210   ierr = PetscSectionGetChart(coordSection, &pStart, &pEnd);CHKERRQ(ierr);
211   ierr = VecGetArrayRead(coordinates, &a);CHKERRQ(ierr);
212   name[0]     = "vertex";
213   name[1]     = "edge";
214   name[dim-1] = "face";
215   name[dim]   = "cell";
216   for (c = cStart; c < cEnd; ++c) {
217     PetscInt *closure = NULL;
218     PetscInt  closureSize, cl;
219 
220     ierr = PetscViewerASCIIPrintf(viewer, "Geometry for cell %d:\n", c);CHKERRQ(ierr);
221     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
222     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
223     for (cl = 0; cl < closureSize*2; cl += 2) {
224       PetscInt point = closure[cl], depth, dof, off, d, p;
225 
226       if ((point < pStart) || (point >= pEnd)) continue;
227       ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
228       if (!dof) continue;
229       ierr = DMLabelGetValue(depthLabel, point, &depth);CHKERRQ(ierr);
230       ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
231       ierr = PetscViewerASCIIPrintf(viewer, "%s %d coords:", name[depth], point);CHKERRQ(ierr);
232       for (p = 0; p < dof/dim; ++p) {
233         ierr = PetscViewerASCIIPrintf(viewer, " (");CHKERRQ(ierr);
234         for (d = 0; d < dim; ++d) {
235           if (d > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
236           ierr = PetscViewerASCIIPrintf(viewer, "%g", PetscRealPart(a[off+p*dim+d]));CHKERRQ(ierr);
237         }
238         ierr = PetscViewerASCIIPrintf(viewer, ")");CHKERRQ(ierr);
239       }
240       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
241     }
242     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
243     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
244   }
245   ierr = VecRestoreArrayRead(coordinates, &a);CHKERRQ(ierr);
246   PetscFunctionReturn(0);
247 }
248 
249 #undef __FUNCT__
250 #define __FUNCT__ "DMPlexView_Ascii"
251 PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
252 {
253   DM_Plex          *mesh = (DM_Plex*) dm->data;
254   DM                cdm;
255   DMLabel           markers;
256   PetscSection      coordSection;
257   Vec               coordinates;
258   PetscViewerFormat format;
259   PetscErrorCode    ierr;
260 
261   PetscFunctionBegin;
262   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
263   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
264   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
265   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
266   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
267     const char *name;
268     PetscInt    maxConeSize, maxSupportSize;
269     PetscInt    pStart, pEnd, p;
270     PetscMPIInt rank, size;
271 
272     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
273     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
274     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
275     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
276     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
277     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
278     ierr = PetscViewerASCIIPrintf(viewer, "Mesh '%s':\n", name);CHKERRQ(ierr);
279     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "Max sizes cone: %D support: %D\n", maxConeSize, maxSupportSize);CHKERRQ(ierr);
280     ierr = PetscViewerASCIIPrintf(viewer, "orientation is missing\n", name);CHKERRQ(ierr);
281     ierr = PetscViewerASCIIPrintf(viewer, "cap --> base:\n", name);CHKERRQ(ierr);
282     for (p = pStart; p < pEnd; ++p) {
283       PetscInt dof, off, s;
284 
285       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
286       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
287       for (s = off; s < off+dof; ++s) {
288         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
289       }
290     }
291     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
292     ierr = PetscViewerASCIIPrintf(viewer, "base <-- cap:\n", name);CHKERRQ(ierr);
293     for (p = pStart; p < pEnd; ++p) {
294       PetscInt dof, off, c;
295 
296       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
297       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
298       for (c = off; c < off+dof; ++c) {
299         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
300       }
301     }
302     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
303     ierr = PetscSectionGetChart(coordSection, &pStart, NULL);CHKERRQ(ierr);
304     if (pStart >= 0) {ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);}
305     ierr = DMPlexGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
306     ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);
307     if (size > 1) {
308       PetscSF sf;
309 
310       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
311       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
312     }
313     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
314   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
315     const char  *name, *color;
316     const char  *defcolors[3]  = {"gray", "orange", "green"};
317     const char  *deflcolors[4] = {"blue", "cyan", "red", "magenta"};
318     PetscReal    scale         = 2.0;
319     PetscBool    useNumbers    = PETSC_TRUE, useLabels, useColors;
320     double       tcoords[3];
321     PetscScalar *coords;
322     PetscInt     numLabels, l, numColors, numLColors, dim, depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
323     PetscMPIInt  rank, size;
324     char         **names, **colors, **lcolors;
325 
326     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
327     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
328     ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
329     numLabels  = PetscMax(numLabels, 10);
330     numColors  = 10;
331     numLColors = 10;
332     ierr = PetscCalloc3(numLabels, &names, numColors, &colors, numLColors, &lcolors);CHKERRQ(ierr);
333     ierr = PetscOptionsGetReal(((PetscObject) viewer)->prefix, "-dm_plex_view_scale", &scale, NULL);CHKERRQ(ierr);
334     ierr = PetscOptionsGetBool(((PetscObject) viewer)->prefix, "-dm_plex_view_numbers", &useNumbers, NULL);CHKERRQ(ierr);
335     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->prefix, "-dm_plex_view_labels", names, &numLabels, &useLabels);CHKERRQ(ierr);
336     if (!useLabels) numLabels = 0;
337     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->prefix, "-dm_plex_view_colors", colors, &numColors, &useColors);CHKERRQ(ierr);
338     if (!useColors) {
339       numColors = 3;
340       for (c = 0; c < numColors; ++c) {ierr = PetscStrallocpy(defcolors[c], &colors[c]);CHKERRQ(ierr);}
341     }
342     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->prefix, "-dm_plex_view_lcolors", lcolors, &numLColors, &useColors);CHKERRQ(ierr);
343     if (!useColors) {
344       numLColors = 4;
345       for (c = 0; c < numLColors; ++c) {ierr = PetscStrallocpy(deflcolors[c], &lcolors[c]);CHKERRQ(ierr);}
346     }
347     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
348     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
349     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
350     ierr = PetscViewerASCIISynchronizedAllow(viewer, PETSC_TRUE);CHKERRQ(ierr);
351     ierr = PetscViewerASCIIPrintf(viewer, "\
352 \\documentclass[tikz]{standalone}\n\n\
353 \\usepackage{pgflibraryshapes}\n\
354 \\usetikzlibrary{backgrounds}\n\
355 \\usetikzlibrary{arrows}\n\
356 \\begin{document}\n");CHKERRQ(ierr);
357     if (size > 1) {
358       ierr = PetscViewerASCIIPrintf(viewer, "%s for process ", name);CHKERRQ(ierr);
359       for (p = 0; p < size; ++p) {
360         if (p > 0 && p == size-1) {
361           ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
362         } else if (p > 0) {
363           ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
364         }
365         ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
366       }
367       ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n");CHKERRQ(ierr);
368     }
369     ierr = PetscViewerASCIIPrintf(viewer, "\\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n", 1.0);CHKERRQ(ierr);
370     /* Plot vertices */
371     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
372     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
373     for (v = vStart; v < vEnd; ++v) {
374       PetscInt  off, dof, d;
375       PetscBool isLabeled = PETSC_FALSE;
376 
377       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
378       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
379       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
380       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->comps);CHKERRQ(ierr);
629     ierr = PetscFree(b->ids);CHKERRQ(ierr);
630     ierr = PetscFree(b->name);CHKERRQ(ierr);
631     ierr = PetscFree(b->labelname);CHKERRQ(ierr);
632     ierr = PetscFree(b);CHKERRQ(ierr);
633   }
634   PetscFunctionReturn(0);
635 }
636 
637 #undef __FUNCT__
638 #define __FUNCT__ "DMDestroy_Plex"
639 PetscErrorCode DMDestroy_Plex(DM dm)
640 {
641   DM_Plex       *mesh = (DM_Plex*) dm->data;
642   PlexLabel      next = mesh->labels;
643   PetscErrorCode ierr;
644 
645   PetscFunctionBegin;
646   if (--mesh->refct > 0) PetscFunctionReturn(0);
647   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
648   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
649   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
650   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
651   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
652   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
653   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
654   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
655   ierr = PetscPartitionerDestroy(&mesh->partitioner);CHKERRQ(ierr);
656   while (next) {
657     PlexLabel tmp = next->next;
658 
659     ierr = DMLabelDestroy(&next->label);CHKERRQ(ierr);
660     ierr = PetscFree(next);CHKERRQ(ierr);
661     next = tmp;
662   }
663   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
664   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
665   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
666   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
667   ierr = BoundaryDestroy(&mesh->boundary);CHKERRQ(ierr);
668   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
669   ierr = ISDestroy(&mesh->anchorIS);CHKERRQ(ierr);
670   ierr = PetscSectionDestroy(&mesh->parentSection);CHKERRQ(ierr);
671   ierr = PetscFree(mesh->parents);CHKERRQ(ierr);
672   ierr = PetscFree(mesh->childIDs);CHKERRQ(ierr);
673   ierr = PetscSectionDestroy(&mesh->childSection);CHKERRQ(ierr);
674   ierr = PetscFree(mesh->children);CHKERRQ(ierr);
675   ierr = DMDestroy(&mesh->referenceTree);CHKERRQ(ierr);
676   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
677   ierr = PetscFree(mesh);CHKERRQ(ierr);
678   PetscFunctionReturn(0);
679 }
680 
681 #undef __FUNCT__
682 #define __FUNCT__ "DMCreateMatrix_Plex"
683 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
684 {
685   PetscSection   sectionGlobal;
686   PetscInt       bs = -1;
687   PetscInt       localSize;
688   PetscBool      isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock;
689   PetscErrorCode ierr;
690   MatType        mtype;
691   ISLocalToGlobalMapping ltog;
692 
693   PetscFunctionBegin;
694   ierr = MatInitializePackage();CHKERRQ(ierr);
695   mtype = dm->mattype;
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, 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 #undef __FUNCT__
2534 #define __FUNCT__ "DMPlexLocalizeCoordinateReal_Internal"
2535 PetscErrorCode DMPlexLocalizeCoordinateReal_Internal(DM dm, PetscInt dim, const PetscReal anchor[], const PetscReal in[], PetscReal out[])
2536 {
2537   PetscInt d;
2538 
2539   PetscFunctionBegin;
2540   if (!dm->maxCell) {
2541     for (d = 0; d < dim; ++d) out[d] = in[d];
2542   } else {
2543     for (d = 0; d < dim; ++d) {
2544       if (PetscAbsReal(anchor[d] - in[d]) > dm->maxCell[d]) {
2545         out[d] = anchor[d] > in[d] ? dm->L[d] + in[d] : in[d] - dm->L[d];
2546       } else {
2547         out[d] = in[d];
2548       }
2549     }
2550   }
2551   PetscFunctionReturn(0);
2552 }
2553 
2554 #undef __FUNCT__
2555 #define __FUNCT__ "DMPlexLocalizeAddCoordinate_Internal"
2556 /*
2557   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.
2558 
2559   Input Parameters:
2560 + dm     - The DM
2561 . dim    - The spatial dimension
2562 . anchor - The anchor point, the input point can be no more than maxCell away from it
2563 . in     - The input coordinate delta (dim numbers)
2564 - out    - The input coordinate point (dim numbers)
2565 
2566   Output Parameter:
2567 . out    - The localized coordinate in + out
2568 
2569   Level: developer
2570 
2571   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
2572 
2573 .seealso: DMPlexLocalizeCoordinates(), DMPlexLocalizeCoordinate()
2574 */
2575 PetscErrorCode DMPlexLocalizeAddCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
2576 {
2577   PetscInt d;
2578 
2579   PetscFunctionBegin;
2580   if (!dm->maxCell) {
2581     for (d = 0; d < dim; ++d) out[d] += in[d];
2582   } else {
2583     for (d = 0; d < dim; ++d) {
2584       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
2585         out[d] += PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
2586       } else {
2587         out[d] += in[d];
2588       }
2589     }
2590   }
2591   PetscFunctionReturn(0);
2592 }
2593 
2594 #undef __FUNCT__
2595 #define __FUNCT__ "DMPlexLocalizeCoordinates"
2596 /*@
2597   DMPlexLocalizeCoordinates - If a mesh is periodic, create local coordinates for each cell
2598 
2599   Input Parameter:
2600 . dm - The DM
2601 
2602   Level: developer
2603 
2604 .seealso: DMPlexLocalizeCoordinate(), DMPlexLocalizeAddCoordinate()
2605 @*/
2606 PetscErrorCode DMPlexLocalizeCoordinates(DM dm)
2607 {
2608   PetscSection   coordSection, cSection;
2609   Vec            coordinates,  cVec;
2610   PetscScalar   *coords, *coords2, *anchor;
2611   PetscInt       Nc, cStart, cEnd, c, vStart, vEnd, v, dof, d, off, off2, bs, coordSize;
2612   PetscErrorCode ierr;
2613 
2614   PetscFunctionBegin;
2615   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2616   if (!dm->maxCell) PetscFunctionReturn(0);
2617   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2618   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
2619   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2620   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2621   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &cSection);CHKERRQ(ierr);
2622   ierr = PetscSectionSetNumFields(cSection, 1);CHKERRQ(ierr);
2623   ierr = PetscSectionGetFieldComponents(coordSection, 0, &Nc);CHKERRQ(ierr);
2624   ierr = PetscSectionSetFieldComponents(cSection, 0, Nc);CHKERRQ(ierr);
2625   ierr = PetscSectionSetChart(cSection, cStart, vEnd);CHKERRQ(ierr);
2626   for (v = vStart; v < vEnd; ++v) {
2627     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2628     ierr = PetscSectionSetDof(cSection,     v,  dof);CHKERRQ(ierr);
2629     ierr = PetscSectionSetFieldDof(cSection, v, 0, dof);CHKERRQ(ierr);
2630   }
2631   for (c = cStart; c < cEnd; ++c) {
2632     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, NULL);CHKERRQ(ierr);
2633     ierr = PetscSectionSetDof(cSection, c, dof);CHKERRQ(ierr);
2634     ierr = PetscSectionSetFieldDof(cSection, c, 0, dof);CHKERRQ(ierr);
2635   }
2636   ierr = PetscSectionSetUp(cSection);CHKERRQ(ierr);
2637   ierr = PetscSectionGetStorageSize(cSection, &coordSize);CHKERRQ(ierr);
2638   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cVec);CHKERRQ(ierr);
2639   ierr = VecGetBlockSize(coordinates, &bs);CHKERRQ(ierr);
2640   ierr = VecSetBlockSize(cVec,         bs);CHKERRQ(ierr);
2641   ierr = VecSetSizes(cVec, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2642   ierr = VecSetType(cVec,VECSTANDARD);CHKERRQ(ierr);
2643   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
2644   ierr = VecGetArray(cVec,        &coords2);CHKERRQ(ierr);
2645   for (v = vStart; v < vEnd; ++v) {
2646     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
2647     ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
2648     ierr = PetscSectionGetOffset(cSection,     v, &off2);CHKERRQ(ierr);
2649     for (d = 0; d < dof; ++d) coords2[off2+d] = coords[off+d];
2650   }
2651   ierr = DMGetWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2652   for (c = cStart; c < cEnd; ++c) {
2653     PetscScalar *cellCoords = NULL;
2654     PetscInt     b;
2655 
2656     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2657     ierr = PetscSectionGetOffset(cSection, c, &off2);CHKERRQ(ierr);
2658     for (b = 0; b < bs; ++b) anchor[b] = cellCoords[b];
2659     for (d = 0; d < dof/bs; ++d) {ierr = DMPlexLocalizeCoordinate_Internal(dm, bs, anchor, &cellCoords[d*bs], &coords2[off2+d*bs]);CHKERRQ(ierr);}
2660     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
2661   }
2662   ierr = DMRestoreWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
2663   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
2664   ierr = VecRestoreArray(cVec,        &coords2);CHKERRQ(ierr);
2665   ierr = DMSetCoordinateSection(dm, PETSC_DETERMINE, cSection);CHKERRQ(ierr);
2666   ierr = DMSetCoordinatesLocal(dm, cVec);CHKERRQ(ierr);
2667   ierr = VecDestroy(&cVec);CHKERRQ(ierr);
2668   ierr = PetscSectionDestroy(&cSection);CHKERRQ(ierr);
2669   PetscFunctionReturn(0);
2670 }
2671 
2672 #undef __FUNCT__
2673 #define __FUNCT__ "DMPlexGetDepthLabel"
2674 /*@
2675   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
2676 
2677   Not Collective
2678 
2679   Input Parameter:
2680 . dm    - The DMPlex object
2681 
2682   Output Parameter:
2683 . depthLabel - The DMLabel recording point depth
2684 
2685   Level: developer
2686 
2687 .keywords: mesh, points
2688 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2689 @*/
2690 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
2691 {
2692   DM_Plex       *mesh = (DM_Plex*) dm->data;
2693   PetscErrorCode ierr;
2694 
2695   PetscFunctionBegin;
2696   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2697   PetscValidPointer(depthLabel, 2);
2698   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
2699   *depthLabel = mesh->depthLabel;
2700   PetscFunctionReturn(0);
2701 }
2702 
2703 #undef __FUNCT__
2704 #define __FUNCT__ "DMPlexGetDepth"
2705 /*@
2706   DMPlexGetDepth - Get the depth of the DAG representing this mesh
2707 
2708   Not Collective
2709 
2710   Input Parameter:
2711 . dm    - The DMPlex object
2712 
2713   Output Parameter:
2714 . depth - The number of strata (breadth first levels) in the DAG
2715 
2716   Level: developer
2717 
2718 .keywords: mesh, points
2719 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2720 @*/
2721 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
2722 {
2723   DMLabel        label;
2724   PetscInt       d = 0;
2725   PetscErrorCode ierr;
2726 
2727   PetscFunctionBegin;
2728   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2729   PetscValidPointer(depth, 2);
2730   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2731   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
2732   *depth = d-1;
2733   PetscFunctionReturn(0);
2734 }
2735 
2736 #undef __FUNCT__
2737 #define __FUNCT__ "DMPlexGetDepthStratum"
2738 /*@
2739   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
2740 
2741   Not Collective
2742 
2743   Input Parameters:
2744 + dm           - The DMPlex object
2745 - stratumValue - The requested depth
2746 
2747   Output Parameters:
2748 + start - The first point at this depth
2749 - end   - One beyond the last point at this depth
2750 
2751   Level: developer
2752 
2753 .keywords: mesh, points
2754 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
2755 @*/
2756 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2757 {
2758   DMLabel        label;
2759   PetscInt       pStart, pEnd;
2760   PetscErrorCode ierr;
2761 
2762   PetscFunctionBegin;
2763   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2764   if (start) {PetscValidPointer(start, 3); *start = 0;}
2765   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2766   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2767   if (pStart == pEnd) PetscFunctionReturn(0);
2768   if (stratumValue < 0) {
2769     if (start) *start = pStart;
2770     if (end)   *end   = pEnd;
2771     PetscFunctionReturn(0);
2772   }
2773   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2774   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
2775   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
2776   PetscFunctionReturn(0);
2777 }
2778 
2779 #undef __FUNCT__
2780 #define __FUNCT__ "DMPlexGetHeightStratum"
2781 /*@
2782   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
2783 
2784   Not Collective
2785 
2786   Input Parameters:
2787 + dm           - The DMPlex object
2788 - stratumValue - The requested height
2789 
2790   Output Parameters:
2791 + start - The first point at this height
2792 - end   - One beyond the last point at this height
2793 
2794   Level: developer
2795 
2796 .keywords: mesh, points
2797 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
2798 @*/
2799 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2800 {
2801   DMLabel        label;
2802   PetscInt       depth, pStart, pEnd;
2803   PetscErrorCode ierr;
2804 
2805   PetscFunctionBegin;
2806   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2807   if (start) {PetscValidPointer(start, 3); *start = 0;}
2808   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2809   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2810   if (pStart == pEnd) PetscFunctionReturn(0);
2811   if (stratumValue < 0) {
2812     if (start) *start = pStart;
2813     if (end)   *end   = pEnd;
2814     PetscFunctionReturn(0);
2815   }
2816   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2817   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
2818   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
2819   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
2820   PetscFunctionReturn(0);
2821 }
2822 
2823 #undef __FUNCT__
2824 #define __FUNCT__ "DMPlexCreateSectionInitial"
2825 /* Set the number of dof on each point and separate by fields */
2826 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
2827 {
2828   PetscInt      *pMax;
2829   PetscInt       depth, pStart = 0, pEnd = 0;
2830   PetscInt       Nf, p, d, dep, f;
2831   PetscBool     *isFE;
2832   PetscErrorCode ierr;
2833 
2834   PetscFunctionBegin;
2835   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
2836   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2837   for (f = 0; f < numFields; ++f) {
2838     PetscObject  obj;
2839     PetscClassId id;
2840 
2841     isFE[f] = PETSC_FALSE;
2842     if (f >= Nf) continue;
2843     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
2844     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2845     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
2846     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
2847   }
2848   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2849   if (numFields > 0) {
2850     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
2851     if (numComp) {
2852       for (f = 0; f < numFields; ++f) {
2853         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
2854       }
2855     }
2856   }
2857   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2858   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
2859   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2860   ierr = PetscMalloc1(depth+1,&pMax);CHKERRQ(ierr);
2861   ierr = DMPlexGetHybridBounds(dm, depth >= 0 ? &pMax[depth] : NULL, depth>1 ? &pMax[depth-1] : NULL, depth>2 ? &pMax[1] : NULL, &pMax[0]);CHKERRQ(ierr);
2862   for (dep = 0; dep <= depth; ++dep) {
2863     d    = dim == depth ? dep : (!dep ? 0 : dim);
2864     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
2865     pMax[dep] = pMax[dep] < 0 ? pEnd : pMax[dep];
2866     for (p = pStart; p < pEnd; ++p) {
2867       PetscInt tot = 0;
2868 
2869       for (f = 0; f < numFields; ++f) {
2870         if (isFE[f] && p >= pMax[dep]) continue;
2871         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
2872         tot += numDof[f*(dim+1)+d];
2873       }
2874       ierr = PetscSectionSetDof(*section, p, tot);CHKERRQ(ierr);
2875     }
2876   }
2877   ierr = PetscFree(pMax);CHKERRQ(ierr);
2878   ierr = PetscFree(isFE);CHKERRQ(ierr);
2879   PetscFunctionReturn(0);
2880 }
2881 
2882 #undef __FUNCT__
2883 #define __FUNCT__ "DMPlexCreateSectionBCDof"
2884 /* Set the number of dof on each point and separate by fields
2885    If bcComps is NULL or the IS is NULL, constrain every dof on the point
2886 */
2887 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC, const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
2888 {
2889   PetscInt       numFields;
2890   PetscInt       bc;
2891   PetscSection   aSec;
2892   PetscErrorCode ierr;
2893 
2894   PetscFunctionBegin;
2895   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2896   for (bc = 0; bc < numBC; ++bc) {
2897     PetscInt        field = 0;
2898     const PetscInt *comp;
2899     const PetscInt *idx;
2900     PetscInt        Nc = -1, n, i;
2901 
2902     if (numFields) field = bcField[bc];
2903     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
2904     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
2905     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
2906     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2907     for (i = 0; i < n; ++i) {
2908       const PetscInt p = idx[i];
2909       PetscInt       numConst;
2910 
2911       if (numFields) {
2912         ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
2913       } else {
2914         ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
2915       }
2916       /* If Nc < 0, constrain every dof on the point */
2917       if (Nc > 0) numConst = PetscMin(numConst, Nc);
2918       if (numFields) {ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);}
2919       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
2920     }
2921     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2922     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
2923   }
2924   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
2925   if (aSec) {
2926     PetscInt aStart, aEnd, a;
2927 
2928     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
2929     for (a = aStart; a < aEnd; a++) {
2930       PetscInt dof, f;
2931 
2932       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
2933       if (dof) {
2934         /* if there are point-to-point constraints, then all dofs are constrained */
2935         ierr = PetscSectionGetDof(section, a, &dof);CHKERRQ(ierr);
2936         ierr = PetscSectionSetConstraintDof(section, a, dof);CHKERRQ(ierr);
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   PetscFunctionReturn(0);
2945 }
2946 
2947 #undef __FUNCT__
2948 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
2949 /* Set the constrained field indices on each point
2950    If bcComps is NULL or the IS is NULL, constrain every dof on the point
2951 */
2952 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt numBC,const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
2953 {
2954   PetscSection   aSec;
2955   PetscInt      *indices;
2956   PetscInt       numFields, maxDof, pStart, pEnd, p, bc, f, d;
2957   PetscErrorCode ierr;
2958 
2959   PetscFunctionBegin;
2960   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
2961   if (!numFields) PetscFunctionReturn(0);
2962   /* Initialize all field indices to -1 */
2963   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
2964   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
2965   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
2966   for (d = 0; d < maxDof; ++d) indices[d] = -1;
2967   for (p = pStart; p < pEnd; ++p) for (f = 0; f < numFields; ++f) {ierr = PetscSectionSetFieldConstraintIndices(section, p, f, indices);CHKERRQ(ierr);}
2968   /* Handle BC constraints */
2969   for (bc = 0; bc < numBC; ++bc) {
2970     const PetscInt  field = bcField[bc];
2971     const PetscInt *comp, *idx;
2972     PetscInt        Nc = -1, n, i;
2973 
2974     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
2975     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
2976     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
2977     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2978     for (i = 0; i < n; ++i) {
2979       const PetscInt  p = idx[i];
2980       const PetscInt *find;
2981       PetscInt        fcdof, c;
2982 
2983       ierr = PetscSectionGetFieldConstraintDof(section, p, field, &fcdof);CHKERRQ(ierr);
2984       if (Nc < 0) {
2985         for (d = 0; d < fcdof; ++d) indices[d] = d;
2986       } else {
2987         ierr = PetscSectionGetFieldConstraintIndices(section, p, field, &find);CHKERRQ(ierr);
2988         for (d = 0; d < fcdof; ++d) {if (find[d] < 0) break; indices[d] = find[d];}
2989         for (c = 0; c < Nc; ++c) indices[d+c] = comp[c];
2990         ierr = PetscSortInt(d+Nc, indices);CHKERRQ(ierr);
2991         for (c = d+Nc; c < fcdof; ++c) indices[c] = -1;
2992       }
2993       ierr = PetscSectionSetFieldConstraintIndices(section, p, field, indices);CHKERRQ(ierr);
2994     }
2995     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
2996     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
2997   }
2998   /* Handle anchors */
2999   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
3000   if (aSec) {
3001     PetscInt aStart, aEnd, a;
3002 
3003     for (d = 0; d < maxDof; ++d) indices[d] = d;
3004     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
3005     for (a = aStart; a < aEnd; a++) {
3006       PetscInt dof, fdof, f;
3007 
3008       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3009       if (dof) {
3010         /* if there are point-to-point constraints, then all dofs are constrained */
3011         for (f = 0; f < numFields; f++) {
3012           ierr = PetscSectionGetFieldDof(section, a, f, &fdof);CHKERRQ(ierr);
3013           ierr = PetscSectionSetFieldConstraintIndices(section, a, f, indices);CHKERRQ(ierr);
3014         }
3015       }
3016     }
3017   }
3018   ierr = PetscFree(indices);CHKERRQ(ierr);
3019   PetscFunctionReturn(0);
3020 }
3021 
3022 #undef __FUNCT__
3023 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
3024 /* Set the constrained indices on each point */
3025 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
3026 {
3027   PetscInt      *indices;
3028   PetscInt       numFields, maxDof, pStart, pEnd, p, f, d;
3029   PetscErrorCode ierr;
3030 
3031   PetscFunctionBegin;
3032   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3033   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3034   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3035   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3036   for (d = 0; d < maxDof; ++d) indices[d] = -1;
3037   for (p = pStart; p < pEnd; ++p) {
3038     PetscInt cdof, d;
3039 
3040     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3041     if (cdof) {
3042       if (numFields) {
3043         PetscInt numConst = 0, foff = 0;
3044 
3045         for (f = 0; f < numFields; ++f) {
3046           const PetscInt *find;
3047           PetscInt        fcdof, fdof;
3048 
3049           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
3050           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
3051           /* Change constraint numbering from field component to local dof number */
3052           ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &find);CHKERRQ(ierr);
3053           for (d = 0; d < fcdof; ++d) indices[numConst+d] = find[d] + foff;
3054           numConst += fcdof;
3055           foff     += fdof;
3056         }
3057         if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
3058       } else {
3059         for (d = 0; d < cdof; ++d) indices[d] = d;
3060       }
3061       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
3062     }
3063   }
3064   ierr = PetscFree(indices);CHKERRQ(ierr);
3065   PetscFunctionReturn(0);
3066 }
3067 
3068 #undef __FUNCT__
3069 #define __FUNCT__ "DMPlexCreateSection"
3070 /*@C
3071   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
3072 
3073   Not Collective
3074 
3075   Input Parameters:
3076 + dm        - The DMPlex object
3077 . dim       - The spatial dimension of the problem
3078 . numFields - The number of fields in the problem
3079 . numComp   - An array of size numFields that holds the number of components for each field
3080 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
3081 . numBC     - The number of boundary conditions
3082 . bcField   - An array of size numBC giving the field number for each boundry condition
3083 . bcComps   - [Optional] An array of size numBC giving an IS holding the field components to which each boundary condition applies
3084 . bcPoints  - An array of size numBC giving an IS holding the Plex points to which each boundary condition applies
3085 - perm      - Optional permutation of the chart, or NULL
3086 
3087   Output Parameter:
3088 . section - The PetscSection object
3089 
3090   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
3091   number of dof for field 0 on each edge.
3092 
3093   The chart permutation is the same one set using PetscSectionSetPermutation()
3094 
3095   Level: developer
3096 
3097   Fortran Notes:
3098   A Fortran 90 version is available as DMPlexCreateSectionF90()
3099 
3100 .keywords: mesh, elements
3101 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
3102 @*/
3103 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], IS perm, PetscSection *section)
3104 {
3105   PetscSection   aSec;
3106   PetscErrorCode ierr;
3107 
3108   PetscFunctionBegin;
3109   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
3110   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3111   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
3112   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3113   ierr = DMPlexGetAnchors(dm,&aSec,NULL);CHKERRQ(ierr);
3114   if (numBC || aSec) {
3115     ierr = DMPlexCreateSectionBCIndicesField(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3116     ierr = DMPlexCreateSectionBCIndices(dm, *section);CHKERRQ(ierr);
3117   }
3118   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
3119   PetscFunctionReturn(0);
3120 }
3121 
3122 #undef __FUNCT__
3123 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
3124 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3125 {
3126   PetscSection   section;
3127   PetscErrorCode ierr;
3128 
3129   PetscFunctionBegin;
3130   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
3131   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
3132   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
3133   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
3134   PetscFunctionReturn(0);
3135 }
3136 
3137 #undef __FUNCT__
3138 #define __FUNCT__ "DMPlexGetConeSection"
3139 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
3140 {
3141   DM_Plex *mesh = (DM_Plex*) dm->data;
3142 
3143   PetscFunctionBegin;
3144   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3145   if (section) *section = mesh->coneSection;
3146   PetscFunctionReturn(0);
3147 }
3148 
3149 #undef __FUNCT__
3150 #define __FUNCT__ "DMPlexGetSupportSection"
3151 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
3152 {
3153   DM_Plex *mesh = (DM_Plex*) dm->data;
3154 
3155   PetscFunctionBegin;
3156   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3157   if (section) *section = mesh->supportSection;
3158   PetscFunctionReturn(0);
3159 }
3160 
3161 #undef __FUNCT__
3162 #define __FUNCT__ "DMPlexGetCones"
3163 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
3164 {
3165   DM_Plex *mesh = (DM_Plex*) dm->data;
3166 
3167   PetscFunctionBegin;
3168   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3169   if (cones) *cones = mesh->cones;
3170   PetscFunctionReturn(0);
3171 }
3172 
3173 #undef __FUNCT__
3174 #define __FUNCT__ "DMPlexGetConeOrientations"
3175 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
3176 {
3177   DM_Plex *mesh = (DM_Plex*) dm->data;
3178 
3179   PetscFunctionBegin;
3180   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3181   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
3182   PetscFunctionReturn(0);
3183 }
3184 
3185 /******************************** FEM Support **********************************/
3186 
3187 #undef __FUNCT__
3188 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
3189 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3190 {
3191   PetscScalar    *array, *vArray;
3192   const PetscInt *cone, *coneO;
3193   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
3194   PetscErrorCode  ierr;
3195 
3196   PetscFunctionBeginHot;
3197   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3198   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3199   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3200   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3201   if (!values || !*values) {
3202     if ((point >= pStart) && (point < pEnd)) {
3203       PetscInt dof;
3204 
3205       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3206       size += dof;
3207     }
3208     for (p = 0; p < numPoints; ++p) {
3209       const PetscInt cp = cone[p];
3210       PetscInt       dof;
3211 
3212       if ((cp < pStart) || (cp >= pEnd)) continue;
3213       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3214       size += dof;
3215     }
3216     if (!values) {
3217       if (csize) *csize = size;
3218       PetscFunctionReturn(0);
3219     }
3220     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
3221   } else {
3222     array = *values;
3223   }
3224   size = 0;
3225   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3226   if ((point >= pStart) && (point < pEnd)) {
3227     PetscInt     dof, off, d;
3228     PetscScalar *varr;
3229 
3230     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3231     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3232     varr = &vArray[off];
3233     for (d = 0; d < dof; ++d, ++offset) {
3234       array[offset] = varr[d];
3235     }
3236     size += dof;
3237   }
3238   for (p = 0; p < numPoints; ++p) {
3239     const PetscInt cp = cone[p];
3240     PetscInt       o  = coneO[p];
3241     PetscInt       dof, off, d;
3242     PetscScalar   *varr;
3243 
3244     if ((cp < pStart) || (cp >= pEnd)) continue;
3245     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3246     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3247     varr = &vArray[off];
3248     if (o >= 0) {
3249       for (d = 0; d < dof; ++d, ++offset) {
3250         array[offset] = varr[d];
3251       }
3252     } else {
3253       for (d = dof-1; d >= 0; --d, ++offset) {
3254         array[offset] = varr[d];
3255       }
3256     }
3257     size += dof;
3258   }
3259   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3260   if (!*values) {
3261     if (csize) *csize = size;
3262     *values = array;
3263   } else {
3264     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3265     *csize = size;
3266   }
3267   PetscFunctionReturn(0);
3268 }
3269 
3270 #undef __FUNCT__
3271 #define __FUNCT__ "DMPlexVecGetClosure_Static"
3272 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3273 {
3274   PetscInt       offset = 0, p;
3275   PetscErrorCode ierr;
3276 
3277   PetscFunctionBeginHot;
3278   *size = 0;
3279   for (p = 0; p < numPoints*2; p += 2) {
3280     const PetscInt point = points[p];
3281     const PetscInt o     = points[p+1];
3282     PetscInt       dof, off, d;
3283     const PetscScalar *varr;
3284 
3285     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3286     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3287     varr = &vArray[off];
3288     if (o >= 0) {
3289       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
3290     } else {
3291       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
3292     }
3293   }
3294   *size = offset;
3295   PetscFunctionReturn(0);
3296 }
3297 
3298 #undef __FUNCT__
3299 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
3300 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3301 {
3302   PetscInt       offset = 0, f;
3303   PetscErrorCode ierr;
3304 
3305   PetscFunctionBeginHot;
3306   *size = 0;
3307   for (f = 0; f < numFields; ++f) {
3308     PetscInt fcomp, p;
3309 
3310     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3311     for (p = 0; p < numPoints*2; p += 2) {
3312       const PetscInt point = points[p];
3313       const PetscInt o     = points[p+1];
3314       PetscInt       fdof, foff, d, c;
3315       const PetscScalar *varr;
3316 
3317       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3318       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3319       varr = &vArray[foff];
3320       if (o >= 0) {
3321         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
3322       } else {
3323         for (d = fdof/fcomp-1; d >= 0; --d) {
3324           for (c = 0; c < fcomp; ++c, ++offset) {
3325             array[offset] = varr[d*fcomp+c];
3326           }
3327         }
3328       }
3329     }
3330   }
3331   *size = offset;
3332   PetscFunctionReturn(0);
3333 }
3334 
3335 #undef __FUNCT__
3336 #define __FUNCT__ "DMPlexVecGetClosure"
3337 /*@C
3338   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
3339 
3340   Not collective
3341 
3342   Input Parameters:
3343 + dm - The DM
3344 . section - The section describing the layout in v, or NULL to use the default section
3345 . v - The local vector
3346 - point - The sieve point in the DM
3347 
3348   Output Parameters:
3349 + csize - The number of values in the closure, or NULL
3350 - values - The array of values, which is a borrowed array and should not be freed
3351 
3352   Fortran Notes:
3353   Since it returns an array, this routine is only available in Fortran 90, and you must
3354   include petsc.h90 in your code.
3355 
3356   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3357 
3358   Level: intermediate
3359 
3360 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3361 @*/
3362 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3363 {
3364   PetscSection    clSection;
3365   IS              clPoints;
3366   PetscScalar    *array, *vArray;
3367   PetscInt       *points = NULL;
3368   const PetscInt *clp;
3369   PetscInt        depth, numFields, numPoints, size;
3370   PetscErrorCode  ierr;
3371 
3372   PetscFunctionBeginHot;
3373   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3374   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3375   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3376   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3377   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3378   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3379   if (depth == 1 && numFields < 2) {
3380     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
3381     PetscFunctionReturn(0);
3382   }
3383   /* Get points */
3384   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3385   if (!clPoints) {
3386     PetscInt pStart, pEnd, p, q;
3387 
3388     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3389     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3390     /* Compress out points not in the section */
3391     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3392       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3393         points[q*2]   = points[p];
3394         points[q*2+1] = points[p+1];
3395         ++q;
3396       }
3397     }
3398     numPoints = q;
3399   } else {
3400     PetscInt dof, off;
3401 
3402     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3403     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3404     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3405     numPoints = dof/2;
3406     points    = (PetscInt *) &clp[off];
3407   }
3408   /* Get array */
3409   if (!values || !*values) {
3410     PetscInt asize = 0, dof, p;
3411 
3412     for (p = 0; p < numPoints*2; p += 2) {
3413       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3414       asize += dof;
3415     }
3416     if (!values) {
3417       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3418       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3419       if (csize) *csize = asize;
3420       PetscFunctionReturn(0);
3421     }
3422     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
3423   } else {
3424     array = *values;
3425   }
3426   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3427   /* Get values */
3428   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
3429   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
3430   /* Cleanup points */
3431   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3432   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3433   /* Cleanup array */
3434   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3435   if (!*values) {
3436     if (csize) *csize = size;
3437     *values = array;
3438   } else {
3439     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
3440     *csize = size;
3441   }
3442   PetscFunctionReturn(0);
3443 }
3444 
3445 #undef __FUNCT__
3446 #define __FUNCT__ "DMPlexVecRestoreClosure"
3447 /*@C
3448   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
3449 
3450   Not collective
3451 
3452   Input Parameters:
3453 + dm - The DM
3454 . section - The section describing the layout in v, or NULL to use the default section
3455 . v - The local vector
3456 . point - The sieve point in the DM
3457 . csize - The number of values in the closure, or NULL
3458 - values - The array of values, which is a borrowed array and should not be freed
3459 
3460   Fortran Notes:
3461   Since it returns an array, this routine is only available in Fortran 90, and you must
3462   include petsc.h90 in your code.
3463 
3464   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3465 
3466   Level: intermediate
3467 
3468 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3469 @*/
3470 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3471 {
3472   PetscInt       size = 0;
3473   PetscErrorCode ierr;
3474 
3475   PetscFunctionBegin;
3476   /* Should work without recalculating size */
3477   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
3478   PetscFunctionReturn(0);
3479 }
3480 
3481 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
3482 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
3483 
3484 #undef __FUNCT__
3485 #define __FUNCT__ "updatePoint_private"
3486 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[])
3487 {
3488   PetscInt        cdof;   /* The number of constraints on this point */
3489   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3490   PetscScalar    *a;
3491   PetscInt        off, cind = 0, k;
3492   PetscErrorCode  ierr;
3493 
3494   PetscFunctionBegin;
3495   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3496   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3497   a    = &array[off];
3498   if (!cdof || setBC) {
3499     if (orientation >= 0) {
3500       for (k = 0; k < dof; ++k) {
3501         fuse(&a[k], values[k]);
3502       }
3503     } else {
3504       for (k = 0; k < dof; ++k) {
3505         fuse(&a[k], values[dof-k-1]);
3506       }
3507     }
3508   } else {
3509     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3510     if (orientation >= 0) {
3511       for (k = 0; k < dof; ++k) {
3512         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3513         fuse(&a[k], values[k]);
3514       }
3515     } else {
3516       for (k = 0; k < dof; ++k) {
3517         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3518         fuse(&a[k], values[dof-k-1]);
3519       }
3520     }
3521   }
3522   PetscFunctionReturn(0);
3523 }
3524 
3525 #undef __FUNCT__
3526 #define __FUNCT__ "updatePointBC_private"
3527 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
3528 {
3529   PetscInt        cdof;   /* The number of constraints on this point */
3530   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3531   PetscScalar    *a;
3532   PetscInt        off, cind = 0, k;
3533   PetscErrorCode  ierr;
3534 
3535   PetscFunctionBegin;
3536   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3537   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3538   a    = &array[off];
3539   if (cdof) {
3540     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3541     if (orientation >= 0) {
3542       for (k = 0; k < dof; ++k) {
3543         if ((cind < cdof) && (k == cdofs[cind])) {
3544           fuse(&a[k], values[k]);
3545           ++cind;
3546         }
3547       }
3548     } else {
3549       for (k = 0; k < dof; ++k) {
3550         if ((cind < cdof) && (k == cdofs[cind])) {
3551           fuse(&a[k], values[dof-k-1]);
3552           ++cind;
3553         }
3554       }
3555     }
3556   }
3557   PetscFunctionReturn(0);
3558 }
3559 
3560 #undef __FUNCT__
3561 #define __FUNCT__ "updatePointFields_private"
3562 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[])
3563 {
3564   PetscScalar    *a;
3565   PetscInt        fdof, foff, fcdof, foffset = *offset;
3566   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3567   PetscInt        cind = 0, k, c;
3568   PetscErrorCode  ierr;
3569 
3570   PetscFunctionBegin;
3571   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3572   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3573   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3574   a    = &array[foff];
3575   if (!fcdof || setBC) {
3576     if (o >= 0) {
3577       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
3578     } else {
3579       for (k = fdof/fcomp-1; k >= 0; --k) {
3580         for (c = 0; c < fcomp; ++c) {
3581           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3582         }
3583       }
3584     }
3585   } else {
3586     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3587     if (o >= 0) {
3588       for (k = 0; k < fdof; ++k) {
3589         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
3590         fuse(&a[k], values[foffset+k]);
3591       }
3592     } else {
3593       for (k = fdof/fcomp-1; k >= 0; --k) {
3594         for (c = 0; c < fcomp; ++c) {
3595           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
3596           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3597         }
3598       }
3599     }
3600   }
3601   *offset += fdof;
3602   PetscFunctionReturn(0);
3603 }
3604 
3605 #undef __FUNCT__
3606 #define __FUNCT__ "updatePointFieldsBC_private"
3607 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[])
3608 {
3609   PetscScalar    *a;
3610   PetscInt        fdof, foff, fcdof, foffset = *offset;
3611   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3612   PetscInt        cind = 0, k, c;
3613   PetscErrorCode  ierr;
3614 
3615   PetscFunctionBegin;
3616   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3617   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3618   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3619   a    = &array[foff];
3620   if (fcdof) {
3621     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3622     if (o >= 0) {
3623       for (k = 0; k < fdof; ++k) {
3624         if ((cind < fcdof) && (k == fcdofs[cind])) {
3625           fuse(&a[k], values[foffset+k]);
3626           ++cind;
3627         }
3628       }
3629     } else {
3630       for (k = fdof/fcomp-1; k >= 0; --k) {
3631         for (c = 0; c < fcomp; ++c) {
3632           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
3633             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
3634             ++cind;
3635           }
3636         }
3637       }
3638     }
3639   }
3640   *offset += fdof;
3641   PetscFunctionReturn(0);
3642 }
3643 
3644 #undef __FUNCT__
3645 #define __FUNCT__ "DMPlexVecSetClosure_Static"
3646 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3647 {
3648   PetscScalar    *array;
3649   const PetscInt *cone, *coneO;
3650   PetscInt        pStart, pEnd, p, numPoints, off, dof;
3651   PetscErrorCode  ierr;
3652 
3653   PetscFunctionBeginHot;
3654   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3655   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3656   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3657   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3658   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3659   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
3660     const PetscInt cp = !p ? point : cone[p-1];
3661     const PetscInt o  = !p ? 0     : coneO[p-1];
3662 
3663     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
3664     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3665     /* ADD_VALUES */
3666     {
3667       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3668       PetscScalar    *a;
3669       PetscInt        cdof, coff, cind = 0, k;
3670 
3671       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
3672       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
3673       a    = &array[coff];
3674       if (!cdof) {
3675         if (o >= 0) {
3676           for (k = 0; k < dof; ++k) {
3677             a[k] += values[off+k];
3678           }
3679         } else {
3680           for (k = 0; k < dof; ++k) {
3681             a[k] += values[off+dof-k-1];
3682           }
3683         }
3684       } else {
3685         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
3686         if (o >= 0) {
3687           for (k = 0; k < dof; ++k) {
3688             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3689             a[k] += values[off+k];
3690           }
3691         } else {
3692           for (k = 0; k < dof; ++k) {
3693             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3694             a[k] += values[off+dof-k-1];
3695           }
3696         }
3697       }
3698     }
3699   }
3700   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3701   PetscFunctionReturn(0);
3702 }
3703 
3704 #undef __FUNCT__
3705 #define __FUNCT__ "DMPlexVecSetClosure"
3706 /*@C
3707   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
3708 
3709   Not collective
3710 
3711   Input Parameters:
3712 + dm - The DM
3713 . section - The section describing the layout in v, or NULL to use the default section
3714 . v - The local vector
3715 . point - The sieve point in the DM
3716 . values - The array of values
3717 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
3718 
3719   Fortran Notes:
3720   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
3721 
3722   Level: intermediate
3723 
3724 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
3725 @*/
3726 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
3727 {
3728   PetscSection    clSection;
3729   IS              clPoints;
3730   PetscScalar    *array;
3731   PetscInt       *points = NULL;
3732   const PetscInt *clp;
3733   PetscInt        depth, numFields, numPoints, p;
3734   PetscErrorCode  ierr;
3735 
3736   PetscFunctionBeginHot;
3737   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3738   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3739   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3740   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3741   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3742   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3743   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
3744     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
3745     PetscFunctionReturn(0);
3746   }
3747   /* Get points */
3748   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3749   if (!clPoints) {
3750     PetscInt pStart, pEnd, q;
3751 
3752     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3753     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3754     /* Compress out points not in the section */
3755     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3756       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3757         points[q*2]   = points[p];
3758         points[q*2+1] = points[p+1];
3759         ++q;
3760       }
3761     }
3762     numPoints = q;
3763   } else {
3764     PetscInt dof, off;
3765 
3766     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3767     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3768     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3769     numPoints = dof/2;
3770     points    = (PetscInt *) &clp[off];
3771   }
3772   /* Get array */
3773   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3774   /* Get values */
3775   if (numFields > 0) {
3776     PetscInt offset = 0, fcomp, f;
3777     for (f = 0; f < numFields; ++f) {
3778       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3779       switch (mode) {
3780       case INSERT_VALUES:
3781         for (p = 0; p < numPoints*2; p += 2) {
3782           const PetscInt point = points[p];
3783           const PetscInt o     = points[p+1];
3784           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
3785         } break;
3786       case INSERT_ALL_VALUES:
3787         for (p = 0; p < numPoints*2; p += 2) {
3788           const PetscInt point = points[p];
3789           const PetscInt o     = points[p+1];
3790           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
3791         } break;
3792       case INSERT_BC_VALUES:
3793         for (p = 0; p < numPoints*2; p += 2) {
3794           const PetscInt point = points[p];
3795           const PetscInt o     = points[p+1];
3796           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
3797         } break;
3798       case ADD_VALUES:
3799         for (p = 0; p < numPoints*2; p += 2) {
3800           const PetscInt point = points[p];
3801           const PetscInt o     = points[p+1];
3802           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
3803         } break;
3804       case ADD_ALL_VALUES:
3805         for (p = 0; p < numPoints*2; p += 2) {
3806           const PetscInt point = points[p];
3807           const PetscInt o     = points[p+1];
3808           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
3809         } break;
3810       default:
3811         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3812       }
3813     }
3814   } else {
3815     PetscInt dof, off;
3816 
3817     switch (mode) {
3818     case INSERT_VALUES:
3819       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3820         PetscInt o = points[p+1];
3821         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3822         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
3823       } break;
3824     case INSERT_ALL_VALUES:
3825       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3826         PetscInt o = points[p+1];
3827         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3828         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
3829       } break;
3830     case INSERT_BC_VALUES:
3831       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3832         PetscInt o = points[p+1];
3833         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3834         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
3835       } break;
3836     case ADD_VALUES:
3837       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3838         PetscInt o = points[p+1];
3839         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3840         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
3841       } break;
3842     case ADD_ALL_VALUES:
3843       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
3844         PetscInt o = points[p+1];
3845         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3846         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
3847       } break;
3848     default:
3849       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3850     }
3851   }
3852   /* Cleanup points */
3853   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3854   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3855   /* Cleanup array */
3856   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3857   PetscFunctionReturn(0);
3858 }
3859 
3860 #undef __FUNCT__
3861 #define __FUNCT__ "DMPlexVecSetFieldClosure_Internal"
3862 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, const PetscScalar values[], InsertMode mode)
3863 {
3864   PetscSection    clSection;
3865   IS              clPoints;
3866   PetscScalar    *array;
3867   PetscInt       *points = NULL;
3868   const PetscInt *clp;
3869   PetscInt        numFields, numPoints, p;
3870   PetscInt        offset = 0, fcomp, f;
3871   PetscErrorCode  ierr;
3872 
3873   PetscFunctionBeginHot;
3874   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3875   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3876   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3877   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3878   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3879   /* Get points */
3880   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
3881   if (!clPoints) {
3882     PetscInt pStart, pEnd, q;
3883 
3884     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3885     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3886     /* Compress out points not in the section */
3887     for (p = 0, q = 0; p < numPoints*2; p += 2) {
3888       if ((points[p] >= pStart) && (points[p] < pEnd)) {
3889         points[q*2]   = points[p];
3890         points[q*2+1] = points[p+1];
3891         ++q;
3892       }
3893     }
3894     numPoints = q;
3895   } else {
3896     PetscInt dof, off;
3897 
3898     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
3899     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
3900     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
3901     numPoints = dof/2;
3902     points    = (PetscInt *) &clp[off];
3903   }
3904   /* Get array */
3905   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
3906   /* Get values */
3907   for (f = 0; f < numFields; ++f) {
3908     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
3909     if (!fieldActive[f]) {
3910       for (p = 0; p < numPoints*2; p += 2) {
3911         PetscInt fdof;
3912         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
3913         offset += fdof;
3914       }
3915       continue;
3916     }
3917     switch (mode) {
3918     case INSERT_VALUES:
3919       for (p = 0; p < numPoints*2; p += 2) {
3920         const PetscInt point = points[p];
3921         const PetscInt o     = points[p+1];
3922         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
3923       } break;
3924     case INSERT_ALL_VALUES:
3925       for (p = 0; p < numPoints*2; p += 2) {
3926         const PetscInt point = points[p];
3927         const PetscInt o     = points[p+1];
3928         updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
3929         } break;
3930     case INSERT_BC_VALUES:
3931       for (p = 0; p < numPoints*2; p += 2) {
3932         const PetscInt point = points[p];
3933         const PetscInt o     = points[p+1];
3934         updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
3935       } break;
3936     case ADD_VALUES:
3937       for (p = 0; p < numPoints*2; p += 2) {
3938         const PetscInt point = points[p];
3939         const PetscInt o     = points[p+1];
3940         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
3941       } break;
3942     case ADD_ALL_VALUES:
3943       for (p = 0; p < numPoints*2; p += 2) {
3944         const PetscInt point = points[p];
3945         const PetscInt o     = points[p+1];
3946         updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
3947       } break;
3948     default:
3949       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
3950     }
3951   }
3952   /* Cleanup points */
3953   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
3954   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
3955   /* Cleanup array */
3956   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
3957   PetscFunctionReturn(0);
3958 }
3959 
3960 #undef __FUNCT__
3961 #define __FUNCT__ "DMPlexPrintMatSetValues"
3962 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
3963 {
3964   PetscMPIInt    rank;
3965   PetscInt       i, j;
3966   PetscErrorCode ierr;
3967 
3968   PetscFunctionBegin;
3969   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
3970   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
3971   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
3972   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
3973   numCIndices = numCIndices ? numCIndices : numRIndices;
3974   for (i = 0; i < numRIndices; i++) {
3975     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
3976     for (j = 0; j < numCIndices; j++) {
3977 #if defined(PETSC_USE_COMPLEX)
3978       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
3979 #else
3980       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
3981 #endif
3982     }
3983     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
3984   }
3985   PetscFunctionReturn(0);
3986 }
3987 
3988 #undef __FUNCT__
3989 #define __FUNCT__ "indicesPoint_private"
3990 /* . off - The global offset of this point */
3991 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
3992 {
3993   PetscInt        dof;    /* The number of unknowns on this point */
3994   PetscInt        cdof;   /* The number of constraints on this point */
3995   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3996   PetscInt        cind = 0, k;
3997   PetscErrorCode  ierr;
3998 
3999   PetscFunctionBegin;
4000   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4001   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4002   if (!cdof || setBC) {
4003     if (orientation >= 0) {
4004       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
4005     } else {
4006       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
4007     }
4008   } else {
4009     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4010     if (orientation >= 0) {
4011       for (k = 0; k < dof; ++k) {
4012         if ((cind < cdof) && (k == cdofs[cind])) {
4013           /* Insert check for returning constrained indices */
4014           indices[*loff+k] = -(off+k+1);
4015           ++cind;
4016         } else {
4017           indices[*loff+k] = off+k-cind;
4018         }
4019       }
4020     } else {
4021       for (k = 0; k < dof; ++k) {
4022         if ((cind < cdof) && (k == cdofs[cind])) {
4023           /* Insert check for returning constrained indices */
4024           indices[*loff+dof-k-1] = -(off+k+1);
4025           ++cind;
4026         } else {
4027           indices[*loff+dof-k-1] = off+k-cind;
4028         }
4029       }
4030     }
4031   }
4032   *loff += dof;
4033   PetscFunctionReturn(0);
4034 }
4035 
4036 #undef __FUNCT__
4037 #define __FUNCT__ "indicesPointFields_private"
4038 /* . off - The global offset of this point */
4039 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
4040 {
4041   PetscInt       numFields, foff, f;
4042   PetscErrorCode ierr;
4043 
4044   PetscFunctionBegin;
4045   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4046   for (f = 0, foff = 0; f < numFields; ++f) {
4047     PetscInt        fdof, fcomp, cfdof;
4048     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4049     PetscInt        cind = 0, k, c;
4050 
4051     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
4052     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4053     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4054     if (!cfdof || setBC) {
4055       if (orientation >= 0) {
4056         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
4057       } else {
4058         for (k = fdof/fcomp-1; k >= 0; --k) {
4059           for (c = 0; c < fcomp; ++c) {
4060             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
4061           }
4062         }
4063       }
4064     } else {
4065       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4066       if (orientation >= 0) {
4067         for (k = 0; k < fdof; ++k) {
4068           if ((cind < cfdof) && (k == fcdofs[cind])) {
4069             indices[foffs[f]+k] = -(off+foff+k+1);
4070             ++cind;
4071           } else {
4072             indices[foffs[f]+k] = off+foff+k-cind;
4073           }
4074         }
4075       } else {
4076         for (k = fdof/fcomp-1; k >= 0; --k) {
4077           for (c = 0; c < fcomp; ++c) {
4078             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
4079               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
4080               ++cind;
4081             } else {
4082               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
4083             }
4084           }
4085         }
4086       }
4087     }
4088     foff     += fdof - cfdof;
4089     foffs[f] += fdof;
4090   }
4091   PetscFunctionReturn(0);
4092 }
4093 
4094 #undef __FUNCT__
4095 #define __FUNCT__ "DMPlexAnchorsModifyMat"
4096 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[])
4097 {
4098   Mat             cMat;
4099   PetscSection    aSec, cSec;
4100   IS              aIS;
4101   PetscInt        aStart = -1, aEnd = -1;
4102   const PetscInt  *anchors;
4103   PetscInt        numFields, f, p, q, newP = 0;
4104   PetscInt        newNumPoints = 0, newNumIndices = 0;
4105   PetscInt        *newPoints, *indices, *newIndices;
4106   PetscInt        maxAnchor, maxDof;
4107   PetscInt        newOffsets[32];
4108   PetscInt        *pointMatOffsets[32];
4109   PetscInt        *newPointOffsets[32];
4110   PetscScalar     *pointMat[32];
4111   PetscScalar     *newValues,*tmpValues;
4112   PetscBool       anyConstrained = PETSC_FALSE;
4113   PetscErrorCode  ierr;
4114 
4115   PetscFunctionBegin;
4116   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4117   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4118   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4119 
4120   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4121   /* if there are point-to-point constraints */
4122   if (aSec) {
4123     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4124     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4125     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4126     /* figure out how many points are going to be in the new element matrix
4127      * (we allow double counting, because it's all just going to be summed
4128      * into the global matrix anyway) */
4129     for (p = 0; p < 2*numPoints; p+=2) {
4130       PetscInt b    = points[p];
4131       PetscInt bDof = 0;
4132 
4133       if (b >= aStart && b < aEnd) {
4134         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4135       }
4136       if (bDof) {
4137         /* this point is constrained */
4138         /* it is going to be replaced by its anchors */
4139         PetscInt bOff, q;
4140 
4141         anyConstrained = PETSC_TRUE;
4142         newNumPoints  += bDof;
4143         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4144         for (q = 0; q < bDof; q++) {
4145           PetscInt a = anchors[bOff + q];
4146           PetscInt aDof;
4147 
4148           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4149           newNumIndices += aDof;
4150           for (f = 0; f < numFields; ++f) {
4151             PetscInt fDof;
4152 
4153             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4154             newOffsets[f+1] += fDof;
4155           }
4156         }
4157       }
4158       else {
4159         /* this point is not constrained */
4160         newNumPoints++;
4161         ierr           = PetscSectionGetDof(section,b,&bDof);CHKERRQ(ierr);
4162         newNumIndices += bDof;
4163         for (f = 0; f < numFields; ++f) {
4164           PetscInt fDof;
4165 
4166           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4167           newOffsets[f+1] += fDof;
4168         }
4169       }
4170     }
4171   }
4172   if (!anyConstrained) {
4173     *outNumPoints  = 0;
4174     *outNumIndices = 0;
4175     *outPoints     = NULL;
4176     *outValues     = NULL;
4177     if (aSec) {
4178       ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
4179     }
4180     PetscFunctionReturn(0);
4181   }
4182 
4183   for (f = 1; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
4184 
4185   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", newOffsets[numFields], newNumIndices);
4186 
4187   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
4188 
4189   /* output arrays */
4190   ierr = DMGetWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4191   ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4192 
4193   /* workspaces */
4194   ierr = DMGetWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4195   if (numFields) {
4196     for (f = 0; f < numFields; f++) {
4197       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4198       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4199     }
4200   }
4201   else {
4202     ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4203     ierr = DMGetWorkArray(dm,numPoints,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4204   }
4205 
4206   /* get workspaces for the point-to-point matrices */
4207   if (numFields) {
4208     for (p = 0; p < numPoints; p++) {
4209       PetscInt b    = points[2*p];
4210       PetscInt bDof = 0;
4211 
4212       if (b >= aStart && b < aEnd) {
4213         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4214       }
4215       if (bDof) {
4216         for (f = 0; f < numFields; f++) {
4217           PetscInt fDof, q, bOff, allFDof = 0;
4218 
4219           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4220           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4221           for (q = 0; q < bDof; q++) {
4222             PetscInt a = anchors[bOff + q];
4223             PetscInt aFDof;
4224 
4225             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4226             allFDof += aFDof;
4227           }
4228           newPointOffsets[f][p+1] = allFDof;
4229           pointMatOffsets[f][p+1] = fDof * allFDof;
4230         }
4231       }
4232       else {
4233         for (f = 0; f < numFields; f++) {
4234           PetscInt fDof;
4235 
4236           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4237           newPointOffsets[f][p+1] = fDof;
4238           pointMatOffsets[f][p+1] = 0;
4239         }
4240       }
4241     }
4242     for (f = 0; f < numFields; f++) {
4243       newPointOffsets[f][0] = 0;
4244       pointMatOffsets[f][0] = 0;
4245       for (p = 0; p < numPoints; p++) {
4246         newPointOffsets[f][p+1] += newPointOffsets[f][p];
4247         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
4248       }
4249       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4250     }
4251   }
4252   else {
4253     for (p = 0; p < numPoints; p++) {
4254       PetscInt b    = points[2*p];
4255       PetscInt bDof = 0;
4256 
4257       if (b >= aStart && b < aEnd) {
4258         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4259       }
4260       if (bDof) {
4261         PetscInt dof, bOff, q, allDof = 0;
4262 
4263         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4264         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4265         for (q = 0; q < bDof; q++) {
4266           PetscInt a = anchors[bOff + q], aDof;
4267 
4268           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
4269           allDof += aDof;
4270         }
4271         newPointOffsets[0][p+1] = allDof;
4272         pointMatOffsets[0][p+1] = dof * allDof;
4273       }
4274       else {
4275         PetscInt dof;
4276 
4277         ierr = PetscSectionGetDof(section, b, &dof);CHKERRQ(ierr);
4278         newPointOffsets[0][p+1] = dof;
4279         pointMatOffsets[0][p+1] = 0;
4280       }
4281     }
4282     newPointOffsets[0][0] = 0;
4283     pointMatOffsets[0][0] = 0;
4284     for (p = 0; p < numPoints; p++) {
4285       newPointOffsets[0][p+1] += newPointOffsets[0][p];
4286       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
4287     }
4288     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4289   }
4290 
4291   /* get the point-to-point matrices; construct newPoints */
4292   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
4293   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4294   ierr = DMGetWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4295   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4296   if (numFields) {
4297     for (p = 0, newP = 0; p < numPoints; p++) {
4298       PetscInt b    = points[2*p];
4299       PetscInt o    = points[2*p+1];
4300       PetscInt bDof = 0;
4301 
4302       if (b >= aStart && b < aEnd) {
4303         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4304       }
4305       if (bDof) {
4306         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
4307 
4308         fStart[0] = 0;
4309         fEnd[0]   = 0;
4310         for (f = 0; f < numFields; f++) {
4311           PetscInt fDof;
4312 
4313           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
4314           fStart[f+1] = fStart[f] + fDof;
4315           fEnd[f+1]   = fStart[f+1];
4316         }
4317         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4318         ierr = indicesPointFields_private(cSec, b, bOff, fEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4319 
4320         fAnchorStart[0] = 0;
4321         fAnchorEnd[0]   = 0;
4322         for (f = 0; f < numFields; f++) {
4323           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
4324 
4325           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
4326           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
4327         }
4328         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4329         for (q = 0; q < bDof; q++) {
4330           PetscInt a = anchors[bOff + q], aOff;
4331 
4332           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4333           newPoints[2*(newP + q)]     = a;
4334           newPoints[2*(newP + q) + 1] = 0;
4335           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
4336           ierr = indicesPointFields_private(section, a, aOff, fAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4337         }
4338         newP += bDof;
4339 
4340         /* get the point-to-point submatrix */
4341         for (f = 0; f < numFields; f++) {
4342           ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
4343         }
4344       }
4345       else {
4346         newPoints[2 * newP]     = b;
4347         newPoints[2 * newP + 1] = o;
4348         newP++;
4349       }
4350     }
4351   } else {
4352     for (p = 0; p < numPoints; p++) {
4353       PetscInt b    = points[2*p];
4354       PetscInt o    = points[2*p+1];
4355       PetscInt bDof = 0;
4356 
4357       if (b >= aStart && b < aEnd) {
4358         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4359       }
4360       if (bDof) {
4361         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
4362 
4363         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4364         ierr = indicesPoint_private(cSec, b, bOff, &bEnd, PETSC_TRUE, o, indices);CHKERRQ(ierr);
4365 
4366         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4367         for (q = 0; q < bDof; q++) {
4368           PetscInt a = anchors[bOff + q], aOff;
4369 
4370           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4371 
4372           newPoints[2*(newP + q)]     = a;
4373           newPoints[2*(newP + q) + 1] = 0;
4374           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
4375           ierr = indicesPoint_private(section, a, aOff, &bAnchorEnd, PETSC_TRUE, 0, newIndices);CHKERRQ(ierr);
4376         }
4377         newP += bDof;
4378 
4379         /* get the point-to-point submatrix */
4380         ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
4381       }
4382       else {
4383         newPoints[2 * newP]     = b;
4384         newPoints[2 * newP + 1] = o;
4385         newP++;
4386       }
4387     }
4388   }
4389 
4390   ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
4391   /* multiply constraints on the right */
4392   if (numFields) {
4393     for (f = 0; f < numFields; f++) {
4394       PetscInt oldOff = offsets[f];
4395 
4396       for (p = 0; p < numPoints; p++) {
4397         PetscInt cStart = newPointOffsets[f][p];
4398         PetscInt b      = points[2 * p];
4399         PetscInt c, r, k;
4400         PetscInt dof;
4401 
4402         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4403         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4404           PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
4405           const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
4406 
4407           for (r = 0; r < numIndices; r++) {
4408             for (c = 0; c < nCols; c++) {
4409               for (k = 0; k < dof; k++) {
4410                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4411               }
4412             }
4413           }
4414         }
4415         else {
4416           /* copy this column as is */
4417           for (r = 0; r < numIndices; r++) {
4418             for (c = 0; c < dof; c++) {
4419               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4420             }
4421           }
4422         }
4423         oldOff += dof;
4424       }
4425     }
4426   }
4427   else {
4428     PetscInt oldOff = 0;
4429     for (p = 0; p < numPoints; p++) {
4430       PetscInt cStart = newPointOffsets[0][p];
4431       PetscInt b      = points[2 * p];
4432       PetscInt c, r, k;
4433       PetscInt dof;
4434 
4435       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4436       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4437         PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
4438         const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
4439 
4440         for (r = 0; r < numIndices; r++) {
4441           for (c = 0; c < nCols; c++) {
4442             for (k = 0; k < dof; k++) {
4443               tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4444             }
4445           }
4446         }
4447       }
4448       else {
4449         /* copy this column as is */
4450         for (r = 0; r < numIndices; r++) {
4451           for (c = 0; c < dof; c++) {
4452             tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4453           }
4454         }
4455       }
4456       oldOff += dof;
4457     }
4458   }
4459 
4460   ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
4461   /* multiply constraints transpose on the left */
4462   if (numFields) {
4463     for (f = 0; f < numFields; f++) {
4464       PetscInt oldOff = offsets[f];
4465 
4466       for (p = 0; p < numPoints; p++) {
4467         PetscInt rStart = newPointOffsets[f][p];
4468         PetscInt b      = points[2 * p];
4469         PetscInt c, r, k;
4470         PetscInt dof;
4471 
4472         ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4473         if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4474           PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
4475           const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
4476 
4477           for (r = 0; r < nRows; r++) {
4478             for (c = 0; c < newNumIndices; c++) {
4479               for (k = 0; k < dof; k++) {
4480                 newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4481               }
4482             }
4483           }
4484         }
4485         else {
4486           /* copy this row as is */
4487           for (r = 0; r < dof; r++) {
4488             for (c = 0; c < newNumIndices; c++) {
4489               newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4490             }
4491           }
4492         }
4493         oldOff += dof;
4494       }
4495     }
4496   }
4497   else {
4498     PetscInt oldOff = 0;
4499 
4500     for (p = 0; p < numPoints; p++) {
4501       PetscInt rStart = newPointOffsets[0][p];
4502       PetscInt b      = points[2 * p];
4503       PetscInt c, r, k;
4504       PetscInt dof;
4505 
4506       ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4507       if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4508         PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
4509         const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
4510 
4511         for (r = 0; r < nRows; r++) {
4512           for (c = 0; c < newNumIndices; c++) {
4513             for (k = 0; k < dof; k++) {
4514               newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4515             }
4516           }
4517         }
4518       }
4519       else {
4520         /* copy this row as is */
4521         for (r = 0; r < dof; c++) {
4522           for (c = 0; c < newNumIndices; c++) {
4523             newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4524           }
4525         }
4526       }
4527       oldOff += dof;
4528     }
4529   }
4530 
4531   /* clean up */
4532   ierr = DMRestoreWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4533   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4534   if (numFields) {
4535     for (f = 0; f < numFields; f++) {
4536       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4537       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4538       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4539     }
4540   }
4541   else {
4542     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4543     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4544     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4545   }
4546   ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4547   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
4548 
4549   /* output */
4550   *outNumPoints  = newNumPoints;
4551   *outNumIndices = newNumIndices;
4552   *outPoints     = newPoints;
4553   *outValues     = newValues;
4554   for (f = 0; f < numFields; f++) {
4555     offsets[f] = newOffsets[f];
4556   }
4557   PetscFunctionReturn(0);
4558 }
4559 
4560 #undef __FUNCT__
4561 #define __FUNCT__ "DMPlexMatSetClosure"
4562 /*@C
4563   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
4564 
4565   Not collective
4566 
4567   Input Parameters:
4568 + dm - The DM
4569 . section - The section describing the layout in v, or NULL to use the default section
4570 . globalSection - The section describing the layout in v, or NULL to use the default global section
4571 . A - The matrix
4572 . point - The sieve point in the DM
4573 . values - The array of values
4574 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
4575 
4576   Fortran Notes:
4577   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4578 
4579   Level: intermediate
4580 
4581 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
4582 @*/
4583 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4584 {
4585   DM_Plex        *mesh   = (DM_Plex*) dm->data;
4586   PetscSection    clSection;
4587   IS              clPoints;
4588   PetscInt       *points = NULL, *newPoints;
4589   const PetscInt *clp;
4590   PetscInt       *indices;
4591   PetscInt        offsets[32];
4592   PetscInt        numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
4593   PetscScalar    *newValues;
4594   PetscErrorCode  ierr;
4595 
4596   PetscFunctionBegin;
4597   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4598   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4599   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4600   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
4601   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
4602   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
4603   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4604   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4605   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4606   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
4607   if (!clPoints) {
4608     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4609     /* Compress out points not in the section */
4610     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4611     for (p = 0, q = 0; p < numPoints*2; p += 2) {
4612       if ((points[p] >= pStart) && (points[p] < pEnd)) {
4613         points[q*2]   = points[p];
4614         points[q*2+1] = points[p+1];
4615         ++q;
4616       }
4617     }
4618     numPoints = q;
4619   } else {
4620     PetscInt dof, off;
4621 
4622     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
4623     numPoints = dof/2;
4624     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
4625     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
4626     points = (PetscInt *) &clp[off];
4627   }
4628   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
4629     PetscInt fdof;
4630 
4631     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4632     for (f = 0; f < numFields; ++f) {
4633       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4634       offsets[f+1] += fdof;
4635     }
4636     numIndices += dof;
4637   }
4638   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
4639 
4640   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
4641   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets);CHKERRQ(ierr);
4642   if (newNumPoints) {
4643     if (!clPoints) {
4644       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4645     } else {
4646       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4647     }
4648     numPoints  = newNumPoints;
4649     numIndices = newNumIndices;
4650     points     = newPoints;
4651     values     = newValues;
4652   }
4653   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4654   if (numFields) {
4655     for (p = 0; p < numPoints*2; p += 2) {
4656       PetscInt o = points[p+1];
4657       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4658       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
4659     }
4660   } else {
4661     for (p = 0, off = 0; p < numPoints*2; p += 2) {
4662       PetscInt o = points[p+1];
4663       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
4664       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
4665     }
4666   }
4667   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
4668   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
4669   if (mesh->printFEM > 1) {
4670     PetscInt i;
4671     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
4672     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %d", indices[i]);CHKERRQ(ierr);}
4673     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
4674   }
4675   if (ierr) {
4676     PetscMPIInt    rank;
4677     PetscErrorCode ierr2;
4678 
4679     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4680     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4681     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
4682     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
4683     CHKERRQ(ierr);
4684   }
4685   if (newNumPoints) {
4686     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4687     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4688   }
4689   else {
4690     if (!clPoints) {
4691       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
4692     } else {
4693       ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
4694     }
4695   }
4696   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
4697   PetscFunctionReturn(0);
4698 }
4699 
4700 #undef __FUNCT__
4701 #define __FUNCT__ "DMPlexMatSetClosureRefined"
4702 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
4703 {
4704   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
4705   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
4706   PetscInt       *cpoints = NULL;
4707   PetscInt       *findices, *cindices;
4708   PetscInt        foffsets[32], coffsets[32];
4709   CellRefiner     cellRefiner;
4710   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4711   PetscErrorCode  ierr;
4712 
4713   PetscFunctionBegin;
4714   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4715   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4716   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4717   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4718   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4719   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4720   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4721   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4722   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4723   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4724   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
4725   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4726   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4727   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4728   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4729   /* Column indices */
4730   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4731   maxFPoints = numCPoints;
4732   /* Compress out points not in the section */
4733   /*   TODO: Squeeze out points with 0 dof as well */
4734   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4735   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4736     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4737       cpoints[q*2]   = cpoints[p];
4738       cpoints[q*2+1] = cpoints[p+1];
4739       ++q;
4740     }
4741   }
4742   numCPoints = q;
4743   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4744     PetscInt fdof;
4745 
4746     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4747     if (!dof) continue;
4748     for (f = 0; f < numFields; ++f) {
4749       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4750       coffsets[f+1] += fdof;
4751     }
4752     numCIndices += dof;
4753   }
4754   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4755   /* Row indices */
4756   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4757   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4758   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4759   for (r = 0, q = 0; r < numSubcells; ++r) {
4760     /* TODO Map from coarse to fine cells */
4761     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4762     /* Compress out points not in the section */
4763     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4764     for (p = 0; p < numFPoints*2; p += 2) {
4765       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4766         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4767         if (!dof) continue;
4768         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4769         if (s < q) continue;
4770         ftotpoints[q*2]   = fpoints[p];
4771         ftotpoints[q*2+1] = fpoints[p+1];
4772         ++q;
4773       }
4774     }
4775     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4776   }
4777   numFPoints = q;
4778   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
4779     PetscInt fdof;
4780 
4781     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
4782     if (!dof) continue;
4783     for (f = 0; f < numFields; ++f) {
4784       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
4785       foffsets[f+1] += fdof;
4786     }
4787     numFIndices += dof;
4788   }
4789   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
4790 
4791   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
4792   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
4793   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4794   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4795   if (numFields) {
4796     for (p = 0; p < numFPoints*2; p += 2) {
4797       PetscInt o = ftotpoints[p+1];
4798       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4799       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
4800     }
4801     for (p = 0; p < numCPoints*2; p += 2) {
4802       PetscInt o = cpoints[p+1];
4803       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4804       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
4805     }
4806   } else {
4807     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
4808       PetscInt o = ftotpoints[p+1];
4809       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4810       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
4811     }
4812     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
4813       PetscInt o = cpoints[p+1];
4814       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4815       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
4816     }
4817   }
4818   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
4819   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
4820   if (ierr) {
4821     PetscMPIInt    rank;
4822     PetscErrorCode ierr2;
4823 
4824     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
4825     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
4826     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
4827     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
4828     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
4829     CHKERRQ(ierr);
4830   }
4831   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4832   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4833   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
4834   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
4835   PetscFunctionReturn(0);
4836 }
4837 
4838 #undef __FUNCT__
4839 #define __FUNCT__ "DMPlexMatGetClosureIndicesRefined"
4840 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
4841 {
4842   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
4843   PetscInt      *cpoints = NULL;
4844   PetscInt       foffsets[32], coffsets[32];
4845   CellRefiner    cellRefiner;
4846   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
4847   PetscErrorCode ierr;
4848 
4849   PetscFunctionBegin;
4850   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
4851   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
4852   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
4853   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
4854   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
4855   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
4856   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
4857   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
4858   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
4859   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
4860   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
4861   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
4862   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4863   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4864   /* Column indices */
4865   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4866   maxFPoints = numCPoints;
4867   /* Compress out points not in the section */
4868   /*   TODO: Squeeze out points with 0 dof as well */
4869   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
4870   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
4871     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
4872       cpoints[q*2]   = cpoints[p];
4873       cpoints[q*2+1] = cpoints[p+1];
4874       ++q;
4875     }
4876   }
4877   numCPoints = q;
4878   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
4879     PetscInt fdof;
4880 
4881     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
4882     if (!dof) continue;
4883     for (f = 0; f < numFields; ++f) {
4884       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
4885       coffsets[f+1] += fdof;
4886     }
4887     numCIndices += dof;
4888   }
4889   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
4890   /* Row indices */
4891   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
4892   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
4893   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4894   for (r = 0, q = 0; r < numSubcells; ++r) {
4895     /* TODO Map from coarse to fine cells */
4896     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4897     /* Compress out points not in the section */
4898     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
4899     for (p = 0; p < numFPoints*2; p += 2) {
4900       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
4901         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
4902         if (!dof) continue;
4903         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
4904         if (s < q) continue;
4905         ftotpoints[q*2]   = fpoints[p];
4906         ftotpoints[q*2+1] = fpoints[p+1];
4907         ++q;
4908       }
4909     }
4910     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
4911   }
4912   numFPoints = q;
4913   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
4914     PetscInt fdof;
4915 
4916     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
4917     if (!dof) continue;
4918     for (f = 0; f < numFields; ++f) {
4919       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
4920       foffsets[f+1] += fdof;
4921     }
4922     numFIndices += dof;
4923   }
4924   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
4925 
4926   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
4927   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
4928   if (numFields) {
4929     for (p = 0; p < numFPoints*2; p += 2) {
4930       PetscInt o = ftotpoints[p+1];
4931       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4932       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
4933     }
4934     for (p = 0; p < numCPoints*2; p += 2) {
4935       PetscInt o = cpoints[p+1];
4936       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4937       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
4938     }
4939   } else {
4940     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
4941       PetscInt o = ftotpoints[p+1];
4942       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
4943       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
4944     }
4945     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
4946       PetscInt o = cpoints[p+1];
4947       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
4948       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
4949     }
4950   }
4951   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
4952   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
4953   PetscFunctionReturn(0);
4954 }
4955 
4956 #undef __FUNCT__
4957 #define __FUNCT__ "DMPlexGetHybridBounds"
4958 /*@
4959   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
4960 
4961   Input Parameter:
4962 . dm - The DMPlex object
4963 
4964   Output Parameters:
4965 + cMax - The first hybrid cell
4966 . fMax - The first hybrid face
4967 . eMax - The first hybrid edge
4968 - vMax - The first hybrid vertex
4969 
4970   Level: developer
4971 
4972 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
4973 @*/
4974 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
4975 {
4976   DM_Plex       *mesh = (DM_Plex*) dm->data;
4977   PetscInt       dim;
4978   PetscErrorCode ierr;
4979 
4980   PetscFunctionBegin;
4981   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4982   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4983   if (cMax) *cMax = mesh->hybridPointMax[dim];
4984   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
4985   if (eMax) *eMax = mesh->hybridPointMax[1];
4986   if (vMax) *vMax = mesh->hybridPointMax[0];
4987   PetscFunctionReturn(0);
4988 }
4989 
4990 #undef __FUNCT__
4991 #define __FUNCT__ "DMPlexSetHybridBounds"
4992 /*@
4993   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
4994 
4995   Input Parameters:
4996 . dm   - The DMPlex object
4997 . cMax - The first hybrid cell
4998 . fMax - The first hybrid face
4999 . eMax - The first hybrid edge
5000 - vMax - The first hybrid vertex
5001 
5002   Level: developer
5003 
5004 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
5005 @*/
5006 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5007 {
5008   DM_Plex       *mesh = (DM_Plex*) dm->data;
5009   PetscInt       dim;
5010   PetscErrorCode ierr;
5011 
5012   PetscFunctionBegin;
5013   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5014   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5015   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5016   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5017   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5018   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5019   PetscFunctionReturn(0);
5020 }
5021 
5022 #undef __FUNCT__
5023 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5024 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5025 {
5026   DM_Plex *mesh = (DM_Plex*) dm->data;
5027 
5028   PetscFunctionBegin;
5029   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5030   PetscValidPointer(cellHeight, 2);
5031   *cellHeight = mesh->vtkCellHeight;
5032   PetscFunctionReturn(0);
5033 }
5034 
5035 #undef __FUNCT__
5036 #define __FUNCT__ "DMPlexSetVTKCellHeight"
5037 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5038 {
5039   DM_Plex *mesh = (DM_Plex*) dm->data;
5040 
5041   PetscFunctionBegin;
5042   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5043   mesh->vtkCellHeight = cellHeight;
5044   PetscFunctionReturn(0);
5045 }
5046 
5047 #undef __FUNCT__
5048 #define __FUNCT__ "DMPlexCreateNumbering_Private"
5049 /* We can easily have a form that takes an IS instead */
5050 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
5051 {
5052   PetscSection   section, globalSection;
5053   PetscInt      *numbers, p;
5054   PetscErrorCode ierr;
5055 
5056   PetscFunctionBegin;
5057   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
5058   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
5059   for (p = pStart; p < pEnd; ++p) {
5060     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
5061   }
5062   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
5063   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
5064   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
5065   for (p = pStart; p < pEnd; ++p) {
5066     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
5067     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
5068     else                       numbers[p-pStart] += shift;
5069   }
5070   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
5071   if (globalSize) {
5072     PetscLayout layout;
5073     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
5074     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
5075     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
5076   }
5077   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5078   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
5079   PetscFunctionReturn(0);
5080 }
5081 
5082 #undef __FUNCT__
5083 #define __FUNCT__ "DMPlexGetCellNumbering"
5084 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
5085 {
5086   DM_Plex       *mesh = (DM_Plex*) dm->data;
5087   PetscInt       cellHeight, cStart, cEnd, cMax;
5088   PetscErrorCode ierr;
5089 
5090   PetscFunctionBegin;
5091   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5092   if (!mesh->globalCellNumbers) {
5093     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
5094     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5095     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5096     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
5097     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
5098   }
5099   *globalCellNumbers = mesh->globalCellNumbers;
5100   PetscFunctionReturn(0);
5101 }
5102 
5103 #undef __FUNCT__
5104 #define __FUNCT__ "DMPlexGetVertexNumbering"
5105 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
5106 {
5107   DM_Plex       *mesh = (DM_Plex*) dm->data;
5108   PetscInt       vStart, vEnd, vMax;
5109   PetscErrorCode ierr;
5110 
5111   PetscFunctionBegin;
5112   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5113   if (!mesh->globalVertexNumbers) {
5114     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5115     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
5116     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
5117     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
5118   }
5119   *globalVertexNumbers = mesh->globalVertexNumbers;
5120   PetscFunctionReturn(0);
5121 }
5122 
5123 #undef __FUNCT__
5124 #define __FUNCT__ "DMPlexCreatePointNumbering"
5125 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
5126 {
5127   IS             nums[4];
5128   PetscInt       depths[4];
5129   PetscInt       depth, d, shift = 0;
5130   PetscErrorCode ierr;
5131 
5132   PetscFunctionBegin;
5133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5134   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5135   /* For unstratified meshes use dim instead of depth */
5136   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
5137   depths[0] = depth; depths[1] = 0;
5138   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
5139   for (d = 0; d <= depth; ++d) {
5140     PetscInt pStart, pEnd, gsize;
5141 
5142     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
5143     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
5144     shift += gsize;
5145   }
5146   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
5147   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
5148   PetscFunctionReturn(0);
5149 }
5150 
5151 
5152 #undef __FUNCT__
5153 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
5154 /*@C
5155   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
5156   the local section and an SF describing the section point overlap.
5157 
5158   Input Parameters:
5159   + s - The PetscSection for the local field layout
5160   . sf - The SF describing parallel layout of the section points
5161   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
5162   . label - The label specifying the points
5163   - labelValue - The label stratum specifying the points
5164 
5165   Output Parameter:
5166   . gsection - The PetscSection for the global field layout
5167 
5168   Note: This gives negative sizes and offsets to points not owned by this process
5169 
5170   Level: developer
5171 
5172 .seealso: PetscSectionCreate()
5173 @*/
5174 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
5175 {
5176   PetscInt      *neg = NULL, *tmpOff = NULL;
5177   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
5178   PetscErrorCode ierr;
5179 
5180   PetscFunctionBegin;
5181   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) s), gsection);CHKERRQ(ierr);
5182   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
5183   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
5184   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
5185   if (nroots >= 0) {
5186     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
5187     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
5188     if (nroots > pEnd-pStart) {
5189       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
5190     } else {
5191       tmpOff = &(*gsection)->atlasDof[-pStart];
5192     }
5193   }
5194   /* Mark ghost points with negative dof */
5195   for (p = pStart; p < pEnd; ++p) {
5196     PetscInt value;
5197 
5198     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
5199     if (value != labelValue) continue;
5200     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
5201     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
5202     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
5203     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
5204     if (neg) neg[p] = -(dof+1);
5205   }
5206   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
5207   if (nroots >= 0) {
5208     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5209     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5210     if (nroots > pEnd-pStart) {
5211       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
5212     }
5213   }
5214   /* Calculate new sizes, get proccess offset, and calculate point offsets */
5215   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5216     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
5217     (*gsection)->atlasOff[p] = off;
5218     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
5219   }
5220   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) s));CHKERRQ(ierr);
5221   globalOff -= off;
5222   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
5223     (*gsection)->atlasOff[p] += globalOff;
5224     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
5225   }
5226   /* Put in negative offsets for ghost points */
5227   if (nroots >= 0) {
5228     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5229     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
5230     if (nroots > pEnd-pStart) {
5231       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
5232     }
5233   }
5234   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
5235   ierr = PetscFree(neg);CHKERRQ(ierr);
5236   PetscFunctionReturn(0);
5237 }
5238 
5239 #undef __FUNCT__
5240 #define __FUNCT__ "DMPlexCheckSymmetry"
5241 /*@
5242   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
5243 
5244   Input Parameters:
5245   + dm - The DMPlex object
5246 
5247   Note: This is a useful diagnostic when creating meshes programmatically.
5248 
5249   Level: developer
5250 
5251 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
5252 @*/
5253 PetscErrorCode DMPlexCheckSymmetry(DM dm)
5254 {
5255   PetscSection    coneSection, supportSection;
5256   const PetscInt *cone, *support;
5257   PetscInt        coneSize, c, supportSize, s;
5258   PetscInt        pStart, pEnd, p, csize, ssize;
5259   PetscErrorCode  ierr;
5260 
5261   PetscFunctionBegin;
5262   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5263   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
5264   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
5265   /* Check that point p is found in the support of its cone points, and vice versa */
5266   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
5267   for (p = pStart; p < pEnd; ++p) {
5268     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
5269     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
5270     for (c = 0; c < coneSize; ++c) {
5271       PetscBool dup = PETSC_FALSE;
5272       PetscInt  d;
5273       for (d = c-1; d >= 0; --d) {
5274         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
5275       }
5276       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
5277       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
5278       for (s = 0; s < supportSize; ++s) {
5279         if (support[s] == p) break;
5280       }
5281       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
5282         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);CHKERRQ(ierr);
5283         for (s = 0; s < coneSize; ++s) {
5284           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);CHKERRQ(ierr);
5285         }
5286         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5287         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);CHKERRQ(ierr);
5288         for (s = 0; s < supportSize; ++s) {
5289           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);CHKERRQ(ierr);
5290         }
5291         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5292         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
5293         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
5294       }
5295     }
5296     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
5297     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
5298     for (s = 0; s < supportSize; ++s) {
5299       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5300       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5301       for (c = 0; c < coneSize; ++c) {
5302         if (cone[c] == p) break;
5303       }
5304       if (c >= coneSize) {
5305         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);CHKERRQ(ierr);
5306         for (c = 0; c < supportSize; ++c) {
5307           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);CHKERRQ(ierr);
5308         }
5309         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5310         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);CHKERRQ(ierr);
5311         for (c = 0; c < coneSize; ++c) {
5312           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);CHKERRQ(ierr);
5313         }
5314         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5315         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
5316       }
5317     }
5318   }
5319   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
5320   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
5321   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
5322   PetscFunctionReturn(0);
5323 }
5324 
5325 #undef __FUNCT__
5326 #define __FUNCT__ "DMPlexCheckSkeleton"
5327 /*@
5328   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
5329 
5330   Input Parameters:
5331 + dm - The DMPlex object
5332 . isSimplex - Are the cells simplices or tensor products
5333 - cellHeight - Normally 0
5334 
5335   Note: This is a useful diagnostic when creating meshes programmatically.
5336 
5337   Level: developer
5338 
5339 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
5340 @*/
5341 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5342 {
5343   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
5344   PetscErrorCode ierr;
5345 
5346   PetscFunctionBegin;
5347   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5348   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5349   switch (dim) {
5350   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
5351   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
5352   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
5353   default:
5354     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
5355   }
5356   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5357   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5358   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5359   cMax = cMax >= 0 ? cMax : cEnd;
5360   for (c = cStart; c < cMax; ++c) {
5361     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5362 
5363     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5364     for (cl = 0; cl < closureSize*2; cl += 2) {
5365       const PetscInt p = closure[cl];
5366       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5367     }
5368     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5369     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
5370   }
5371   for (c = cMax; c < cEnd; ++c) {
5372     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5373 
5374     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5375     for (cl = 0; cl < closureSize*2; cl += 2) {
5376       const PetscInt p = closure[cl];
5377       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5378     }
5379     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5380     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
5381   }
5382   PetscFunctionReturn(0);
5383 }
5384 
5385 #undef __FUNCT__
5386 #define __FUNCT__ "DMPlexCheckFaces"
5387 /*@
5388   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
5389 
5390   Input Parameters:
5391 + dm - The DMPlex object
5392 . isSimplex - Are the cells simplices or tensor products
5393 - cellHeight - Normally 0
5394 
5395   Note: This is a useful diagnostic when creating meshes programmatically.
5396 
5397   Level: developer
5398 
5399 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
5400 @*/
5401 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5402 {
5403   PetscInt       pMax[4];
5404   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
5405   PetscErrorCode ierr;
5406 
5407   PetscFunctionBegin;
5408   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5409   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5410   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5411   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
5412   for (h = cellHeight; h < dim; ++h) {
5413     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
5414     for (c = cStart; c < cEnd; ++c) {
5415       const PetscInt *cone, *ornt, *faces;
5416       PetscInt        numFaces, faceSize, coneSize,f;
5417       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
5418 
5419       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
5420       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
5421       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5422       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5423       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5424       for (cl = 0; cl < closureSize*2; cl += 2) {
5425         const PetscInt p = closure[cl];
5426         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
5427       }
5428       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5429       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
5430       for (f = 0; f < numFaces; ++f) {
5431         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
5432 
5433         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5434         for (cl = 0; cl < fclosureSize*2; cl += 2) {
5435           const PetscInt p = fclosure[cl];
5436           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
5437         }
5438         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);
5439         for (v = 0; v < fnumCorners; ++v) {
5440           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]);
5441         }
5442         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5443       }
5444       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5445       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5446     }
5447   }
5448   PetscFunctionReturn(0);
5449 }
5450 
5451 #undef __FUNCT__
5452 #define __FUNCT__ "DMCreateInterpolation_Plex"
5453 /* Pointwise interpolation
5454      Just code FEM for now
5455      u^f = I u^c
5456      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
5457      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
5458      I_{ij} = psi^f_i phi^c_j
5459 */
5460 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
5461 {
5462   PetscSection   gsc, gsf;
5463   PetscInt       m, n;
5464   void          *ctx;
5465   PetscErrorCode ierr;
5466 
5467   PetscFunctionBegin;
5468   /*
5469   Loop over coarse cells
5470     Loop over coarse basis functions
5471       Loop over fine cells in coarse cell
5472         Loop over fine dual basis functions
5473           Evaluate coarse basis on fine dual basis quad points
5474           Sum
5475           Update local element matrix
5476     Accumulate to interpolation matrix
5477 
5478    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
5479   */
5480   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
5481   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
5482   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
5483   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
5484   /* We need to preallocate properly */
5485   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
5486   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
5487   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
5488   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
5489   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
5490   /* Use naive scaling */
5491   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
5492   PetscFunctionReturn(0);
5493 }
5494 
5495 #undef __FUNCT__
5496 #define __FUNCT__ "DMCreateInjection_Plex"
5497 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
5498 {
5499   PetscErrorCode ierr;
5500   VecScatter     ctx;
5501 
5502   PetscFunctionBegin;
5503   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
5504   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
5505   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 #undef __FUNCT__
5510 #define __FUNCT__ "DMCreateDefaultSection_Plex"
5511 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
5512 {
5513   PetscSection   section;
5514   IS            *bcPoints, *bcComps;
5515   PetscBool     *isFE;
5516   PetscInt      *bcFields, *numComp, *numDof;
5517   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
5518   PetscInt       cStart, cEnd, cEndInterior;
5519   PetscErrorCode ierr;
5520 
5521   PetscFunctionBegin;
5522   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
5523   /* FE and FV boundary conditions are handled slightly differently */
5524   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
5525   for (f = 0; f < numFields; ++f) {
5526     PetscObject  obj;
5527     PetscClassId id;
5528 
5529     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5530     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
5531     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
5532     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
5533     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
5534   }
5535   /* Allocate boundary point storage for FEM boundaries */
5536   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5537   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5538   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
5539   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
5540   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
5541   for (bd = 0; bd < numBd; ++bd) {
5542     PetscInt  field;
5543     PetscBool isEssential;
5544 
5545     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, &field, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5546     if (isFE[field] && isEssential) ++numBC;
5547   }
5548   /* Add ghost cell boundaries for FVM */
5549   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
5550   ierr = PetscMalloc3(numBC,&bcFields,numBC,&bcPoints,numBC,&bcComps);CHKERRQ(ierr);
5551   /* Constrain ghost cells for FV */
5552   for (f = 0; f < numFields; ++f) {
5553     PetscInt *newidx, c;
5554 
5555     if (isFE[f] || cEndInterior < 0) continue;
5556     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
5557     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
5558     bcFields[bc] = f;
5559     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5560   }
5561   /* Handle FEM Dirichlet boundaries */
5562   for (bd = 0; bd < numBd; ++bd) {
5563     const char     *bdLabel;
5564     DMLabel         label;
5565     const PetscInt *comps;
5566     const PetscInt *values;
5567     PetscInt        bd2, field, numComps, numValues;
5568     PetscBool       isEssential, duplicate = PETSC_FALSE;
5569 
5570     bcComps[bc] = NULL;
5571     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, &numComps, &comps, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
5572     if (!isFE[field]) continue;
5573     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
5574     /* Only want to modify label once */
5575     for (bd2 = 0; bd2 < bd; ++bd2) {
5576       const char *bdname;
5577       ierr = DMPlexGetBoundary(dm, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
5578       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
5579       if (duplicate) break;
5580     }
5581     if (!duplicate && (isFE[field])) {
5582       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
5583       ierr = DMPlexLabelAddCells(dm, label);CHKERRQ(ierr);
5584     }
5585     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
5586     if (isEssential) {
5587       PetscInt       *newidx;
5588       PetscInt        n, newn = 0, p, v;
5589 
5590       bcFields[bc] = field;
5591       if (numComps) {ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), numComps, comps, PETSC_COPY_VALUES, &bcComps[bc]);CHKERRQ(ierr);}
5592       for (v = 0; v < numValues; ++v) {
5593         IS              tmp;
5594         const PetscInt *idx;
5595 
5596         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5597         if (!tmp) continue;
5598         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5599         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5600         if (isFE[field]) {
5601           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
5602         } else {
5603           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
5604         }
5605         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5606         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5607       }
5608       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
5609       newn = 0;
5610       for (v = 0; v < numValues; ++v) {
5611         IS              tmp;
5612         const PetscInt *idx;
5613 
5614         ierr = DMPlexGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
5615         if (!tmp) continue;
5616         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
5617         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
5618         if (isFE[field]) {
5619           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
5620         } else {
5621           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
5622         }
5623         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
5624         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
5625       }
5626       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
5627     }
5628   }
5629   /* Handle discretization */
5630   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
5631   for (f = 0; f < numFields; ++f) {
5632     PetscObject obj;
5633 
5634     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
5635     if (isFE[f]) {
5636       PetscFE         fe = (PetscFE) obj;
5637       const PetscInt *numFieldDof;
5638       PetscInt        d;
5639 
5640       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
5641       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
5642       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
5643     } else {
5644       PetscFV fv = (PetscFV) obj;
5645 
5646       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
5647       numDof[f*(dim+1)+dim] = numComp[f];
5648     }
5649   }
5650   for (f = 0; f < numFields; ++f) {
5651     PetscInt d;
5652     for (d = 1; d < dim; ++d) {
5653       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.");
5654     }
5655   }
5656   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcComps, bcPoints, NULL, &section);CHKERRQ(ierr);
5657   for (f = 0; f < numFields; ++f) {
5658     PetscFE     fe;
5659     const char *name;
5660 
5661     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
5662     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
5663     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
5664   }
5665   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
5666   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5667   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);ierr = ISDestroy(&bcComps[bc]);CHKERRQ(ierr);}
5668   ierr = PetscFree3(bcFields,bcPoints,bcComps);CHKERRQ(ierr);
5669   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
5670   ierr = PetscFree(isFE);CHKERRQ(ierr);
5671   PetscFunctionReturn(0);
5672 }
5673 
5674 #undef __FUNCT__
5675 #define __FUNCT__ "DMPlexGetCoarseDM"
5676 /*@
5677   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
5678 
5679   Input Parameter:
5680 . dm - The DMPlex object
5681 
5682   Output Parameter:
5683 . cdm - The coarse DM
5684 
5685   Level: intermediate
5686 
5687 .seealso: DMPlexSetCoarseDM()
5688 @*/
5689 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
5690 {
5691   PetscFunctionBegin;
5692   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5693   PetscValidPointer(cdm, 2);
5694   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
5695   PetscFunctionReturn(0);
5696 }
5697 
5698 #undef __FUNCT__
5699 #define __FUNCT__ "DMPlexSetCoarseDM"
5700 /*@
5701   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
5702 
5703   Input Parameters:
5704 + dm - The DMPlex object
5705 - cdm - The coarse DM
5706 
5707   Level: intermediate
5708 
5709 .seealso: DMPlexGetCoarseDM()
5710 @*/
5711 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
5712 {
5713   DM_Plex       *mesh;
5714   PetscErrorCode ierr;
5715 
5716   PetscFunctionBegin;
5717   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5718   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
5719   mesh = (DM_Plex *) dm->data;
5720   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
5721   mesh->coarseMesh = cdm;
5722   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
5723   PetscFunctionReturn(0);
5724 }
5725 
5726 /* anchors */
5727 #undef __FUNCT__
5728 #define __FUNCT__ "DMPlexGetAnchors"
5729 /*@
5730   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
5731   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
5732 
5733   not collective
5734 
5735   Input Parameters:
5736 . dm - The DMPlex object
5737 
5738   Output Parameters:
5739 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
5740 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
5741 
5742 
5743   Level: intermediate
5744 
5745 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
5746 @*/
5747 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
5748 {
5749   DM_Plex *plex = (DM_Plex *)dm->data;
5750   PetscErrorCode ierr;
5751 
5752   PetscFunctionBegin;
5753   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5754   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
5755   if (anchorSection) *anchorSection = plex->anchorSection;
5756   if (anchorIS) *anchorIS = plex->anchorIS;
5757   PetscFunctionReturn(0);
5758 }
5759 
5760 #undef __FUNCT__
5761 #define __FUNCT__ "DMPlexSetAnchors"
5762 /*@
5763   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
5764   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
5765   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
5766 
5767   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
5768   DMGetConstraints() and filling in the entries in the constraint matrix.
5769 
5770   collective on dm
5771 
5772   Input Parameters:
5773 + dm - The DMPlex object
5774 . 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).
5775 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
5776 
5777   The reference counts of anchorSection and anchorIS are incremented.
5778 
5779   Level: intermediate
5780 
5781 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
5782 @*/
5783 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
5784 {
5785   DM_Plex        *plex = (DM_Plex *)dm->data;
5786   PetscMPIInt    result;
5787   PetscErrorCode ierr;
5788 
5789   PetscFunctionBegin;
5790   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5791   if (anchorSection) {
5792     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
5793     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
5794     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
5795   }
5796   if (anchorIS) {
5797     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
5798     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
5799     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
5800   }
5801 
5802   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
5803   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
5804   plex->anchorSection = anchorSection;
5805 
5806   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
5807   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
5808   plex->anchorIS = anchorIS;
5809 
5810 #if defined(PETSC_USE_DEBUG)
5811   if (anchorIS && anchorSection) {
5812     PetscInt size, a, pStart, pEnd;
5813     const PetscInt *anchors;
5814 
5815     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5816     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
5817     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
5818     for (a = 0; a < size; a++) {
5819       PetscInt p;
5820 
5821       p = anchors[a];
5822       if (p >= pStart && p < pEnd) {
5823         PetscInt dof;
5824 
5825         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5826         if (dof) {
5827           PetscErrorCode ierr2;
5828 
5829           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
5830           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %d cannot be constrained and an anchor",p);
5831         }
5832       }
5833     }
5834     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
5835   }
5836 #endif
5837   /* reset the generic constraints */
5838   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
5839   PetscFunctionReturn(0);
5840 }
5841 
5842 #undef __FUNCT__
5843 #define __FUNCT__ "DMPlexCreateConstraintSection_Anchors"
5844 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
5845 {
5846   PetscSection anchorSection;
5847   PetscInt pStart, pEnd, p, dof, numFields, f;
5848   PetscErrorCode ierr;
5849 
5850   PetscFunctionBegin;
5851   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5852   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
5853   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
5854   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5855   ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
5856   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
5857   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
5858   for (p = pStart; p < pEnd; p++) {
5859     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
5860     if (dof) {
5861       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
5862       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
5863       for (f = 0; f < numFields; f++) {
5864         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
5865         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
5866       }
5867     }
5868   }
5869   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
5870   PetscFunctionReturn(0);
5871 }
5872 
5873 #undef __FUNCT__
5874 #define __FUNCT__ "DMPlexCreateConstraintMatrix_Anchors"
5875 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
5876 {
5877   PetscSection aSec;
5878   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
5879   const PetscInt *anchors;
5880   PetscInt numFields, f;
5881   IS aIS;
5882   PetscErrorCode ierr;
5883 
5884   PetscFunctionBegin;
5885   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5886   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
5887   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
5888   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
5889   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
5890   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
5891   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
5892   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5893   ierr = PetscSectionGetChart(aSec,&pStart,&pEnd);CHKERRQ(ierr);
5894   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
5895   i[0] = 0;
5896   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
5897   for (p = pStart; p < pEnd; p++) {
5898     ierr = PetscSectionGetDof(aSec,p,&dof);CHKERRQ(ierr);
5899     if (!dof) continue;
5900     ierr = PetscSectionGetOffset(aSec,p,&off);CHKERRQ(ierr);
5901     if (numFields) {
5902       for (f = 0; f < numFields; f++) {
5903         annz = 0;
5904         for (q = 0; q < dof; q++) {
5905           a = anchors[off + q];
5906           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
5907           annz += aDof;
5908         }
5909         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
5910         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
5911         for (q = 0; q < dof; q++) {
5912           i[off + q + 1] = i[off + q] + annz;
5913         }
5914       }
5915     }
5916     else {
5917       annz = 0;
5918       for (q = 0; q < dof; q++) {
5919         a = anchors[off + q];
5920         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5921         annz += aDof;
5922       }
5923       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
5924       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
5925       for (q = 0; q < dof; q++) {
5926         i[off + q + 1] = i[off + q] + annz;
5927       }
5928     }
5929   }
5930   nnz = i[m];
5931   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
5932   offset = 0;
5933   for (p = pStart; p < pEnd; p++) {
5934     if (numFields) {
5935       for (f = 0; f < numFields; f++) {
5936         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
5937         for (q = 0; q < dof; q++) {
5938           PetscInt rDof, rOff, r;
5939           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
5940           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
5941           for (r = 0; r < rDof; r++) {
5942             PetscInt s;
5943 
5944             a = anchors[rOff + r];
5945 
5946             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
5947             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
5948             for (s = 0; s < aDof; s++) {
5949               j[offset++] = aOff + s;
5950             }
5951           }
5952         }
5953       }
5954     }
5955     else {
5956       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
5957       for (q = 0; q < dof; q++) {
5958         PetscInt rDof, rOff, r;
5959         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
5960         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
5961         for (r = 0; r < rDof; r++) {
5962           PetscInt s;
5963 
5964           a = anchors[rOff + r];
5965 
5966           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5967           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
5968           for (s = 0; s < aDof; s++) {
5969             j[offset++] = aOff + s;
5970           }
5971         }
5972       }
5973     }
5974   }
5975   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
5976   ierr = PetscFree(i);CHKERRQ(ierr);
5977   ierr = PetscFree(j);CHKERRQ(ierr);
5978   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5979   PetscFunctionReturn(0);
5980 }
5981 
5982 #undef __FUNCT__
5983 #define __FUNCT__ "DMCreateDefaultConstraints_Plex"
5984 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
5985 {
5986   DM_Plex        *plex = (DM_Plex *)dm->data;
5987   PetscSection   anchorSection, section, cSec;
5988   Mat            cMat;
5989   PetscErrorCode ierr;
5990 
5991   PetscFunctionBegin;
5992   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5993   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
5994   if (anchorSection) {
5995     PetscDS  ds;
5996     PetscInt nf;
5997 
5998     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
5999     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
6000     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
6001     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
6002     ierr = PetscDSGetNumFields(ds,&nf);CHKERRQ(ierr);
6003     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
6004     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
6005     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
6006     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
6007   }
6008   PetscFunctionReturn(0);
6009 }
6010