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