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