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