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