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