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