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