xref: /petsc/src/dm/impls/plex/plex.c (revision e8f90184dbb04f8fc5f4d8ad28300e7ae02c22e7)
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         Mat          G;
3027         PetscBT      seenProcs, flippedProcs;
3028         PetscInt    *procFIFO, pTop, pBottom;
3029         PetscInt    *adj = NULL;
3030         PetscBool   *val = NULL;
3031         PetscMPIInt *recvcounts = NULL, *displs = NULL, p;
3032         PetscMPIInt  N = numNeighbors, numProcs = 0, rank;
3033         PetscInt     debug = 0;
3034 
3035         ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3036         if (!rank) {ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);}
3037         ierr = PetscCalloc2(numProcs,&recvcounts,numProcs+1,&displs);CHKERRQ(ierr);
3038         ierr = MPI_Gather(&N, 1, MPI_INT, recvcounts, 1, MPI_INT, 0, comm);CHKERRQ(ierr);
3039         for (p = 0; p < numProcs; ++p) {
3040           displs[p+1] = displs[p] + recvcounts[p];
3041         }
3042         if (!rank) {ierr = PetscMalloc2(displs[numProcs],&adj,displs[numProcs],&val);CHKERRQ(ierr);}
3043         ierr = MPI_Gatherv(nranks, numNeighbors, MPIU_INT, adj, recvcounts, displs, MPIU_INT, 0, comm);CHKERRQ(ierr);
3044         ierr = MPI_Gatherv(match, numNeighbors, MPIU_BOOL, val, recvcounts, displs, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
3045         if (debug) {
3046           for (p = 0; p < numProcs; ++p) {
3047             ierr = PetscPrintf(comm, "Proc %d:\n", p);
3048             for (n = 0; n < recvcounts[p]; ++n) {
3049               ierr = PetscPrintf(comm, "  edge %d (%d):\n", adj[displs[p]+n], val[displs[p]+n]);
3050             }
3051           }
3052         }
3053         /* Symmetrize the graph */
3054         ierr = MatCreate(PETSC_COMM_SELF, &G);CHKERRQ(ierr);
3055         ierr = MatSetSizes(G, numProcs, numProcs, numProcs, numProcs);CHKERRQ(ierr);
3056         ierr = MatSetUp(G);CHKERRQ(ierr);
3057         for (p = 0; p < numProcs; ++p) {
3058           for (n = 0; n < recvcounts[p]; ++n) {
3059             const PetscInt    q = adj[displs[p]+n];
3060             const PetscScalar o = val[displs[p]+n];
3061 
3062             ierr = MatSetValues(G, 1, &p, 1, &q, &o, INSERT_VALUES);CHKERRQ(ierr);
3063             ierr = MatSetValues(G, 1, &q, 1, &p, &o, INSERT_VALUES);CHKERRQ(ierr);
3064           }
3065         }
3066         ierr = MatAssemblyBegin(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3067         ierr = MatAssemblyEnd(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3068 
3069         ierr = PetscBTCreate(numProcs, &seenProcs);CHKERRQ(ierr);
3070         ierr = PetscBTMemzero(numProcs, seenProcs);CHKERRQ(ierr);
3071         ierr = PetscBTCreate(numProcs, &flippedProcs);CHKERRQ(ierr);
3072         ierr = PetscBTMemzero(numProcs, flippedProcs);CHKERRQ(ierr);
3073         ierr = PetscMalloc1(numProcs,&procFIFO);CHKERRQ(ierr);
3074         pTop = pBottom = 0;
3075         for (p = 0; p < numProcs; ++p) {
3076           if (PetscBTLookup(seenProcs, p)) continue;
3077           /* Initialize FIFO with next proc */
3078           procFIFO[pBottom++] = p;
3079           ierr = PetscBTSet(seenProcs, p);CHKERRQ(ierr);
3080           /* Consider each proc in FIFO */
3081           while (pTop < pBottom) {
3082             const PetscScalar *ornt;
3083             const PetscInt    *neighbors;
3084             PetscInt           proc, nproc, seen, flippedA, flippedB, mismatch, numNeighbors;
3085 
3086             proc     = procFIFO[pTop++];
3087             flippedA = PetscBTLookup(flippedProcs, proc) ? 1 : 0;
3088             ierr = MatGetRow(G, proc, &numNeighbors, &neighbors, &ornt);CHKERRQ(ierr);
3089             /* Loop over neighboring procs */
3090             for (n = 0; n < numNeighbors; ++n) {
3091               nproc    = neighbors[n];
3092               mismatch = ornt[n] > 0.5 ? 0 : 1;
3093               seen     = PetscBTLookup(seenProcs, nproc);
3094               flippedB = PetscBTLookup(flippedProcs, nproc) ? 1 : 0;
3095 
3096               if (mismatch ^ (flippedA ^ flippedB)) {
3097                 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);
3098                 if (!flippedB) {
3099                   ierr = PetscBTSet(flippedProcs, nproc);CHKERRQ(ierr);
3100               } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Inconsistent mesh orientation: Fault mesh is non-orientable");
3101               } else if (mismatch && flippedA && flippedB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Attempt to flip already flipped cell: Fault mesh is non-orientable");
3102               if (!seen) {
3103                 procFIFO[pBottom++] = nproc;
3104                 ierr = PetscBTSet(seenProcs, nproc);CHKERRQ(ierr);
3105               }
3106             }
3107           }
3108         }
3109         ierr = PetscFree(procFIFO);CHKERRQ(ierr);
3110         ierr = MatDestroy(&G);CHKERRQ(ierr);
3111 
3112         ierr = PetscFree2(recvcounts,displs);CHKERRQ(ierr);
3113         ierr = PetscFree2(adj,val);CHKERRQ(ierr);
3114         {
3115           PetscBool *flips;
3116 
3117           ierr = PetscMalloc1(numProcs,&flips);CHKERRQ(ierr);
3118           for (p = 0; p < numProcs; ++p) {
3119             flips[p] = PetscBTLookup(flippedProcs, p) ? PETSC_TRUE : PETSC_FALSE;
3120             if (debug && flips[p]) {ierr = PetscPrintf(comm, "Flipping Proc %d:\n", p);}
3121           }
3122           ierr = MPI_Scatter(flips, 1, MPIU_BOOL, &flipped, 1, MPIU_BOOL, 0, comm);CHKERRQ(ierr);
3123           ierr = PetscFree(flips);CHKERRQ(ierr);
3124         }
3125         ierr = PetscBTDestroy(&seenProcs);CHKERRQ(ierr);
3126         ierr = PetscBTDestroy(&flippedProcs);CHKERRQ(ierr);
3127       }
3128       ierr = PetscFree4(match,nranks,rornt,lornt);CHKERRQ(ierr);
3129       ierr = PetscFree(neighbors);CHKERRQ(ierr);
3130       if (flipped) {for (c = cStart; c < cEnd; ++c) {ierr = PetscBTNegate(flippedCells, c-cStart);CHKERRQ(ierr);}}
3131     }
3132   }
3133   /* Reverse flipped cells in the mesh */
3134   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
3135   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
3136   ierr = DMGetWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
3137   for (c = cStart; c < cEnd; ++c) {
3138     const PetscInt *cone, *coneO, *support;
3139     PetscInt        coneSize, supportSize, faceSize, cp, sp;
3140 
3141     if (!PetscBTLookup(flippedCells, c-cStart)) continue;
3142     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
3143     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
3144     ierr = DMPlexGetConeOrientation(dm, c, &coneO);CHKERRQ(ierr);
3145     for (cp = 0; cp < coneSize; ++cp) {
3146       const PetscInt rcp = coneSize-cp-1;
3147 
3148       ierr = DMPlexGetConeSize(dm, cone[rcp], &faceSize);CHKERRQ(ierr);
3149       revcone[cp]  = cone[rcp];
3150       revconeO[cp] = coneO[rcp] >= 0 ? -(faceSize-coneO[rcp]) : faceSize+coneO[rcp];
3151     }
3152     ierr = DMPlexSetCone(dm, c, revcone);CHKERRQ(ierr);
3153     ierr = DMPlexSetConeOrientation(dm, c, revconeO);CHKERRQ(ierr);
3154     /* Reverse orientations of support */
3155     faceSize = coneSize;
3156     ierr = DMPlexGetSupportSize(dm, c, &supportSize);CHKERRQ(ierr);
3157     ierr = DMPlexGetSupport(dm, c, &support);CHKERRQ(ierr);
3158     for (sp = 0; sp < supportSize; ++sp) {
3159       ierr = DMPlexGetConeSize(dm, support[sp], &coneSize);CHKERRQ(ierr);
3160       ierr = DMPlexGetCone(dm, support[sp], &cone);CHKERRQ(ierr);
3161       ierr = DMPlexGetConeOrientation(dm, support[sp], &coneO);CHKERRQ(ierr);
3162       for (cp = 0; cp < coneSize; ++cp) {
3163         if (cone[cp] != c) continue;
3164         ierr = DMPlexInsertConeOrientation(dm, support[sp], cp, coneO[cp] >= 0 ? -(faceSize-coneO[cp]) : faceSize+coneO[cp]);CHKERRQ(ierr);
3165       }
3166     }
3167   }
3168   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revcone);CHKERRQ(ierr);
3169   ierr = DMRestoreWorkArray(dm, maxConeSize, PETSC_INT, &revconeO);CHKERRQ(ierr);
3170   ierr = PetscBTDestroy(&seenCells);CHKERRQ(ierr);
3171   ierr = PetscBTDestroy(&flippedCells);CHKERRQ(ierr);
3172   ierr = PetscBTDestroy(&seenFaces);CHKERRQ(ierr);
3173   ierr = PetscFree(faceFIFO);CHKERRQ(ierr);
3174   PetscFunctionReturn(0);
3175 }
3176 
3177 #undef __FUNCT__
3178 #define __FUNCT__ "DMPlexInvertCell"
3179 /*@C
3180   DMPlexInvertCell - This flips tetrahedron and hexahedron orientation since Plex stores them internally with outward normals. Other cells are left untouched.
3181 
3182   Input Parameters:
3183 + numCorners - The number of vertices in a cell
3184 - cone - The incoming cone
3185 
3186   Output Parameter:
3187 . cone - The inverted cone (in-place)
3188 
3189   Level: developer
3190 
3191 .seealso: DMPlexGenerate()
3192 @*/
3193 PetscErrorCode DMPlexInvertCell(PetscInt dim, PetscInt numCorners, int cone[])
3194 {
3195   int tmpc;
3196 
3197   PetscFunctionBegin;
3198   if (dim != 3) PetscFunctionReturn(0);
3199   switch (numCorners) {
3200   case 4:
3201     tmpc    = cone[0];
3202     cone[0] = cone[1];
3203     cone[1] = tmpc;
3204     break;
3205   case 8:
3206     tmpc    = cone[1];
3207     cone[1] = cone[3];
3208     cone[3] = tmpc;
3209     break;
3210   default: break;
3211   }
3212   PetscFunctionReturn(0);
3213 }
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "DMPlexInvertCells_Internal"
3217 /* This is to fix the tetrahedron orientation from TetGen */
3218 PETSC_UNUSED static PetscErrorCode DMPlexInvertCells_Internal(PetscInt dim, PetscInt numCells, PetscInt numCorners, int cells[])
3219 {
3220   PetscInt       bound = numCells*numCorners, coff;
3221   PetscErrorCode ierr;
3222 
3223   PetscFunctionBegin;
3224   for (coff = 0; coff < bound; coff += numCorners) {
3225     ierr = DMPlexInvertCell(dim, numCorners, &cells[coff]);CHKERRQ(ierr);
3226   }
3227   PetscFunctionReturn(0);
3228 }
3229 
3230 #if defined(PETSC_HAVE_TRIANGLE)
3231 #include <triangle.h>
3232 
3233 #undef __FUNCT__
3234 #define __FUNCT__ "InitInput_Triangle"
3235 PetscErrorCode InitInput_Triangle(struct triangulateio *inputCtx)
3236 {
3237   PetscFunctionBegin;
3238   inputCtx->numberofpoints             = 0;
3239   inputCtx->numberofpointattributes    = 0;
3240   inputCtx->pointlist                  = NULL;
3241   inputCtx->pointattributelist         = NULL;
3242   inputCtx->pointmarkerlist            = NULL;
3243   inputCtx->numberofsegments           = 0;
3244   inputCtx->segmentlist                = NULL;
3245   inputCtx->segmentmarkerlist          = NULL;
3246   inputCtx->numberoftriangleattributes = 0;
3247   inputCtx->trianglelist               = NULL;
3248   inputCtx->numberofholes              = 0;
3249   inputCtx->holelist                   = NULL;
3250   inputCtx->numberofregions            = 0;
3251   inputCtx->regionlist                 = NULL;
3252   PetscFunctionReturn(0);
3253 }
3254 
3255 #undef __FUNCT__
3256 #define __FUNCT__ "InitOutput_Triangle"
3257 PetscErrorCode InitOutput_Triangle(struct triangulateio *outputCtx)
3258 {
3259   PetscFunctionBegin;
3260   outputCtx->numberofpoints        = 0;
3261   outputCtx->pointlist             = NULL;
3262   outputCtx->pointattributelist    = NULL;
3263   outputCtx->pointmarkerlist       = NULL;
3264   outputCtx->numberoftriangles     = 0;
3265   outputCtx->trianglelist          = NULL;
3266   outputCtx->triangleattributelist = NULL;
3267   outputCtx->neighborlist          = NULL;
3268   outputCtx->segmentlist           = NULL;
3269   outputCtx->segmentmarkerlist     = NULL;
3270   outputCtx->numberofedges         = 0;
3271   outputCtx->edgelist              = NULL;
3272   outputCtx->edgemarkerlist        = NULL;
3273   PetscFunctionReturn(0);
3274 }
3275 
3276 #undef __FUNCT__
3277 #define __FUNCT__ "FiniOutput_Triangle"
3278 PetscErrorCode FiniOutput_Triangle(struct triangulateio *outputCtx)
3279 {
3280   PetscFunctionBegin;
3281   free(outputCtx->pointlist);
3282   free(outputCtx->pointmarkerlist);
3283   free(outputCtx->segmentlist);
3284   free(outputCtx->segmentmarkerlist);
3285   free(outputCtx->edgelist);
3286   free(outputCtx->edgemarkerlist);
3287   free(outputCtx->trianglelist);
3288   free(outputCtx->neighborlist);
3289   PetscFunctionReturn(0);
3290 }
3291 
3292 #undef __FUNCT__
3293 #define __FUNCT__ "DMPlexGenerate_Triangle"
3294 PetscErrorCode DMPlexGenerate_Triangle(DM boundary, PetscBool interpolate, DM *dm)
3295 {
3296   MPI_Comm             comm;
3297   PetscInt             dim              = 2;
3298   const PetscBool      createConvexHull = PETSC_FALSE;
3299   const PetscBool      constrained      = PETSC_FALSE;
3300   struct triangulateio in;
3301   struct triangulateio out;
3302   PetscInt             vStart, vEnd, v, eStart, eEnd, e;
3303   PetscMPIInt          rank;
3304   PetscErrorCode       ierr;
3305 
3306   PetscFunctionBegin;
3307   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3308   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3309   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3310   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3311   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3312 
3313   in.numberofpoints = vEnd - vStart;
3314   if (in.numberofpoints > 0) {
3315     PetscSection coordSection;
3316     Vec          coordinates;
3317     PetscScalar *array;
3318 
3319     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3320     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3321     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3322     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3323     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3324     for (v = vStart; v < vEnd; ++v) {
3325       const PetscInt idx = v - vStart;
3326       PetscInt       off, d;
3327 
3328       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3329       for (d = 0; d < dim; ++d) {
3330         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3331       }
3332       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3333     }
3334     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3335   }
3336   ierr  = DMPlexGetHeightStratum(boundary, 0, &eStart, &eEnd);CHKERRQ(ierr);
3337   in.numberofsegments = eEnd - eStart;
3338   if (in.numberofsegments > 0) {
3339     ierr = PetscMalloc1(in.numberofsegments*2, &in.segmentlist);CHKERRQ(ierr);
3340     ierr = PetscMalloc1(in.numberofsegments, &in.segmentmarkerlist);CHKERRQ(ierr);
3341     for (e = eStart; e < eEnd; ++e) {
3342       const PetscInt  idx = e - eStart;
3343       const PetscInt *cone;
3344 
3345       ierr = DMPlexGetCone(boundary, e, &cone);CHKERRQ(ierr);
3346 
3347       in.segmentlist[idx*2+0] = cone[0] - vStart;
3348       in.segmentlist[idx*2+1] = cone[1] - vStart;
3349 
3350       ierr = DMPlexGetLabelValue(boundary, "marker", e, &in.segmentmarkerlist[idx]);CHKERRQ(ierr);
3351     }
3352   }
3353 #if 0 /* Do not currently support holes */
3354   PetscReal *holeCoords;
3355   PetscInt   h, d;
3356 
3357   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3358   if (in.numberofholes > 0) {
3359     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3360     for (h = 0; h < in.numberofholes; ++h) {
3361       for (d = 0; d < dim; ++d) {
3362         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3363       }
3364     }
3365   }
3366 #endif
3367   if (!rank) {
3368     char args[32];
3369 
3370     /* Take away 'Q' for verbose output */
3371     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3372     if (createConvexHull) {
3373       ierr = PetscStrcat(args, "c");CHKERRQ(ierr);
3374     }
3375     if (constrained) {
3376       ierr = PetscStrcpy(args, "zepDQ");CHKERRQ(ierr);
3377     }
3378     triangulate(args, &in, &out, NULL);
3379   }
3380   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3381   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3382   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3383   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3384   ierr = PetscFree(in.holelist);CHKERRQ(ierr);
3385 
3386   {
3387     const PetscInt numCorners  = 3;
3388     const PetscInt numCells    = out.numberoftriangles;
3389     const PetscInt numVertices = out.numberofpoints;
3390     const int     *cells      = out.trianglelist;
3391     const double  *meshCoords = out.pointlist;
3392 
3393     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3394     /* Set labels */
3395     for (v = 0; v < numVertices; ++v) {
3396       if (out.pointmarkerlist[v]) {
3397         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3398       }
3399     }
3400     if (interpolate) {
3401       for (e = 0; e < out.numberofedges; e++) {
3402         if (out.edgemarkerlist[e]) {
3403           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3404           const PetscInt *edges;
3405           PetscInt        numEdges;
3406 
3407           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3408           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3409           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3410           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3411         }
3412       }
3413     }
3414     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3415   }
3416 #if 0 /* Do not currently support holes */
3417   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3418 #endif
3419   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3420   PetscFunctionReturn(0);
3421 }
3422 
3423 #undef __FUNCT__
3424 #define __FUNCT__ "DMPlexRefine_Triangle"
3425 PetscErrorCode DMPlexRefine_Triangle(DM dm, double *maxVolumes, DM *dmRefined)
3426 {
3427   MPI_Comm             comm;
3428   PetscInt             dim  = 2;
3429   struct triangulateio in;
3430   struct triangulateio out;
3431   PetscInt             vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3432   PetscMPIInt          rank;
3433   PetscErrorCode       ierr;
3434 
3435   PetscFunctionBegin;
3436   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3437   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3438   ierr = InitInput_Triangle(&in);CHKERRQ(ierr);
3439   ierr = InitOutput_Triangle(&out);CHKERRQ(ierr);
3440   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3441   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3442   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3443 
3444   in.numberofpoints = vEnd - vStart;
3445   if (in.numberofpoints > 0) {
3446     PetscSection coordSection;
3447     Vec          coordinates;
3448     PetscScalar *array;
3449 
3450     ierr = PetscMalloc1(in.numberofpoints*dim, &in.pointlist);CHKERRQ(ierr);
3451     ierr = PetscMalloc1(in.numberofpoints, &in.pointmarkerlist);CHKERRQ(ierr);
3452     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3453     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3454     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3455     for (v = vStart; v < vEnd; ++v) {
3456       const PetscInt idx = v - vStart;
3457       PetscInt       off, d;
3458 
3459       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3460       for (d = 0; d < dim; ++d) {
3461         in.pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3462       }
3463       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3464     }
3465     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3466   }
3467   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3468 
3469   in.numberofcorners   = 3;
3470   in.numberoftriangles = cEnd - cStart;
3471 
3472   in.trianglearealist  = (double*) maxVolumes;
3473   if (in.numberoftriangles > 0) {
3474     ierr = PetscMalloc1(in.numberoftriangles*in.numberofcorners, &in.trianglelist);CHKERRQ(ierr);
3475     for (c = cStart; c < cEnd; ++c) {
3476       const PetscInt idx      = c - cStart;
3477       PetscInt      *closure = NULL;
3478       PetscInt       closureSize;
3479 
3480       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3481       if ((closureSize != 4) && (closureSize != 7)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a triangle, %D vertices in closure", closureSize);
3482       for (v = 0; v < 3; ++v) {
3483         in.trianglelist[idx*in.numberofcorners + v] = closure[(v+closureSize-3)*2] - vStart;
3484       }
3485       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3486     }
3487   }
3488   /* TODO: Segment markers are missing on input */
3489 #if 0 /* Do not currently support holes */
3490   PetscReal *holeCoords;
3491   PetscInt   h, d;
3492 
3493   ierr = DMPlexGetHoles(boundary, &in.numberofholes, &holeCords);CHKERRQ(ierr);
3494   if (in.numberofholes > 0) {
3495     ierr = PetscMalloc1(in.numberofholes*dim, &in.holelist);CHKERRQ(ierr);
3496     for (h = 0; h < in.numberofholes; ++h) {
3497       for (d = 0; d < dim; ++d) {
3498         in.holelist[h*dim+d] = holeCoords[h*dim+d];
3499       }
3500     }
3501   }
3502 #endif
3503   if (!rank) {
3504     char args[32];
3505 
3506     /* Take away 'Q' for verbose output */
3507     ierr = PetscStrcpy(args, "pqezQra");CHKERRQ(ierr);
3508     triangulate(args, &in, &out, NULL);
3509   }
3510   ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
3511   ierr = PetscFree(in.pointmarkerlist);CHKERRQ(ierr);
3512   ierr = PetscFree(in.segmentlist);CHKERRQ(ierr);
3513   ierr = PetscFree(in.segmentmarkerlist);CHKERRQ(ierr);
3514   ierr = PetscFree(in.trianglelist);CHKERRQ(ierr);
3515 
3516   {
3517     const PetscInt numCorners  = 3;
3518     const PetscInt numCells    = out.numberoftriangles;
3519     const PetscInt numVertices = out.numberofpoints;
3520     const int     *cells      = out.trianglelist;
3521     const double  *meshCoords = out.pointlist;
3522     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3523 
3524     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3525     /* Set labels */
3526     for (v = 0; v < numVertices; ++v) {
3527       if (out.pointmarkerlist[v]) {
3528         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3529       }
3530     }
3531     if (interpolate) {
3532       PetscInt e;
3533 
3534       for (e = 0; e < out.numberofedges; e++) {
3535         if (out.edgemarkerlist[e]) {
3536           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3537           const PetscInt *edges;
3538           PetscInt        numEdges;
3539 
3540           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3541           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3542           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3543           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3544         }
3545       }
3546     }
3547     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3548   }
3549 #if 0 /* Do not currently support holes */
3550   ierr = DMPlexCopyHoles(*dm, boundary);CHKERRQ(ierr);
3551 #endif
3552   ierr = FiniOutput_Triangle(&out);CHKERRQ(ierr);
3553   PetscFunctionReturn(0);
3554 }
3555 #endif
3556 
3557 #if defined(PETSC_HAVE_TETGEN)
3558 #include <tetgen.h>
3559 #undef __FUNCT__
3560 #define __FUNCT__ "DMPlexGenerate_Tetgen"
3561 PetscErrorCode DMPlexGenerate_Tetgen(DM boundary, PetscBool interpolate, DM *dm)
3562 {
3563   MPI_Comm       comm;
3564   const PetscInt dim  = 3;
3565   ::tetgenio     in;
3566   ::tetgenio     out;
3567   PetscInt       vStart, vEnd, v, fStart, fEnd, f;
3568   PetscMPIInt    rank;
3569   PetscErrorCode ierr;
3570 
3571   PetscFunctionBegin;
3572   ierr              = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3573   ierr              = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3574   ierr              = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3575   in.numberofpoints = vEnd - vStart;
3576   if (in.numberofpoints > 0) {
3577     PetscSection coordSection;
3578     Vec          coordinates;
3579     PetscScalar *array;
3580 
3581     in.pointlist       = new double[in.numberofpoints*dim];
3582     in.pointmarkerlist = new int[in.numberofpoints];
3583 
3584     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3585     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3586     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3587     for (v = vStart; v < vEnd; ++v) {
3588       const PetscInt idx = v - vStart;
3589       PetscInt       off, d;
3590 
3591       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3592       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3593       ierr = DMPlexGetLabelValue(boundary, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3594     }
3595     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3596   }
3597   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3598 
3599   in.numberoffacets = fEnd - fStart;
3600   if (in.numberoffacets > 0) {
3601     in.facetlist       = new tetgenio::facet[in.numberoffacets];
3602     in.facetmarkerlist = new int[in.numberoffacets];
3603     for (f = fStart; f < fEnd; ++f) {
3604       const PetscInt idx     = f - fStart;
3605       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v;
3606 
3607       in.facetlist[idx].numberofpolygons = 1;
3608       in.facetlist[idx].polygonlist      = new tetgenio::polygon[in.facetlist[idx].numberofpolygons];
3609       in.facetlist[idx].numberofholes    = 0;
3610       in.facetlist[idx].holelist         = NULL;
3611 
3612       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3613       for (p = 0; p < numPoints*2; p += 2) {
3614         const PetscInt point = points[p];
3615         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3616       }
3617 
3618       tetgenio::polygon *poly = in.facetlist[idx].polygonlist;
3619       poly->numberofvertices = numVertices;
3620       poly->vertexlist       = new int[poly->numberofvertices];
3621       for (v = 0; v < numVertices; ++v) {
3622         const PetscInt vIdx = points[v] - vStart;
3623         poly->vertexlist[v] = vIdx;
3624       }
3625       ierr = DMPlexGetLabelValue(boundary, "marker", f, &in.facetmarkerlist[idx]);CHKERRQ(ierr);
3626       ierr = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3627     }
3628   }
3629   if (!rank) {
3630     char args[32];
3631 
3632     /* Take away 'Q' for verbose output */
3633     ierr = PetscStrcpy(args, "pqezQ");CHKERRQ(ierr);
3634     ::tetrahedralize(args, &in, &out);
3635   }
3636   {
3637     const PetscInt numCorners  = 4;
3638     const PetscInt numCells    = out.numberoftetrahedra;
3639     const PetscInt numVertices = out.numberofpoints;
3640     const double   *meshCoords = out.pointlist;
3641     int            *cells      = out.tetrahedronlist;
3642 
3643     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3644     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3645     /* Set labels */
3646     for (v = 0; v < numVertices; ++v) {
3647       if (out.pointmarkerlist[v]) {
3648         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3649       }
3650     }
3651     if (interpolate) {
3652       PetscInt e;
3653 
3654       for (e = 0; e < out.numberofedges; e++) {
3655         if (out.edgemarkerlist[e]) {
3656           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3657           const PetscInt *edges;
3658           PetscInt        numEdges;
3659 
3660           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3661           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3662           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3663           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3664         }
3665       }
3666       for (f = 0; f < out.numberoftrifaces; f++) {
3667         if (out.trifacemarkerlist[f]) {
3668           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3669           const PetscInt *faces;
3670           PetscInt        numFaces;
3671 
3672           ierr = DMPlexGetJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3673           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3674           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3675           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3676         }
3677       }
3678     }
3679     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3680   }
3681   PetscFunctionReturn(0);
3682 }
3683 
3684 #undef __FUNCT__
3685 #define __FUNCT__ "DMPlexRefine_Tetgen"
3686 PetscErrorCode DMPlexRefine_Tetgen(DM dm, double *maxVolumes, DM *dmRefined)
3687 {
3688   MPI_Comm       comm;
3689   const PetscInt dim  = 3;
3690   ::tetgenio     in;
3691   ::tetgenio     out;
3692   PetscInt       vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3693   PetscMPIInt    rank;
3694   PetscErrorCode ierr;
3695 
3696   PetscFunctionBegin;
3697   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3698   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3699   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3700   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3701   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3702 
3703   in.numberofpoints = vEnd - vStart;
3704   if (in.numberofpoints > 0) {
3705     PetscSection coordSection;
3706     Vec          coordinates;
3707     PetscScalar *array;
3708 
3709     in.pointlist       = new double[in.numberofpoints*dim];
3710     in.pointmarkerlist = new int[in.numberofpoints];
3711 
3712     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3713     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3714     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3715     for (v = vStart; v < vEnd; ++v) {
3716       const PetscInt idx = v - vStart;
3717       PetscInt       off, d;
3718 
3719       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3720       for (d = 0; d < dim; ++d) in.pointlist[idx*dim + d] = array[off+d];
3721       ierr = DMPlexGetLabelValue(dm, "marker", v, &in.pointmarkerlist[idx]);CHKERRQ(ierr);
3722     }
3723     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3724   }
3725   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3726 
3727   in.numberofcorners       = 4;
3728   in.numberoftetrahedra    = cEnd - cStart;
3729   in.tetrahedronvolumelist = (double*) maxVolumes;
3730   if (in.numberoftetrahedra > 0) {
3731     in.tetrahedronlist = new int[in.numberoftetrahedra*in.numberofcorners];
3732     for (c = cStart; c < cEnd; ++c) {
3733       const PetscInt idx      = c - cStart;
3734       PetscInt      *closure = NULL;
3735       PetscInt       closureSize;
3736 
3737       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3738       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
3739       for (v = 0; v < 4; ++v) {
3740         in.tetrahedronlist[idx*in.numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
3741       }
3742       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
3743     }
3744   }
3745   /* TODO: Put in boundary faces with markers */
3746   if (!rank) {
3747     char args[32];
3748 
3749     /* Take away 'Q' for verbose output */
3750     /*ierr = PetscStrcpy(args, "qezQra");CHKERRQ(ierr); */
3751     ierr = PetscStrcpy(args, "qezraVVVV");CHKERRQ(ierr);
3752     ::tetrahedralize(args, &in, &out);
3753   }
3754   in.tetrahedronvolumelist = NULL;
3755 
3756   {
3757     const PetscInt numCorners  = 4;
3758     const PetscInt numCells    = out.numberoftetrahedra;
3759     const PetscInt numVertices = out.numberofpoints;
3760     const double   *meshCoords = out.pointlist;
3761     int            *cells      = out.tetrahedronlist;
3762 
3763     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
3764 
3765     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3766     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
3767     /* Set labels */
3768     for (v = 0; v < numVertices; ++v) {
3769       if (out.pointmarkerlist[v]) {
3770         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out.pointmarkerlist[v]);CHKERRQ(ierr);
3771       }
3772     }
3773     if (interpolate) {
3774       PetscInt e, f;
3775 
3776       for (e = 0; e < out.numberofedges; e++) {
3777         if (out.edgemarkerlist[e]) {
3778           const PetscInt  vertices[2] = {out.edgelist[e*2+0]+numCells, out.edgelist[e*2+1]+numCells};
3779           const PetscInt *edges;
3780           PetscInt        numEdges;
3781 
3782           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3783           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3784           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out.edgemarkerlist[e]);CHKERRQ(ierr);
3785           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3786         }
3787       }
3788       for (f = 0; f < out.numberoftrifaces; f++) {
3789         if (out.trifacemarkerlist[f]) {
3790           const PetscInt  vertices[3] = {out.trifacelist[f*3+0]+numCells, out.trifacelist[f*3+1]+numCells, out.trifacelist[f*3+2]+numCells};
3791           const PetscInt *faces;
3792           PetscInt        numFaces;
3793 
3794           ierr = DMPlexGetJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3795           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3796           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out.trifacemarkerlist[f]);CHKERRQ(ierr);
3797           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3798         }
3799       }
3800     }
3801     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
3802   }
3803   PetscFunctionReturn(0);
3804 }
3805 #endif
3806 
3807 #if defined(PETSC_HAVE_CTETGEN)
3808 #include <ctetgen.h>
3809 
3810 #undef __FUNCT__
3811 #define __FUNCT__ "DMPlexGenerate_CTetgen"
3812 PetscErrorCode DMPlexGenerate_CTetgen(DM boundary, PetscBool interpolate, DM *dm)
3813 {
3814   MPI_Comm       comm;
3815   const PetscInt dim  = 3;
3816   PLC           *in, *out;
3817   PetscInt       verbose = 0, vStart, vEnd, v, fStart, fEnd, f;
3818   PetscMPIInt    rank;
3819   PetscErrorCode ierr;
3820 
3821   PetscFunctionBegin;
3822   ierr = PetscObjectGetComm((PetscObject)boundary,&comm);CHKERRQ(ierr);
3823   ierr = PetscOptionsGetInt(((PetscObject) boundary)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3824   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3825   ierr = DMPlexGetDepthStratum(boundary, 0, &vStart, &vEnd);CHKERRQ(ierr);
3826   ierr = PLCCreate(&in);CHKERRQ(ierr);
3827   ierr = PLCCreate(&out);CHKERRQ(ierr);
3828 
3829   in->numberofpoints = vEnd - vStart;
3830   if (in->numberofpoints > 0) {
3831     PetscSection coordSection;
3832     Vec          coordinates;
3833     PetscScalar *array;
3834 
3835     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
3836     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
3837     ierr = DMGetCoordinatesLocal(boundary, &coordinates);CHKERRQ(ierr);
3838     ierr = DMGetCoordinateSection(boundary, &coordSection);CHKERRQ(ierr);
3839     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3840     for (v = vStart; v < vEnd; ++v) {
3841       const PetscInt idx = v - vStart;
3842       PetscInt       off, d, m;
3843 
3844       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3845       for (d = 0; d < dim; ++d) {
3846         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3847       }
3848       ierr = DMPlexGetLabelValue(boundary, "marker", v, &m);CHKERRQ(ierr);
3849 
3850       in->pointmarkerlist[idx] = (int) m;
3851     }
3852     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
3853   }
3854   ierr  = DMPlexGetHeightStratum(boundary, 0, &fStart, &fEnd);CHKERRQ(ierr);
3855 
3856   in->numberoffacets = fEnd - fStart;
3857   if (in->numberoffacets > 0) {
3858     ierr = PetscMalloc1(in->numberoffacets, &in->facetlist);CHKERRQ(ierr);
3859     ierr = PetscMalloc1(in->numberoffacets,   &in->facetmarkerlist);CHKERRQ(ierr);
3860     for (f = fStart; f < fEnd; ++f) {
3861       const PetscInt idx     = f - fStart;
3862       PetscInt      *points = NULL, numPoints, p, numVertices = 0, v, m;
3863       polygon       *poly;
3864 
3865       in->facetlist[idx].numberofpolygons = 1;
3866 
3867       ierr = PetscMalloc1(in->facetlist[idx].numberofpolygons, &in->facetlist[idx].polygonlist);CHKERRQ(ierr);
3868 
3869       in->facetlist[idx].numberofholes    = 0;
3870       in->facetlist[idx].holelist         = NULL;
3871 
3872       ierr = DMPlexGetTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3873       for (p = 0; p < numPoints*2; p += 2) {
3874         const PetscInt point = points[p];
3875         if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point;
3876       }
3877 
3878       poly                   = in->facetlist[idx].polygonlist;
3879       poly->numberofvertices = numVertices;
3880       ierr                   = PetscMalloc1(poly->numberofvertices, &poly->vertexlist);CHKERRQ(ierr);
3881       for (v = 0; v < numVertices; ++v) {
3882         const PetscInt vIdx = points[v] - vStart;
3883         poly->vertexlist[v] = vIdx;
3884       }
3885       ierr                     = DMPlexGetLabelValue(boundary, "marker", f, &m);CHKERRQ(ierr);
3886       in->facetmarkerlist[idx] = (int) m;
3887       ierr                     = DMPlexRestoreTransitiveClosure(boundary, f, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
3888     }
3889   }
3890   if (!rank) {
3891     TetGenOpts t;
3892 
3893     ierr        = TetGenOptsInitialize(&t);CHKERRQ(ierr);
3894     t.in        = boundary; /* Should go away */
3895     t.plc       = 1;
3896     t.quality   = 1;
3897     t.edgesout  = 1;
3898     t.zeroindex = 1;
3899     t.quiet     = 1;
3900     t.verbose   = verbose;
3901     ierr        = TetGenCheckOpts(&t);CHKERRQ(ierr);
3902     ierr        = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
3903   }
3904   {
3905     const PetscInt numCorners  = 4;
3906     const PetscInt numCells    = out->numberoftetrahedra;
3907     const PetscInt numVertices = out->numberofpoints;
3908     const double   *meshCoords = out->pointlist;
3909     int            *cells      = out->tetrahedronlist;
3910 
3911     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
3912     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dm);CHKERRQ(ierr);
3913     /* Set labels */
3914     for (v = 0; v < numVertices; ++v) {
3915       if (out->pointmarkerlist[v]) {
3916         ierr = DMPlexSetLabelValue(*dm, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
3917       }
3918     }
3919     if (interpolate) {
3920       PetscInt e;
3921 
3922       for (e = 0; e < out->numberofedges; e++) {
3923         if (out->edgemarkerlist[e]) {
3924           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
3925           const PetscInt *edges;
3926           PetscInt        numEdges;
3927 
3928           ierr = DMPlexGetJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3929           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
3930           ierr = DMPlexSetLabelValue(*dm, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
3931           ierr = DMPlexRestoreJoin(*dm, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
3932         }
3933       }
3934       for (f = 0; f < out->numberoftrifaces; f++) {
3935         if (out->trifacemarkerlist[f]) {
3936           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
3937           const PetscInt *faces;
3938           PetscInt        numFaces;
3939 
3940           ierr = DMPlexGetFullJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3941           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
3942           ierr = DMPlexSetLabelValue(*dm, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
3943           ierr = DMPlexRestoreJoin(*dm, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
3944         }
3945       }
3946     }
3947     ierr = DMPlexSetRefinementUniform(*dm, PETSC_FALSE);CHKERRQ(ierr);
3948   }
3949 
3950   ierr = PLCDestroy(&in);CHKERRQ(ierr);
3951   ierr = PLCDestroy(&out);CHKERRQ(ierr);
3952   PetscFunctionReturn(0);
3953 }
3954 
3955 #undef __FUNCT__
3956 #define __FUNCT__ "DMPlexRefine_CTetgen"
3957 PetscErrorCode DMPlexRefine_CTetgen(DM dm, PetscReal *maxVolumes, DM *dmRefined)
3958 {
3959   MPI_Comm       comm;
3960   const PetscInt dim  = 3;
3961   PLC           *in, *out;
3962   PetscInt       verbose = 0, vStart, vEnd, v, cStart, cEnd, c, depth, depthGlobal;
3963   PetscMPIInt    rank;
3964   PetscErrorCode ierr;
3965 
3966   PetscFunctionBegin;
3967   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3968   ierr = PetscOptionsGetInt(((PetscObject) dm)->prefix, "-ctetgen_verbose", &verbose, NULL);CHKERRQ(ierr);
3969   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
3970   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3971   ierr = MPI_Allreduce(&depth, &depthGlobal, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
3972   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3973   ierr = PLCCreate(&in);CHKERRQ(ierr);
3974   ierr = PLCCreate(&out);CHKERRQ(ierr);
3975 
3976   in->numberofpoints = vEnd - vStart;
3977   if (in->numberofpoints > 0) {
3978     PetscSection coordSection;
3979     Vec          coordinates;
3980     PetscScalar *array;
3981 
3982     ierr = PetscMalloc1(in->numberofpoints*dim, &in->pointlist);CHKERRQ(ierr);
3983     ierr = PetscMalloc1(in->numberofpoints,       &in->pointmarkerlist);CHKERRQ(ierr);
3984     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
3985     ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
3986     ierr = VecGetArray(coordinates, &array);CHKERRQ(ierr);
3987     for (v = vStart; v < vEnd; ++v) {
3988       const PetscInt idx = v - vStart;
3989       PetscInt       off, d, m;
3990 
3991       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
3992       for (d = 0; d < dim; ++d) {
3993         in->pointlist[idx*dim + d] = PetscRealPart(array[off+d]);
3994       }
3995       ierr = DMPlexGetLabelValue(dm, "marker", v, &m);CHKERRQ(ierr);
3996 
3997       in->pointmarkerlist[idx] = (int) m;
3998     }
3999     ierr = VecRestoreArray(coordinates, &array);CHKERRQ(ierr);
4000   }
4001   ierr  = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4002 
4003   in->numberofcorners       = 4;
4004   in->numberoftetrahedra    = cEnd - cStart;
4005   in->tetrahedronvolumelist = maxVolumes;
4006   if (in->numberoftetrahedra > 0) {
4007     ierr = PetscMalloc1(in->numberoftetrahedra*in->numberofcorners, &in->tetrahedronlist);CHKERRQ(ierr);
4008     for (c = cStart; c < cEnd; ++c) {
4009       const PetscInt idx      = c - cStart;
4010       PetscInt      *closure = NULL;
4011       PetscInt       closureSize;
4012 
4013       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4014       if ((closureSize != 5) && (closureSize != 15)) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Mesh has cell which is not a tetrahedron, %D vertices in closure", closureSize);
4015       for (v = 0; v < 4; ++v) {
4016         in->tetrahedronlist[idx*in->numberofcorners + v] = closure[(v+closureSize-4)*2] - vStart;
4017       }
4018       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
4019     }
4020   }
4021   if (!rank) {
4022     TetGenOpts t;
4023 
4024     ierr = TetGenOptsInitialize(&t);CHKERRQ(ierr);
4025 
4026     t.in        = dm; /* Should go away */
4027     t.refine    = 1;
4028     t.varvolume = 1;
4029     t.quality   = 1;
4030     t.edgesout  = 1;
4031     t.zeroindex = 1;
4032     t.quiet     = 1;
4033     t.verbose   = verbose; /* Change this */
4034 
4035     ierr = TetGenCheckOpts(&t);CHKERRQ(ierr);
4036     ierr = TetGenTetrahedralize(&t, in, out);CHKERRQ(ierr);
4037   }
4038   {
4039     const PetscInt numCorners  = 4;
4040     const PetscInt numCells    = out->numberoftetrahedra;
4041     const PetscInt numVertices = out->numberofpoints;
4042     const double   *meshCoords = out->pointlist;
4043     int            *cells      = out->tetrahedronlist;
4044     PetscBool      interpolate = depthGlobal > 1 ? PETSC_TRUE : PETSC_FALSE;
4045 
4046     ierr = DMPlexInvertCells_Internal(dim, numCells, numCorners, cells);CHKERRQ(ierr);
4047     ierr = DMPlexCreateFromCellList(comm, dim, numCells, numVertices, numCorners, interpolate, cells, dim, meshCoords, dmRefined);CHKERRQ(ierr);
4048     /* Set labels */
4049     for (v = 0; v < numVertices; ++v) {
4050       if (out->pointmarkerlist[v]) {
4051         ierr = DMPlexSetLabelValue(*dmRefined, "marker", v+numCells, out->pointmarkerlist[v]);CHKERRQ(ierr);
4052       }
4053     }
4054     if (interpolate) {
4055       PetscInt e, f;
4056 
4057       for (e = 0; e < out->numberofedges; e++) {
4058         if (out->edgemarkerlist[e]) {
4059           const PetscInt  vertices[2] = {out->edgelist[e*2+0]+numCells, out->edgelist[e*2+1]+numCells};
4060           const PetscInt *edges;
4061           PetscInt        numEdges;
4062 
4063           ierr = DMPlexGetJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4064           if (numEdges != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Two vertices must cover only one edge, not %D", numEdges);
4065           ierr = DMPlexSetLabelValue(*dmRefined, "marker", edges[0], out->edgemarkerlist[e]);CHKERRQ(ierr);
4066           ierr = DMPlexRestoreJoin(*dmRefined, 2, vertices, &numEdges, &edges);CHKERRQ(ierr);
4067         }
4068       }
4069       for (f = 0; f < out->numberoftrifaces; f++) {
4070         if (out->trifacemarkerlist[f]) {
4071           const PetscInt  vertices[3] = {out->trifacelist[f*3+0]+numCells, out->trifacelist[f*3+1]+numCells, out->trifacelist[f*3+2]+numCells};
4072           const PetscInt *faces;
4073           PetscInt        numFaces;
4074 
4075           ierr = DMPlexGetFullJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4076           if (numFaces != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Three vertices must cover only one face, not %D", numFaces);
4077           ierr = DMPlexSetLabelValue(*dmRefined, "marker", faces[0], out->trifacemarkerlist[f]);CHKERRQ(ierr);
4078           ierr = DMPlexRestoreJoin(*dmRefined, 3, vertices, &numFaces, &faces);CHKERRQ(ierr);
4079         }
4080       }
4081     }
4082     ierr = DMPlexSetRefinementUniform(*dmRefined, PETSC_FALSE);CHKERRQ(ierr);
4083   }
4084   ierr = PLCDestroy(&in);CHKERRQ(ierr);
4085   ierr = PLCDestroy(&out);CHKERRQ(ierr);
4086   PetscFunctionReturn(0);
4087 }
4088 #endif
4089 
4090 #undef __FUNCT__
4091 #define __FUNCT__ "DMPlexGenerate"
4092 /*@C
4093   DMPlexGenerate - Generates a mesh.
4094 
4095   Not Collective
4096 
4097   Input Parameters:
4098 + boundary - The DMPlex boundary object
4099 . name - The mesh generation package name
4100 - interpolate - Flag to create intermediate mesh elements
4101 
4102   Output Parameter:
4103 . mesh - The DMPlex object
4104 
4105   Level: intermediate
4106 
4107 .keywords: mesh, elements
4108 .seealso: DMPlexCreate(), DMRefine()
4109 @*/
4110 PetscErrorCode DMPlexGenerate(DM boundary, const char name[], PetscBool interpolate, DM *mesh)
4111 {
4112   PetscInt       dim;
4113   char           genname[1024];
4114   PetscBool      isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4115   PetscErrorCode ierr;
4116 
4117   PetscFunctionBegin;
4118   PetscValidHeaderSpecific(boundary, DM_CLASSID, 1);
4119   PetscValidLogicalCollectiveBool(boundary, interpolate, 2);
4120   ierr = DMPlexGetDimension(boundary, &dim);CHKERRQ(ierr);
4121   ierr = PetscOptionsGetString(((PetscObject) boundary)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4122   if (flg) name = genname;
4123   if (name) {
4124     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4125     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4126     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4127   }
4128   switch (dim) {
4129   case 1:
4130     if (!name || isTriangle) {
4131 #if defined(PETSC_HAVE_TRIANGLE)
4132       ierr = DMPlexGenerate_Triangle(boundary, interpolate, mesh);CHKERRQ(ierr);
4133 #else
4134       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation needs external package support.\nPlease reconfigure with --download-triangle.");
4135 #endif
4136     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4137     break;
4138   case 2:
4139     if (!name || isCTetgen) {
4140 #if defined(PETSC_HAVE_CTETGEN)
4141       ierr = DMPlexGenerate_CTetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4142 #else
4143       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4144 #endif
4145     } else if (isTetgen) {
4146 #if defined(PETSC_HAVE_TETGEN)
4147       ierr = DMPlexGenerate_Tetgen(boundary, interpolate, mesh);CHKERRQ(ierr);
4148 #else
4149       SETERRQ(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4150 #endif
4151     } else SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4152     break;
4153   default:
4154     SETERRQ1(PetscObjectComm((PetscObject)boundary), PETSC_ERR_SUP, "Mesh generation for a dimension %d boundary is not supported.", dim);
4155   }
4156   PetscFunctionReturn(0);
4157 }
4158 
4159 #undef __FUNCT__
4160 #define __FUNCT__ "DMRefine_Plex"
4161 PetscErrorCode DMRefine_Plex(DM dm, MPI_Comm comm, DM *dmRefined)
4162 {
4163   PetscReal      refinementLimit;
4164   PetscInt       dim, cStart, cEnd;
4165   char           genname[1024], *name = NULL;
4166   PetscBool      isUniform, isTriangle = PETSC_FALSE, isTetgen = PETSC_FALSE, isCTetgen = PETSC_FALSE, flg;
4167   PetscErrorCode ierr;
4168 
4169   PetscFunctionBegin;
4170   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4171   if (isUniform) {
4172     CellRefiner cellRefiner;
4173 
4174     ierr = DMPlexGetCellRefiner_Internal(dm, &cellRefiner);CHKERRQ(ierr);
4175     ierr = DMPlexRefineUniform_Internal(dm, cellRefiner, dmRefined);CHKERRQ(ierr);
4176     PetscFunctionReturn(0);
4177   }
4178   ierr = DMPlexGetRefinementLimit(dm, &refinementLimit);CHKERRQ(ierr);
4179   if (refinementLimit == 0.0) PetscFunctionReturn(0);
4180   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
4181   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4182   ierr = PetscOptionsGetString(((PetscObject) dm)->prefix, "-dm_plex_generator", genname, 1024, &flg);CHKERRQ(ierr);
4183   if (flg) name = genname;
4184   if (name) {
4185     ierr = PetscStrcmp(name, "triangle", &isTriangle);CHKERRQ(ierr);
4186     ierr = PetscStrcmp(name, "tetgen",   &isTetgen);CHKERRQ(ierr);
4187     ierr = PetscStrcmp(name, "ctetgen",  &isCTetgen);CHKERRQ(ierr);
4188   }
4189   switch (dim) {
4190   case 2:
4191     if (!name || isTriangle) {
4192 #if defined(PETSC_HAVE_TRIANGLE)
4193       double  *maxVolumes;
4194       PetscInt c;
4195 
4196       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4197       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4198       ierr = DMPlexRefine_Triangle(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4199       ierr = PetscFree(maxVolumes);CHKERRQ(ierr);
4200 #else
4201       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement needs external package support.\nPlease reconfigure with --download-triangle.");
4202 #endif
4203     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 2D mesh generation package %s", name);
4204     break;
4205   case 3:
4206     if (!name || isCTetgen) {
4207 #if defined(PETSC_HAVE_CTETGEN)
4208       PetscReal *maxVolumes;
4209       PetscInt   c;
4210 
4211       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4212       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4213       ierr = DMPlexRefine_CTetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4214 #else
4215       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "CTetgen needs external package support.\nPlease reconfigure with --download-ctetgen.");
4216 #endif
4217     } else if (isTetgen) {
4218 #if defined(PETSC_HAVE_TETGEN)
4219       double  *maxVolumes;
4220       PetscInt c;
4221 
4222       ierr = PetscMalloc1((cEnd - cStart), &maxVolumes);CHKERRQ(ierr);
4223       for (c = 0; c < cEnd-cStart; ++c) maxVolumes[c] = refinementLimit;
4224       ierr = DMPlexRefine_Tetgen(dm, maxVolumes, dmRefined);CHKERRQ(ierr);
4225 #else
4226       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Tetgen needs external package support.\nPlease reconfigure with --with-c-language=cxx --download-tetgen.");
4227 #endif
4228     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unknown 3D mesh generation package %s", name);
4229     break;
4230   default:
4231     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Mesh refinement in dimension %d is not supported.", dim);
4232   }
4233   PetscFunctionReturn(0);
4234 }
4235 
4236 #undef __FUNCT__
4237 #define __FUNCT__ "DMRefineHierarchy_Plex"
4238 PetscErrorCode DMRefineHierarchy_Plex(DM dm, PetscInt nlevels, DM dmRefined[])
4239 {
4240   DM             cdm = dm;
4241   PetscInt       r;
4242   PetscBool      isUniform;
4243   PetscErrorCode ierr;
4244 
4245   PetscFunctionBegin;
4246   ierr = DMPlexGetRefinementUniform(dm, &isUniform);CHKERRQ(ierr);
4247   if (!isUniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Non-uniform refinement is incompatible with the hierarchy");
4248   for (r = 0; r < nlevels; ++r) {
4249     CellRefiner cellRefiner;
4250 
4251     ierr = DMPlexGetCellRefiner_Internal(cdm, &cellRefiner);CHKERRQ(ierr);
4252     ierr = DMPlexRefineUniform_Internal(cdm, cellRefiner, &dmRefined[r]);CHKERRQ(ierr);
4253     ierr = DMPlexSetCoarseDM(dmRefined[r], cdm);CHKERRQ(ierr);
4254     cdm  = dmRefined[r];
4255   }
4256   PetscFunctionReturn(0);
4257 }
4258 
4259 #undef __FUNCT__
4260 #define __FUNCT__ "DMCoarsen_Plex"
4261 PetscErrorCode DMCoarsen_Plex(DM dm, MPI_Comm comm, DM *dmCoarsened)
4262 {
4263   DM_Plex       *mesh = (DM_Plex*) dm->data;
4264   PetscErrorCode ierr;
4265 
4266   PetscFunctionBegin;
4267   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
4268   *dmCoarsened = mesh->coarseMesh;
4269   PetscFunctionReturn(0);
4270 }
4271 
4272 #undef __FUNCT__
4273 #define __FUNCT__ "DMPlexLocalizeCoordinate_Internal"
4274 PetscErrorCode DMPlexLocalizeCoordinate_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__ "DMPlexLocalizeAddCoordinate_Internal"
4295 PetscErrorCode DMPlexLocalizeAddCoordinate_Internal(DM dm, PetscInt dim, const PetscScalar anchor[], const PetscScalar in[], PetscScalar out[])
4296 {
4297   PetscInt d;
4298 
4299   PetscFunctionBegin;
4300   if (!dm->maxCell) {
4301     for (d = 0; d < dim; ++d) out[d] += in[d];
4302   } else {
4303     for (d = 0; d < dim; ++d) {
4304       if (PetscAbsScalar(anchor[d] - in[d]) > dm->maxCell[d]) {
4305         out[d] += PetscRealPart(anchor[d]) > PetscRealPart(in[d]) ? dm->L[d] + in[d] : in[d] - dm->L[d];
4306       } else {
4307         out[d] += in[d];
4308       }
4309     }
4310   }
4311   PetscFunctionReturn(0);
4312 }
4313 
4314 #undef __FUNCT__
4315 #define __FUNCT__ "DMPlexLocalizeCoordinates"
4316 PetscErrorCode DMPlexLocalizeCoordinates(DM dm)
4317 {
4318   PetscSection   coordSection, cSection;
4319   Vec            coordinates,  cVec;
4320   PetscScalar   *coords, *coords2, *anchor;
4321   PetscInt       cStart, cEnd, c, vStart, vEnd, v, dof, d, off, off2, bs, coordSize;
4322   PetscErrorCode ierr;
4323 
4324   PetscFunctionBegin;
4325   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4326   if (!dm->maxCell) PetscFunctionReturn(0);
4327   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
4328   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
4329   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
4330   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
4331   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &cSection);CHKERRQ(ierr);
4332   ierr = PetscSectionSetChart(cSection, cStart, vEnd);CHKERRQ(ierr);
4333   for (v = vStart; v < vEnd; ++v) {
4334     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
4335     ierr = PetscSectionSetDof(cSection,     v,  dof);CHKERRQ(ierr);
4336   }
4337   for (c = cStart; c < cEnd; ++c) {
4338     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, NULL);CHKERRQ(ierr);
4339     ierr = PetscSectionSetDof(cSection, c, dof);CHKERRQ(ierr);
4340   }
4341   ierr = PetscSectionSetUp(cSection);CHKERRQ(ierr);
4342   ierr = PetscSectionGetStorageSize(cSection, &coordSize);CHKERRQ(ierr);
4343   ierr = VecCreate(PetscObjectComm((PetscObject) dm), &cVec);CHKERRQ(ierr);
4344   ierr = VecGetBlockSize(coordinates, &bs);CHKERRQ(ierr);
4345   ierr = VecSetBlockSize(cVec,         bs);CHKERRQ(ierr);
4346   ierr = VecSetSizes(cVec, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
4347   ierr = VecSetType(cVec,VECSTANDARD);CHKERRQ(ierr);
4348   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
4349   ierr = VecGetArray(cVec,        &coords2);CHKERRQ(ierr);
4350   for (v = vStart; v < vEnd; ++v) {
4351     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
4352     ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
4353     ierr = PetscSectionGetOffset(cSection,     v, &off2);CHKERRQ(ierr);
4354     for (d = 0; d < dof; ++d) coords2[off2+d] = coords[off+d];
4355   }
4356   ierr = DMGetWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
4357   for (c = cStart; c < cEnd; ++c) {
4358     PetscScalar *cellCoords = NULL;
4359     PetscInt     b;
4360 
4361     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
4362     ierr = PetscSectionGetOffset(cSection, c, &off2);CHKERRQ(ierr);
4363     for (b = 0; b < bs; ++b) anchor[b] = cellCoords[b];
4364     for (d = 0; d < dof/bs; ++d) {ierr = DMPlexLocalizeCoordinate_Internal(dm, bs, anchor, &cellCoords[d*bs], &coords2[off2+d*bs]);CHKERRQ(ierr);}
4365     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &dof, &cellCoords);CHKERRQ(ierr);
4366   }
4367   ierr = DMRestoreWorkArray(dm, 3, PETSC_SCALAR, &anchor);CHKERRQ(ierr);
4368   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
4369   ierr = VecRestoreArray(cVec,        &coords2);CHKERRQ(ierr);
4370   ierr = DMSetCoordinateSection(dm, cSection);CHKERRQ(ierr);
4371   ierr = DMSetCoordinatesLocal(dm, cVec);CHKERRQ(ierr);
4372   ierr = VecDestroy(&cVec);CHKERRQ(ierr);
4373   ierr = PetscSectionDestroy(&cSection);CHKERRQ(ierr);
4374   PetscFunctionReturn(0);
4375 }
4376 
4377 #undef __FUNCT__
4378 #define __FUNCT__ "DMPlexGetDepthLabel"
4379 /*@
4380   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
4381 
4382   Not Collective
4383 
4384   Input Parameter:
4385 . dm    - The DMPlex object
4386 
4387   Output Parameter:
4388 . depthLabel - The DMLabel recording point depth
4389 
4390   Level: developer
4391 
4392 .keywords: mesh, points
4393 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4394 @*/
4395 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
4396 {
4397   DM_Plex       *mesh = (DM_Plex*) dm->data;
4398   PetscErrorCode ierr;
4399 
4400   PetscFunctionBegin;
4401   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4402   PetscValidPointer(depthLabel, 2);
4403   if (!mesh->depthLabel) {ierr = DMPlexGetLabel(dm, "depth", &mesh->depthLabel);CHKERRQ(ierr);}
4404   *depthLabel = mesh->depthLabel;
4405   PetscFunctionReturn(0);
4406 }
4407 
4408 #undef __FUNCT__
4409 #define __FUNCT__ "DMPlexGetDepth"
4410 /*@
4411   DMPlexGetDepth - Get the depth of the DAG representing this mesh
4412 
4413   Not Collective
4414 
4415   Input Parameter:
4416 . dm    - The DMPlex object
4417 
4418   Output Parameter:
4419 . depth - The number of strata (breadth first levels) in the DAG
4420 
4421   Level: developer
4422 
4423 .keywords: mesh, points
4424 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
4425 @*/
4426 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
4427 {
4428   DMLabel        label;
4429   PetscInt       d = 0;
4430   PetscErrorCode ierr;
4431 
4432   PetscFunctionBegin;
4433   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4434   PetscValidPointer(depth, 2);
4435   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4436   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
4437   *depth = d-1;
4438   PetscFunctionReturn(0);
4439 }
4440 
4441 #undef __FUNCT__
4442 #define __FUNCT__ "DMPlexGetDepthStratum"
4443 /*@
4444   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
4445 
4446   Not Collective
4447 
4448   Input Parameters:
4449 + dm           - The DMPlex object
4450 - stratumValue - The requested depth
4451 
4452   Output Parameters:
4453 + start - The first point at this depth
4454 - end   - One beyond the last point at this depth
4455 
4456   Level: developer
4457 
4458 .keywords: mesh, points
4459 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
4460 @*/
4461 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4462 {
4463   DMLabel        label;
4464   PetscInt       pStart, pEnd;
4465   PetscErrorCode ierr;
4466 
4467   PetscFunctionBegin;
4468   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4469   if (start) {PetscValidPointer(start, 3); *start = 0;}
4470   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4471   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4472   if (pStart == pEnd) PetscFunctionReturn(0);
4473   if (stratumValue < 0) {
4474     if (start) *start = pStart;
4475     if (end)   *end   = pEnd;
4476     PetscFunctionReturn(0);
4477   }
4478   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4479   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
4480   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
4481   PetscFunctionReturn(0);
4482 }
4483 
4484 #undef __FUNCT__
4485 #define __FUNCT__ "DMPlexGetHeightStratum"
4486 /*@
4487   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
4488 
4489   Not Collective
4490 
4491   Input Parameters:
4492 + dm           - The DMPlex object
4493 - stratumValue - The requested height
4494 
4495   Output Parameters:
4496 + start - The first point at this height
4497 - end   - One beyond the last point at this height
4498 
4499   Level: developer
4500 
4501 .keywords: mesh, points
4502 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
4503 @*/
4504 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
4505 {
4506   DMLabel        label;
4507   PetscInt       depth, pStart, pEnd;
4508   PetscErrorCode ierr;
4509 
4510   PetscFunctionBegin;
4511   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4512   if (start) {PetscValidPointer(start, 3); *start = 0;}
4513   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
4514   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4515   if (pStart == pEnd) PetscFunctionReturn(0);
4516   if (stratumValue < 0) {
4517     if (start) *start = pStart;
4518     if (end)   *end   = pEnd;
4519     PetscFunctionReturn(0);
4520   }
4521   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4522   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
4523   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
4524   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
4525   PetscFunctionReturn(0);
4526 }
4527 
4528 #undef __FUNCT__
4529 #define __FUNCT__ "DMPlexCreateSectionInitial"
4530 /* Set the number of dof on each point and separate by fields */
4531 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
4532 {
4533   PetscInt      *numDofTot;
4534   PetscInt       depth, pStart = 0, pEnd = 0;
4535   PetscInt       p, d, dep, f;
4536   PetscErrorCode ierr;
4537 
4538   PetscFunctionBegin;
4539   ierr = PetscMalloc1((dim+1), &numDofTot);CHKERRQ(ierr);
4540   for (d = 0; d <= dim; ++d) {
4541     numDofTot[d] = 0;
4542     for (f = 0; f < numFields; ++f) numDofTot[d] += numDof[f*(dim+1)+d];
4543   }
4544   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
4545   if (numFields > 0) {
4546     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
4547     if (numComp) {
4548       for (f = 0; f < numFields; ++f) {
4549         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
4550       }
4551     }
4552   }
4553   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
4554   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
4555   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4556   for (dep = 0; dep <= depth; ++dep) {
4557     d    = dim == depth ? dep : (!dep ? 0 : dim);
4558     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
4559     for (p = pStart; p < pEnd; ++p) {
4560       for (f = 0; f < numFields; ++f) {
4561         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
4562       }
4563       ierr = PetscSectionSetDof(*section, p, numDofTot[d]);CHKERRQ(ierr);
4564     }
4565   }
4566   ierr = PetscFree(numDofTot);CHKERRQ(ierr);
4567   PetscFunctionReturn(0);
4568 }
4569 
4570 #undef __FUNCT__
4571 #define __FUNCT__ "DMPlexCreateSectionBCDof"
4572 /* Set the number of dof on each point and separate by fields
4573    If constDof is PETSC_DETERMINE, constrain every dof on the point
4574 */
4575 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC,const PetscInt bcField[],const IS bcPoints[], PetscInt constDof, PetscSection section)
4576 {
4577   PetscInt       numFields;
4578   PetscInt       bc;
4579   PetscErrorCode ierr;
4580 
4581   PetscFunctionBegin;
4582   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4583   for (bc = 0; bc < numBC; ++bc) {
4584     PetscInt        field = 0;
4585     const PetscInt *idx;
4586     PetscInt        n, i;
4587 
4588     if (numFields) field = bcField[bc];
4589     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
4590     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4591     for (i = 0; i < n; ++i) {
4592       const PetscInt p        = idx[i];
4593       PetscInt       numConst = constDof;
4594 
4595       /* Constrain every dof on the point */
4596       if (numConst < 0) {
4597         if (numFields) {
4598           ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
4599         } else {
4600           ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
4601         }
4602       }
4603       if (numFields) {
4604         ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);
4605       }
4606       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
4607     }
4608     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
4609   }
4610   PetscFunctionReturn(0);
4611 }
4612 
4613 #undef __FUNCT__
4614 #define __FUNCT__ "DMPlexCreateSectionBCIndicesAll"
4615 /* Set the constrained indices on each point and separate by fields */
4616 PetscErrorCode DMPlexCreateSectionBCIndicesAll(DM dm, PetscSection section)
4617 {
4618   PetscInt      *maxConstraints;
4619   PetscInt       numFields, f, pStart = 0, pEnd = 0, p;
4620   PetscErrorCode ierr;
4621 
4622   PetscFunctionBegin;
4623   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4624   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4625   ierr = PetscMalloc1((numFields+1), &maxConstraints);CHKERRQ(ierr);
4626   for (f = 0; f <= numFields; ++f) maxConstraints[f] = 0;
4627   for (p = pStart; p < pEnd; ++p) {
4628     PetscInt cdof;
4629 
4630     if (numFields) {
4631       for (f = 0; f < numFields; ++f) {
4632         ierr              = PetscSectionGetFieldConstraintDof(section, p, f, &cdof);CHKERRQ(ierr);
4633         maxConstraints[f] = PetscMax(maxConstraints[f], cdof);
4634       }
4635     } else {
4636       ierr              = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4637       maxConstraints[0] = PetscMax(maxConstraints[0], cdof);
4638     }
4639   }
4640   for (f = 0; f < numFields; ++f) {
4641     maxConstraints[numFields] += maxConstraints[f];
4642   }
4643   if (maxConstraints[numFields]) {
4644     PetscInt *indices;
4645 
4646     ierr = PetscMalloc1(maxConstraints[numFields], &indices);CHKERRQ(ierr);
4647     for (p = pStart; p < pEnd; ++p) {
4648       PetscInt cdof, d;
4649 
4650       ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4651       if (cdof) {
4652         if (cdof > maxConstraints[numFields]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_LIB, "Likely memory corruption, point %D cDof %D > maxConstraints %D", p, cdof, maxConstraints[numFields]);
4653         if (numFields) {
4654           PetscInt numConst = 0, foff = 0;
4655 
4656           for (f = 0; f < numFields; ++f) {
4657             PetscInt cfdof, fdof;
4658 
4659             ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4660             ierr = PetscSectionGetFieldConstraintDof(section, p, f, &cfdof);CHKERRQ(ierr);
4661             /* Change constraint numbering from absolute local dof number to field relative local dof number */
4662             for (d = 0; d < cfdof; ++d) indices[numConst+d] = d;
4663             ierr = PetscSectionSetFieldConstraintIndices(section, p, f, &indices[numConst]);CHKERRQ(ierr);
4664             for (d = 0; d < cfdof; ++d) indices[numConst+d] += foff;
4665             numConst += cfdof;
4666             foff     += fdof;
4667           }
4668           if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4669         } else {
4670           for (d = 0; d < cdof; ++d) indices[d] = d;
4671         }
4672         ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4673       }
4674     }
4675     ierr = PetscFree(indices);CHKERRQ(ierr);
4676   }
4677   ierr = PetscFree(maxConstraints);CHKERRQ(ierr);
4678   PetscFunctionReturn(0);
4679 }
4680 
4681 #undef __FUNCT__
4682 #define __FUNCT__ "DMPlexCreateSectionBCIndicesField"
4683 /* Set the constrained field indices on each point */
4684 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt field, IS bcPoints, IS constraintIndices, PetscSection section)
4685 {
4686   const PetscInt *points, *indices;
4687   PetscInt        numFields, maxDof, numPoints, p, numConstraints;
4688   PetscErrorCode  ierr;
4689 
4690   PetscFunctionBegin;
4691   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4692   if ((field < 0) || (field >= numFields)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Section field %d should be in [%d, %d)", field, 0, numFields);
4693 
4694   ierr = ISGetLocalSize(bcPoints, &numPoints);CHKERRQ(ierr);
4695   ierr = ISGetIndices(bcPoints, &points);CHKERRQ(ierr);
4696   if (!constraintIndices) {
4697     PetscInt *idx, i;
4698 
4699     ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4700     ierr = PetscMalloc1(maxDof, &idx);CHKERRQ(ierr);
4701     for (i = 0; i < maxDof; ++i) idx[i] = i;
4702     for (p = 0; p < numPoints; ++p) {
4703       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, idx);CHKERRQ(ierr);
4704     }
4705     ierr = PetscFree(idx);CHKERRQ(ierr);
4706   } else {
4707     ierr = ISGetLocalSize(constraintIndices, &numConstraints);CHKERRQ(ierr);
4708     ierr = ISGetIndices(constraintIndices, &indices);CHKERRQ(ierr);
4709     for (p = 0; p < numPoints; ++p) {
4710       PetscInt fcdof;
4711 
4712       ierr = PetscSectionGetFieldConstraintDof(section, points[p], field, &fcdof);CHKERRQ(ierr);
4713       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);
4714       ierr = PetscSectionSetFieldConstraintIndices(section, points[p], field, indices);CHKERRQ(ierr);
4715     }
4716     ierr = ISRestoreIndices(constraintIndices, &indices);CHKERRQ(ierr);
4717   }
4718   ierr = ISRestoreIndices(bcPoints, &points);CHKERRQ(ierr);
4719   PetscFunctionReturn(0);
4720 }
4721 
4722 #undef __FUNCT__
4723 #define __FUNCT__ "DMPlexCreateSectionBCIndices"
4724 /* Set the constrained indices on each point and separate by fields */
4725 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
4726 {
4727   PetscInt      *indices;
4728   PetscInt       numFields, maxDof, f, pStart = 0, pEnd = 0, p;
4729   PetscErrorCode ierr;
4730 
4731   PetscFunctionBegin;
4732   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4733   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
4734   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4735   if (!numFields) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "This function only works after users have set field constraint indices.");
4736   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4737   for (p = pStart; p < pEnd; ++p) {
4738     PetscInt cdof, d;
4739 
4740     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
4741     if (cdof) {
4742       PetscInt numConst = 0, foff = 0;
4743 
4744       for (f = 0; f < numFields; ++f) {
4745         const PetscInt *fcind;
4746         PetscInt        fdof, fcdof;
4747 
4748         ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
4749         ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
4750         if (fcdof) {ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &fcind);CHKERRQ(ierr);}
4751         /* Change constraint numbering from field relative local dof number to absolute local dof number */
4752         for (d = 0; d < fcdof; ++d) indices[numConst+d] = fcind[d]+foff;
4753         foff     += fdof;
4754         numConst += fcdof;
4755       }
4756       if (cdof != numConst) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
4757       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
4758     }
4759   }
4760   ierr = PetscFree(indices);CHKERRQ(ierr);
4761   PetscFunctionReturn(0);
4762 }
4763 
4764 #undef __FUNCT__
4765 #define __FUNCT__ "DMPlexCreateSection"
4766 /*@C
4767   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
4768 
4769   Not Collective
4770 
4771   Input Parameters:
4772 + dm        - The DMPlex object
4773 . dim       - The spatial dimension of the problem
4774 . numFields - The number of fields in the problem
4775 . numComp   - An array of size numFields that holds the number of components for each field
4776 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
4777 . numBC     - The number of boundary conditions
4778 . bcField   - An array of size numBC giving the field number for each boundry condition
4779 . bcPoints  - An array of size numBC giving an IS holding the sieve points to which each boundary condition applies
4780 - perm      - Optional permutation of the chart, or NULL
4781 
4782   Output Parameter:
4783 . section - The PetscSection object
4784 
4785   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
4786   number of dof for field 0 on each edge.
4787 
4788   The chart permutation is the same one set using PetscSectionSetPermutation()
4789 
4790   Level: developer
4791 
4792   Fortran Notes:
4793   A Fortran 90 version is available as DMPlexCreateSectionF90()
4794 
4795 .keywords: mesh, elements
4796 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
4797 @*/
4798 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)
4799 {
4800   PetscErrorCode ierr;
4801 
4802   PetscFunctionBegin;
4803   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
4804   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcPoints, PETSC_DETERMINE, *section);CHKERRQ(ierr);
4805   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
4806   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
4807   if (numBC) {ierr = DMPlexCreateSectionBCIndicesAll(dm, *section);CHKERRQ(ierr);}
4808   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
4809   PetscFunctionReturn(0);
4810 }
4811 
4812 #undef __FUNCT__
4813 #define __FUNCT__ "DMCreateCoordinateDM_Plex"
4814 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
4815 {
4816   PetscSection   section;
4817   PetscErrorCode ierr;
4818 
4819   PetscFunctionBegin;
4820   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
4821   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
4822   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
4823   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
4824   PetscFunctionReturn(0);
4825 }
4826 
4827 #undef __FUNCT__
4828 #define __FUNCT__ "DMPlexGetConeSection"
4829 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4830 {
4831   DM_Plex *mesh = (DM_Plex*) dm->data;
4832 
4833   PetscFunctionBegin;
4834   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4835   if (section) *section = mesh->coneSection;
4836   PetscFunctionReturn(0);
4837 }
4838 
4839 #undef __FUNCT__
4840 #define __FUNCT__ "DMPlexGetSupportSection"
4841 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4842 {
4843   DM_Plex *mesh = (DM_Plex*) dm->data;
4844 
4845   PetscFunctionBegin;
4846   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4847   if (section) *section = mesh->supportSection;
4848   PetscFunctionReturn(0);
4849 }
4850 
4851 #undef __FUNCT__
4852 #define __FUNCT__ "DMPlexGetCones"
4853 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4854 {
4855   DM_Plex *mesh = (DM_Plex*) dm->data;
4856 
4857   PetscFunctionBegin;
4858   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4859   if (cones) *cones = mesh->cones;
4860   PetscFunctionReturn(0);
4861 }
4862 
4863 #undef __FUNCT__
4864 #define __FUNCT__ "DMPlexGetConeOrientations"
4865 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4866 {
4867   DM_Plex *mesh = (DM_Plex*) dm->data;
4868 
4869   PetscFunctionBegin;
4870   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4871   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4872   PetscFunctionReturn(0);
4873 }
4874 
4875 /******************************** FEM Support **********************************/
4876 
4877 #undef __FUNCT__
4878 #define __FUNCT__ "DMPlexVecGetClosure_Depth1_Static"
4879 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4880 {
4881   PetscScalar    *array, *vArray;
4882   const PetscInt *cone, *coneO;
4883   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4884   PetscErrorCode  ierr;
4885 
4886   PetscFunctionBeginHot;
4887   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4888   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4889   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4890   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4891   if (!values || !*values) {
4892     if ((point >= pStart) && (point < pEnd)) {
4893       PetscInt dof;
4894 
4895       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4896       size += dof;
4897     }
4898     for (p = 0; p < numPoints; ++p) {
4899       const PetscInt cp = cone[p];
4900       PetscInt       dof;
4901 
4902       if ((cp < pStart) || (cp >= pEnd)) continue;
4903       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4904       size += dof;
4905     }
4906     if (!values) {
4907       if (csize) *csize = size;
4908       PetscFunctionReturn(0);
4909     }
4910     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
4911   } else {
4912     array = *values;
4913   }
4914   size = 0;
4915   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4916   if ((point >= pStart) && (point < pEnd)) {
4917     PetscInt     dof, off, d;
4918     PetscScalar *varr;
4919 
4920     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4921     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4922     varr = &vArray[off];
4923     for (d = 0; d < dof; ++d, ++offset) {
4924       array[offset] = varr[d];
4925     }
4926     size += dof;
4927   }
4928   for (p = 0; p < numPoints; ++p) {
4929     const PetscInt cp = cone[p];
4930     PetscInt       o  = coneO[p];
4931     PetscInt       dof, off, d;
4932     PetscScalar   *varr;
4933 
4934     if ((cp < pStart) || (cp >= pEnd)) continue;
4935     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4936     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
4937     varr = &vArray[off];
4938     if (o >= 0) {
4939       for (d = 0; d < dof; ++d, ++offset) {
4940         array[offset] = varr[d];
4941       }
4942     } else {
4943       for (d = dof-1; d >= 0; --d, ++offset) {
4944         array[offset] = varr[d];
4945       }
4946     }
4947     size += dof;
4948   }
4949   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4950   if (!*values) {
4951     if (csize) *csize = size;
4952     *values = array;
4953   } else {
4954     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
4955     *csize = size;
4956   }
4957   PetscFunctionReturn(0);
4958 }
4959 
4960 #undef __FUNCT__
4961 #define __FUNCT__ "DMPlexVecGetClosure_Static"
4962 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4963 {
4964   PetscInt       offset = 0, p;
4965   PetscErrorCode ierr;
4966 
4967   PetscFunctionBeginHot;
4968   *size = 0;
4969   for (p = 0; p < numPoints*2; p += 2) {
4970     const PetscInt point = points[p];
4971     const PetscInt o     = points[p+1];
4972     PetscInt       dof, off, d;
4973     const PetscScalar *varr;
4974 
4975     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4976     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4977     varr = &vArray[off];
4978     if (o >= 0) {
4979       for (d = 0; d < dof; ++d, ++offset)    array[offset] = varr[d];
4980     } else {
4981       for (d = dof-1; d >= 0; --d, ++offset) array[offset] = varr[d];
4982     }
4983   }
4984   *size = offset;
4985   PetscFunctionReturn(0);
4986 }
4987 
4988 #undef __FUNCT__
4989 #define __FUNCT__ "DMPlexVecGetClosure_Fields_Static"
4990 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
4991 {
4992   PetscInt       offset = 0, f;
4993   PetscErrorCode ierr;
4994 
4995   PetscFunctionBeginHot;
4996   *size = 0;
4997   for (f = 0; f < numFields; ++f) {
4998     PetscInt fcomp, p;
4999 
5000     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5001     for (p = 0; p < numPoints*2; p += 2) {
5002       const PetscInt point = points[p];
5003       const PetscInt o     = points[p+1];
5004       PetscInt       fdof, foff, d, c;
5005       const PetscScalar *varr;
5006 
5007       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5008       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5009       varr = &vArray[foff];
5010       if (o >= 0) {
5011         for (d = 0; d < fdof; ++d, ++offset) array[offset] = varr[d];
5012       } else {
5013         for (d = fdof/fcomp-1; d >= 0; --d) {
5014           for (c = 0; c < fcomp; ++c, ++offset) {
5015             array[offset] = varr[d*fcomp+c];
5016           }
5017         }
5018       }
5019     }
5020   }
5021   *size = offset;
5022   PetscFunctionReturn(0);
5023 }
5024 
5025 #undef __FUNCT__
5026 #define __FUNCT__ "DMPlexVecGetClosure"
5027 /*@C
5028   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
5029 
5030   Not collective
5031 
5032   Input Parameters:
5033 + dm - The DM
5034 . section - The section describing the layout in v, or NULL to use the default section
5035 . v - The local vector
5036 - point - The sieve point in the DM
5037 
5038   Output Parameters:
5039 + csize - The number of values in the closure, or NULL
5040 - values - The array of values, which is a borrowed array and should not be freed
5041 
5042   Fortran Notes:
5043   Since it returns an array, this routine is only available in Fortran 90, and you must
5044   include petsc.h90 in your code.
5045 
5046   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5047 
5048   Level: intermediate
5049 
5050 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5051 @*/
5052 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5053 {
5054   PetscSection    clSection;
5055   IS              clPoints;
5056   PetscScalar    *array, *vArray;
5057   PetscInt       *points = NULL;
5058   const PetscInt *clp;
5059   PetscInt        depth, numFields, numPoints, size;
5060   PetscErrorCode  ierr;
5061 
5062   PetscFunctionBeginHot;
5063   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5064   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5065   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5066   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5067   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5068   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5069   if (depth == 1 && numFields < 2) {
5070     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
5071     PetscFunctionReturn(0);
5072   }
5073   /* Get points */
5074   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5075   if (!clPoints) {
5076     PetscInt pStart, pEnd, p, q;
5077 
5078     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5079     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5080     /* Compress out points not in the section */
5081     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5082       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5083         points[q*2]   = points[p];
5084         points[q*2+1] = points[p+1];
5085         ++q;
5086       }
5087     }
5088     numPoints = q;
5089   } else {
5090     PetscInt dof, off;
5091 
5092     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5093     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5094     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5095     numPoints = dof/2;
5096     points    = (PetscInt *) &clp[off];
5097   }
5098   /* Get array */
5099   if (!values || !*values) {
5100     PetscInt asize = 0, dof, p;
5101 
5102     for (p = 0; p < numPoints*2; p += 2) {
5103       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5104       asize += dof;
5105     }
5106     if (!values) {
5107       if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5108       else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5109       if (csize) *csize = asize;
5110       PetscFunctionReturn(0);
5111     }
5112     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
5113   } else {
5114     array = *values;
5115   }
5116   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
5117   /* Get values */
5118   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(section, numPoints, points, numFields, vArray, &size, array);CHKERRQ(ierr);}
5119   else               {ierr = DMPlexVecGetClosure_Static(section, numPoints, points, vArray, &size, array);CHKERRQ(ierr);}
5120   /* Cleanup points */
5121   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5122   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5123   /* Cleanup array */
5124   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
5125   if (!*values) {
5126     if (csize) *csize = size;
5127     *values = array;
5128   } else {
5129     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %d < actual size %d", *csize, size);
5130     *csize = size;
5131   }
5132   PetscFunctionReturn(0);
5133 }
5134 
5135 #undef __FUNCT__
5136 #define __FUNCT__ "DMPlexVecRestoreClosure"
5137 /*@C
5138   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
5139 
5140   Not collective
5141 
5142   Input Parameters:
5143 + dm - The DM
5144 . section - The section describing the layout in v, or NULL to use the default section
5145 . v - The local vector
5146 . point - The sieve point in the DM
5147 . csize - The number of values in the closure, or NULL
5148 - values - The array of values, which is a borrowed array and should not be freed
5149 
5150   Fortran Notes:
5151   Since it returns an array, this routine is only available in Fortran 90, and you must
5152   include petsc.h90 in your code.
5153 
5154   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
5155 
5156   Level: intermediate
5157 
5158 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
5159 @*/
5160 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
5161 {
5162   PetscInt       size = 0;
5163   PetscErrorCode ierr;
5164 
5165   PetscFunctionBegin;
5166   /* Should work without recalculating size */
5167   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
5168   PetscFunctionReturn(0);
5169 }
5170 
5171 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
5172 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
5173 
5174 #undef __FUNCT__
5175 #define __FUNCT__ "updatePoint_private"
5176 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[])
5177 {
5178   PetscInt        cdof;   /* The number of constraints on this point */
5179   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5180   PetscScalar    *a;
5181   PetscInt        off, cind = 0, k;
5182   PetscErrorCode  ierr;
5183 
5184   PetscFunctionBegin;
5185   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5186   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5187   a    = &array[off];
5188   if (!cdof || setBC) {
5189     if (orientation >= 0) {
5190       for (k = 0; k < dof; ++k) {
5191         fuse(&a[k], values[k]);
5192       }
5193     } else {
5194       for (k = 0; k < dof; ++k) {
5195         fuse(&a[k], values[dof-k-1]);
5196       }
5197     }
5198   } else {
5199     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5200     if (orientation >= 0) {
5201       for (k = 0; k < dof; ++k) {
5202         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5203         fuse(&a[k], values[k]);
5204       }
5205     } else {
5206       for (k = 0; k < dof; ++k) {
5207         if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5208         fuse(&a[k], values[dof-k-1]);
5209       }
5210     }
5211   }
5212   PetscFunctionReturn(0);
5213 }
5214 
5215 #undef __FUNCT__
5216 #define __FUNCT__ "updatePointBC_private"
5217 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscInt orientation, const PetscScalar values[], PetscScalar array[])
5218 {
5219   PetscInt        cdof;   /* The number of constraints on this point */
5220   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5221   PetscScalar    *a;
5222   PetscInt        off, cind = 0, k;
5223   PetscErrorCode  ierr;
5224 
5225   PetscFunctionBegin;
5226   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5227   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5228   a    = &array[off];
5229   if (cdof) {
5230     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5231     if (orientation >= 0) {
5232       for (k = 0; k < dof; ++k) {
5233         if ((cind < cdof) && (k == cdofs[cind])) {
5234           fuse(&a[k], values[k]);
5235           ++cind;
5236         }
5237       }
5238     } else {
5239       for (k = 0; k < dof; ++k) {
5240         if ((cind < cdof) && (k == cdofs[cind])) {
5241           fuse(&a[k], values[dof-k-1]);
5242           ++cind;
5243         }
5244       }
5245     }
5246   }
5247   PetscFunctionReturn(0);
5248 }
5249 
5250 #undef __FUNCT__
5251 #define __FUNCT__ "updatePointFields_private"
5252 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[])
5253 {
5254   PetscScalar    *a;
5255   PetscInt        fdof, foff, fcdof, foffset = *offset;
5256   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5257   PetscInt        cind = 0, k, c;
5258   PetscErrorCode  ierr;
5259 
5260   PetscFunctionBegin;
5261   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5262   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5263   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5264   a    = &array[foff];
5265   if (!fcdof || setBC) {
5266     if (o >= 0) {
5267       for (k = 0; k < fdof; ++k) fuse(&a[k], values[foffset+k]);
5268     } else {
5269       for (k = fdof/fcomp-1; k >= 0; --k) {
5270         for (c = 0; c < fcomp; ++c) {
5271           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5272         }
5273       }
5274     }
5275   } else {
5276     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5277     if (o >= 0) {
5278       for (k = 0; k < fdof; ++k) {
5279         if ((cind < fcdof) && (k == fcdofs[cind])) {++cind; continue;}
5280         fuse(&a[k], values[foffset+k]);
5281       }
5282     } else {
5283       for (k = fdof/fcomp-1; k >= 0; --k) {
5284         for (c = 0; c < fcomp; ++c) {
5285           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {++cind; continue;}
5286           fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5287         }
5288       }
5289     }
5290   }
5291   *offset += fdof;
5292   PetscFunctionReturn(0);
5293 }
5294 
5295 #undef __FUNCT__
5296 #define __FUNCT__ "updatePointFieldsBC_private"
5297 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[])
5298 {
5299   PetscScalar    *a;
5300   PetscInt        fdof, foff, fcdof, foffset = *offset;
5301   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5302   PetscInt        cind = 0, k, c;
5303   PetscErrorCode  ierr;
5304 
5305   PetscFunctionBegin;
5306   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5307   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5308   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5309   a    = &array[foff];
5310   if (fcdof) {
5311     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5312     if (o >= 0) {
5313       for (k = 0; k < fdof; ++k) {
5314         if ((cind < fcdof) && (k == fcdofs[cind])) {
5315           fuse(&a[k], values[foffset+k]);
5316           ++cind;
5317         }
5318       }
5319     } else {
5320       for (k = fdof/fcomp-1; k >= 0; --k) {
5321         for (c = 0; c < fcomp; ++c) {
5322           if ((cind < fcdof) && (k*fcomp+c == fcdofs[cind])) {
5323             fuse(&a[(fdof/fcomp-1-k)*fcomp+c], values[foffset+k*fcomp+c]);
5324             ++cind;
5325           }
5326         }
5327       }
5328     }
5329   }
5330   *offset += fdof;
5331   PetscFunctionReturn(0);
5332 }
5333 
5334 #undef __FUNCT__
5335 #define __FUNCT__ "DMPlexVecSetClosure_Static"
5336 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5337 {
5338   PetscScalar    *array;
5339   const PetscInt *cone, *coneO;
5340   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5341   PetscErrorCode  ierr;
5342 
5343   PetscFunctionBeginHot;
5344   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5345   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5346   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5347   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5348   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5349   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5350     const PetscInt cp = !p ? point : cone[p-1];
5351     const PetscInt o  = !p ? 0     : coneO[p-1];
5352 
5353     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5354     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5355     /* ADD_VALUES */
5356     {
5357       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5358       PetscScalar    *a;
5359       PetscInt        cdof, coff, cind = 0, k;
5360 
5361       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5362       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5363       a    = &array[coff];
5364       if (!cdof) {
5365         if (o >= 0) {
5366           for (k = 0; k < dof; ++k) {
5367             a[k] += values[off+k];
5368           }
5369         } else {
5370           for (k = 0; k < dof; ++k) {
5371             a[k] += values[off+dof-k-1];
5372           }
5373         }
5374       } else {
5375         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5376         if (o >= 0) {
5377           for (k = 0; k < dof; ++k) {
5378             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5379             a[k] += values[off+k];
5380           }
5381         } else {
5382           for (k = 0; k < dof; ++k) {
5383             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5384             a[k] += values[off+dof-k-1];
5385           }
5386         }
5387       }
5388     }
5389   }
5390   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5391   PetscFunctionReturn(0);
5392 }
5393 
5394 #undef __FUNCT__
5395 #define __FUNCT__ "DMPlexVecSetClosure"
5396 /*@C
5397   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5398 
5399   Not collective
5400 
5401   Input Parameters:
5402 + dm - The DM
5403 . section - The section describing the layout in v, or NULL to use the default section
5404 . v - The local vector
5405 . point - The sieve point in the DM
5406 . values - The array of values
5407 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5408 
5409   Fortran Notes:
5410   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5411 
5412   Level: intermediate
5413 
5414 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5415 @*/
5416 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5417 {
5418   PetscSection    clSection;
5419   IS              clPoints;
5420   PetscScalar    *array;
5421   PetscInt       *points = NULL;
5422   const PetscInt *clp;
5423   PetscInt        depth, numFields, numPoints, p;
5424   PetscErrorCode  ierr;
5425 
5426   PetscFunctionBeginHot;
5427   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5428   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5429   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5430   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5431   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5432   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5433   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5434     ierr = DMPlexVecSetClosure_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5435     PetscFunctionReturn(0);
5436   }
5437   /* Get points */
5438   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5439   if (!clPoints) {
5440     PetscInt pStart, pEnd, q;
5441 
5442     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5443     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5444     /* Compress out points not in the section */
5445     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5446       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5447         points[q*2]   = points[p];
5448         points[q*2+1] = points[p+1];
5449         ++q;
5450       }
5451     }
5452     numPoints = q;
5453   } else {
5454     PetscInt dof, off;
5455 
5456     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5457     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5458     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5459     numPoints = dof/2;
5460     points    = (PetscInt *) &clp[off];
5461   }
5462   /* Get array */
5463   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5464   /* Get values */
5465   if (numFields > 0) {
5466     PetscInt offset = 0, fcomp, f;
5467     for (f = 0; f < numFields; ++f) {
5468       ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5469       switch (mode) {
5470       case INSERT_VALUES:
5471         for (p = 0; p < numPoints*2; p += 2) {
5472           const PetscInt point = points[p];
5473           const PetscInt o     = points[p+1];
5474           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_FALSE, values, &offset, array);
5475         } break;
5476       case INSERT_ALL_VALUES:
5477         for (p = 0; p < numPoints*2; p += 2) {
5478           const PetscInt point = points[p];
5479           const PetscInt o     = points[p+1];
5480           updatePointFields_private(section, point, o, f, fcomp, insert, PETSC_TRUE, values, &offset, array);
5481         } break;
5482       case INSERT_BC_VALUES:
5483         for (p = 0; p < numPoints*2; p += 2) {
5484           const PetscInt point = points[p];
5485           const PetscInt o     = points[p+1];
5486           updatePointFieldsBC_private(section, point, o, f, fcomp, insert, values, &offset, array);
5487         } break;
5488       case ADD_VALUES:
5489         for (p = 0; p < numPoints*2; p += 2) {
5490           const PetscInt point = points[p];
5491           const PetscInt o     = points[p+1];
5492           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_FALSE, values, &offset, array);
5493         } break;
5494       case ADD_ALL_VALUES:
5495         for (p = 0; p < numPoints*2; p += 2) {
5496           const PetscInt point = points[p];
5497           const PetscInt o     = points[p+1];
5498           updatePointFields_private(section, point, o, f, fcomp, add, PETSC_TRUE, values, &offset, array);
5499         } break;
5500       default:
5501         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5502       }
5503     }
5504   } else {
5505     PetscInt dof, off;
5506 
5507     switch (mode) {
5508     case INSERT_VALUES:
5509       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5510         PetscInt o = points[p+1];
5511         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5512         updatePoint_private(section, points[p], dof, insert, PETSC_FALSE, o, &values[off], array);
5513       } break;
5514     case INSERT_ALL_VALUES:
5515       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5516         PetscInt o = points[p+1];
5517         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5518         updatePoint_private(section, points[p], dof, insert, PETSC_TRUE,  o, &values[off], array);
5519       } break;
5520     case INSERT_BC_VALUES:
5521       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5522         PetscInt o = points[p+1];
5523         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5524         updatePointBC_private(section, points[p], dof, insert,  o, &values[off], array);
5525       } break;
5526     case ADD_VALUES:
5527       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5528         PetscInt o = points[p+1];
5529         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5530         updatePoint_private(section, points[p], dof, add,    PETSC_FALSE, o, &values[off], array);
5531       } break;
5532     case ADD_ALL_VALUES:
5533       for (p = 0, off = 0; p < numPoints*2; p += 2, off += dof) {
5534         PetscInt o = points[p+1];
5535         ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5536         updatePoint_private(section, points[p], dof, add,    PETSC_TRUE,  o, &values[off], array);
5537       } break;
5538     default:
5539       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %D", mode);
5540     }
5541   }
5542   /* Cleanup points */
5543   if (!clPoints) {ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);}
5544   else           {ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);}
5545   /* Cleanup array */
5546   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5547   PetscFunctionReturn(0);
5548 }
5549 
5550 #undef __FUNCT__
5551 #define __FUNCT__ "DMPlexPrintMatSetValues"
5552 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5553 {
5554   PetscMPIInt    rank;
5555   PetscInt       i, j;
5556   PetscErrorCode ierr;
5557 
5558   PetscFunctionBegin;
5559   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5560   ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
5561   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5562   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%D]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5563   numCIndices = numCIndices ? numCIndices : numRIndices;
5564   for (i = 0; i < numRIndices; i++) {
5565     ierr = PetscViewerASCIIPrintf(viewer, "[%D]", rank);CHKERRQ(ierr);
5566     for (j = 0; j < numCIndices; j++) {
5567 #if defined(PETSC_USE_COMPLEX)
5568       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5569 #else
5570       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5571 #endif
5572     }
5573     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5574   }
5575   PetscFunctionReturn(0);
5576 }
5577 
5578 #undef __FUNCT__
5579 #define __FUNCT__ "indicesPoint_private"
5580 /* . off - The global offset of this point */
5581 PetscErrorCode indicesPoint_private(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, PetscInt orientation, PetscInt indices[])
5582 {
5583   PetscInt        dof;    /* The number of unknowns on this point */
5584   PetscInt        cdof;   /* The number of constraints on this point */
5585   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5586   PetscInt        cind = 0, k;
5587   PetscErrorCode  ierr;
5588 
5589   PetscFunctionBegin;
5590   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5591   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5592   if (!cdof || setBC) {
5593     if (orientation >= 0) {
5594       for (k = 0; k < dof; ++k) indices[*loff+k] = off+k;
5595     } else {
5596       for (k = 0; k < dof; ++k) indices[*loff+dof-k-1] = off+k;
5597     }
5598   } else {
5599     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5600     if (orientation >= 0) {
5601       for (k = 0; k < dof; ++k) {
5602         if ((cind < cdof) && (k == cdofs[cind])) {
5603           /* Insert check for returning constrained indices */
5604           indices[*loff+k] = -(off+k+1);
5605           ++cind;
5606         } else {
5607           indices[*loff+k] = off+k-cind;
5608         }
5609       }
5610     } else {
5611       for (k = 0; k < dof; ++k) {
5612         if ((cind < cdof) && (k == cdofs[cind])) {
5613           /* Insert check for returning constrained indices */
5614           indices[*loff+dof-k-1] = -(off+k+1);
5615           ++cind;
5616         } else {
5617           indices[*loff+dof-k-1] = off+k-cind;
5618         }
5619       }
5620     }
5621   }
5622   *loff += dof;
5623   PetscFunctionReturn(0);
5624 }
5625 
5626 #undef __FUNCT__
5627 #define __FUNCT__ "indicesPointFields_private"
5628 /* . off - The global offset of this point */
5629 PetscErrorCode indicesPointFields_private(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, PetscInt orientation, PetscInt indices[])
5630 {
5631   PetscInt       numFields, foff, f;
5632   PetscErrorCode ierr;
5633 
5634   PetscFunctionBegin;
5635   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5636   for (f = 0, foff = 0; f < numFields; ++f) {
5637     PetscInt        fdof, fcomp, cfdof;
5638     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5639     PetscInt        cind = 0, k, c;
5640 
5641     ierr = PetscSectionGetFieldComponents(section, f, &fcomp);CHKERRQ(ierr);
5642     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5643     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5644     if (!cfdof || setBC) {
5645       if (orientation >= 0) {
5646         for (k = 0; k < fdof; ++k) indices[foffs[f]+k] = off+foff+k;
5647       } else {
5648         for (k = fdof/fcomp-1; k >= 0; --k) {
5649           for (c = 0; c < fcomp; ++c) {
5650             indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c;
5651           }
5652         }
5653       }
5654     } else {
5655       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5656       if (orientation >= 0) {
5657         for (k = 0; k < fdof; ++k) {
5658           if ((cind < cfdof) && (k == fcdofs[cind])) {
5659             indices[foffs[f]+k] = -(off+foff+k+1);
5660             ++cind;
5661           } else {
5662             indices[foffs[f]+k] = off+foff+k-cind;
5663           }
5664         }
5665       } else {
5666         for (k = fdof/fcomp-1; k >= 0; --k) {
5667           for (c = 0; c < fcomp; ++c) {
5668             if ((cind < cfdof) && ((fdof/fcomp-1-k)*fcomp+c == fcdofs[cind])) {
5669               indices[foffs[f]+k*fcomp+c] = -(off+foff+(fdof/fcomp-1-k)*fcomp+c+1);
5670               ++cind;
5671             } else {
5672               indices[foffs[f]+k*fcomp+c] = off+foff+(fdof/fcomp-1-k)*fcomp+c-cind;
5673             }
5674           }
5675         }
5676       }
5677     }
5678     foff     += fdof - cfdof;
5679     foffs[f] += fdof;
5680   }
5681   PetscFunctionReturn(0);
5682 }
5683 
5684 #undef __FUNCT__
5685 #define __FUNCT__ "DMPlexMatSetClosure"
5686 /*@C
5687   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5688 
5689   Not collective
5690 
5691   Input Parameters:
5692 + dm - The DM
5693 . section - The section describing the layout in v, or NULL to use the default section
5694 . globalSection - The section describing the layout in v, or NULL to use the default global section
5695 . A - The matrix
5696 . point - The sieve point in the DM
5697 . values - The array of values
5698 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5699 
5700   Fortran Notes:
5701   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5702 
5703   Level: intermediate
5704 
5705 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5706 @*/
5707 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5708 {
5709   DM_Plex        *mesh   = (DM_Plex*) dm->data;
5710   PetscSection    clSection;
5711   IS              clPoints;
5712   PetscInt       *points = NULL;
5713   const PetscInt *clp;
5714   PetscInt       *indices;
5715   PetscInt        offsets[32];
5716   PetscInt        numFields, numPoints, numIndices, dof, off, globalOff, pStart, pEnd, p, q, f;
5717   PetscErrorCode  ierr;
5718 
5719   PetscFunctionBegin;
5720   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5721   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5722   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5723   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5724   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5725   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5726   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5727   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5728   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5729   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, &clSection, &clPoints);CHKERRQ(ierr);
5730   if (!clPoints) {
5731     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5732     /* Compress out points not in the section */
5733     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5734     for (p = 0, q = 0; p < numPoints*2; p += 2) {
5735       if ((points[p] >= pStart) && (points[p] < pEnd)) {
5736         points[q*2]   = points[p];
5737         points[q*2+1] = points[p+1];
5738         ++q;
5739       }
5740     }
5741     numPoints = q;
5742   } else {
5743     PetscInt dof, off;
5744 
5745     ierr = PetscSectionGetDof(clSection, point, &dof);CHKERRQ(ierr);
5746     numPoints = dof/2;
5747     ierr = PetscSectionGetOffset(clSection, point, &off);CHKERRQ(ierr);
5748     ierr = ISGetIndices(clPoints, &clp);CHKERRQ(ierr);
5749     points = (PetscInt *) &clp[off];
5750   }
5751   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5752     PetscInt fdof;
5753 
5754     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5755     for (f = 0; f < numFields; ++f) {
5756       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5757       offsets[f+1] += fdof;
5758     }
5759     numIndices += dof;
5760   }
5761   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5762 
5763   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", offsets[numFields], numIndices);
5764   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5765   if (numFields) {
5766     for (p = 0; p < numPoints*2; p += 2) {
5767       PetscInt o = points[p+1];
5768       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5769       indicesPointFields_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, o, indices);
5770     }
5771   } else {
5772     for (p = 0, off = 0; p < numPoints*2; p += 2) {
5773       PetscInt o = points[p+1];
5774       ierr = PetscSectionGetOffset(globalSection, points[p], &globalOff);CHKERRQ(ierr);
5775       indicesPoint_private(section, points[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, indices);
5776     }
5777   }
5778   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5779   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5780   if (ierr) {
5781     PetscMPIInt    rank;
5782     PetscErrorCode ierr2;
5783 
5784     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5785     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5786     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5787     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5788     CHKERRQ(ierr);
5789   }
5790   if (!clPoints) {
5791     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr);
5792   } else {
5793     ierr = ISRestoreIndices(clPoints, &clp);CHKERRQ(ierr);
5794   }
5795   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5796   PetscFunctionReturn(0);
5797 }
5798 
5799 #undef __FUNCT__
5800 #define __FUNCT__ "DMPlexMatSetClosureRefined"
5801 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5802 {
5803   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5804   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5805   PetscInt       *cpoints = NULL;
5806   PetscInt       *findices, *cindices;
5807   PetscInt        foffsets[32], coffsets[32];
5808   CellRefiner     cellRefiner;
5809   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5810   PetscErrorCode  ierr;
5811 
5812   PetscFunctionBegin;
5813   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5814   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5815   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5816   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5817   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5818   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5819   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5820   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5821   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5822   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5823   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5824   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5825   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5826   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5827   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5828   /* Column indices */
5829   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5830   maxFPoints = numCPoints;
5831   /* Compress out points not in the section */
5832   /*   TODO: Squeeze out points with 0 dof as well */
5833   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5834   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5835     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5836       cpoints[q*2]   = cpoints[p];
5837       cpoints[q*2+1] = cpoints[p+1];
5838       ++q;
5839     }
5840   }
5841   numCPoints = q;
5842   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5843     PetscInt fdof;
5844 
5845     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5846     if (!dof) continue;
5847     for (f = 0; f < numFields; ++f) {
5848       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5849       coffsets[f+1] += fdof;
5850     }
5851     numCIndices += dof;
5852   }
5853   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5854   /* Row indices */
5855   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5856   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5857   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5858   for (r = 0, q = 0; r < numSubcells; ++r) {
5859     /* TODO Map from coarse to fine cells */
5860     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5861     /* Compress out points not in the section */
5862     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5863     for (p = 0; p < numFPoints*2; p += 2) {
5864       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5865         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5866         if (!dof) continue;
5867         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5868         if (s < q) continue;
5869         ftotpoints[q*2]   = fpoints[p];
5870         ftotpoints[q*2+1] = fpoints[p+1];
5871         ++q;
5872       }
5873     }
5874     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5875   }
5876   numFPoints = q;
5877   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5878     PetscInt fdof;
5879 
5880     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5881     if (!dof) continue;
5882     for (f = 0; f < numFields; ++f) {
5883       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5884       foffsets[f+1] += fdof;
5885     }
5886     numFIndices += dof;
5887   }
5888   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5889 
5890   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", foffsets[numFields], numFIndices);
5891   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %d should be %d", coffsets[numFields], numCIndices);
5892   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5893   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5894   if (numFields) {
5895     for (p = 0; p < numFPoints*2; p += 2) {
5896       PetscInt o = ftotpoints[p+1];
5897       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5898       indicesPointFields_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, o, findices);
5899     }
5900     for (p = 0; p < numCPoints*2; p += 2) {
5901       PetscInt o = cpoints[p+1];
5902       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5903       indicesPointFields_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, o, cindices);
5904     }
5905   } else {
5906     for (p = 0, off = 0; p < numFPoints*2; p += 2) {
5907       PetscInt o = ftotpoints[p+1];
5908       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[p], &globalOff);CHKERRQ(ierr);
5909       indicesPoint_private(fsection, ftotpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, findices);
5910     }
5911     for (p = 0, off = 0; p < numCPoints*2; p += 2) {
5912       PetscInt o = cpoints[p+1];
5913       ierr = PetscSectionGetOffset(globalCSection, cpoints[p], &globalOff);CHKERRQ(ierr);
5914       indicesPoint_private(csection, cpoints[p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, o, cindices);
5915     }
5916   }
5917   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5918   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5919   if (ierr) {
5920     PetscMPIInt    rank;
5921     PetscErrorCode ierr2;
5922 
5923     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5924     ierr2 = (*PetscErrorPrintf)("[%D]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5925     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5926     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
5927     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
5928     CHKERRQ(ierr);
5929   }
5930   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5931   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5932   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5933   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5934   PetscFunctionReturn(0);
5935 }
5936 
5937 #undef __FUNCT__
5938 #define __FUNCT__ "DMPlexGetHybridBounds"
5939 /*@
5940   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5941 
5942   Input Parameter:
5943 . dm - The DMPlex object
5944 
5945   Output Parameters:
5946 + cMax - The first hybrid cell
5947 . cMax - The first hybrid face
5948 . cMax - The first hybrid edge
5949 - cMax - The first hybrid vertex
5950 
5951   Level: developer
5952 
5953 .seealso DMPlexCreateHybridMesh()
5954 @*/
5955 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5956 {
5957   DM_Plex       *mesh = (DM_Plex*) dm->data;
5958   PetscInt       dim;
5959   PetscErrorCode ierr;
5960 
5961   PetscFunctionBegin;
5962   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5963   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5964   if (cMax) *cMax = mesh->hybridPointMax[dim];
5965   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5966   if (eMax) *eMax = mesh->hybridPointMax[1];
5967   if (vMax) *vMax = mesh->hybridPointMax[0];
5968   PetscFunctionReturn(0);
5969 }
5970 
5971 #undef __FUNCT__
5972 #define __FUNCT__ "DMPlexSetHybridBounds"
5973 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5974 {
5975   DM_Plex       *mesh = (DM_Plex*) dm->data;
5976   PetscInt       dim;
5977   PetscErrorCode ierr;
5978 
5979   PetscFunctionBegin;
5980   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5981   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
5982   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5983   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5984   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5985   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5986   PetscFunctionReturn(0);
5987 }
5988 
5989 #undef __FUNCT__
5990 #define __FUNCT__ "DMPlexGetVTKCellHeight"
5991 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5992 {
5993   DM_Plex *mesh = (DM_Plex*) dm->data;
5994 
5995   PetscFunctionBegin;
5996   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5997   PetscValidPointer(cellHeight, 2);
5998   *cellHeight = mesh->vtkCellHeight;
5999   PetscFunctionReturn(0);
6000 }
6001 
6002 #undef __FUNCT__
6003 #define __FUNCT__ "DMPlexSetVTKCellHeight"
6004 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
6005 {
6006   DM_Plex *mesh = (DM_Plex*) dm->data;
6007 
6008   PetscFunctionBegin;
6009   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6010   mesh->vtkCellHeight = cellHeight;
6011   PetscFunctionReturn(0);
6012 }
6013 
6014 #undef __FUNCT__
6015 #define __FUNCT__ "DMPlexCreateNumbering_Private"
6016 /* We can easily have a form that takes an IS instead */
6017 PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscSF sf, IS *numbering)
6018 {
6019   PetscSection   section, globalSection;
6020   PetscInt      *numbers, p;
6021   PetscErrorCode ierr;
6022 
6023   PetscFunctionBegin;
6024   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
6025   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
6026   for (p = pStart; p < pEnd; ++p) {
6027     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
6028   }
6029   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
6030   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
6031   ierr = PetscMalloc1((pEnd - pStart), &numbers);CHKERRQ(ierr);
6032   for (p = pStart; p < pEnd; ++p) {
6033     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
6034   }
6035   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
6036   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6037   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
6038   PetscFunctionReturn(0);
6039 }
6040 
6041 #undef __FUNCT__
6042 #define __FUNCT__ "DMPlexGetCellNumbering"
6043 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
6044 {
6045   DM_Plex       *mesh = (DM_Plex*) dm->data;
6046   PetscInt       cellHeight, cStart, cEnd, cMax;
6047   PetscErrorCode ierr;
6048 
6049   PetscFunctionBegin;
6050   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6051   if (!mesh->globalCellNumbers) {
6052     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
6053     ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6054     ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6055     if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
6056     ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, dm->sf, &mesh->globalCellNumbers);CHKERRQ(ierr);
6057   }
6058   *globalCellNumbers = mesh->globalCellNumbers;
6059   PetscFunctionReturn(0);
6060 }
6061 
6062 #undef __FUNCT__
6063 #define __FUNCT__ "DMPlexGetVertexNumbering"
6064 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
6065 {
6066   DM_Plex       *mesh = (DM_Plex*) dm->data;
6067   PetscInt       vStart, vEnd, vMax;
6068   PetscErrorCode ierr;
6069 
6070   PetscFunctionBegin;
6071   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6072   if (!mesh->globalVertexNumbers) {
6073     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6074     ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
6075     if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
6076     ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, dm->sf, &mesh->globalVertexNumbers);CHKERRQ(ierr);
6077   }
6078   *globalVertexNumbers = mesh->globalVertexNumbers;
6079   PetscFunctionReturn(0);
6080 }
6081 
6082 
6083 #undef __FUNCT__
6084 #define __FUNCT__ "PetscSectionCreateGlobalSectionLabel"
6085 /*@C
6086   PetscSectionCreateGlobalSectionLabel - Create a section describing the global field layout using
6087   the local section and an SF describing the section point overlap.
6088 
6089   Input Parameters:
6090   + s - The PetscSection for the local field layout
6091   . sf - The SF describing parallel layout of the section points
6092   . includeConstraints - By default this is PETSC_FALSE, meaning that the global field vector will not possess constrained dofs
6093   . label - The label specifying the points
6094   - labelValue - The label stratum specifying the points
6095 
6096   Output Parameter:
6097   . gsection - The PetscSection for the global field layout
6098 
6099   Note: This gives negative sizes and offsets to points not owned by this process
6100 
6101   Level: developer
6102 
6103 .seealso: PetscSectionCreate()
6104 @*/
6105 PetscErrorCode PetscSectionCreateGlobalSectionLabel(PetscSection s, PetscSF sf, PetscBool includeConstraints, DMLabel label, PetscInt labelValue, PetscSection *gsection)
6106 {
6107   PetscInt      *neg = NULL, *tmpOff = NULL;
6108   PetscInt       pStart, pEnd, p, dof, cdof, off, globalOff = 0, nroots;
6109   PetscErrorCode ierr;
6110 
6111   PetscFunctionBegin;
6112   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) s), gsection);CHKERRQ(ierr);
6113   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
6114   ierr = PetscSectionSetChart(*gsection, pStart, pEnd);CHKERRQ(ierr);
6115   ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
6116   if (nroots >= 0) {
6117     if (nroots < pEnd-pStart) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "PetscSF nroots %d < %d section size", nroots, pEnd-pStart);
6118     ierr = PetscCalloc1(nroots, &neg);CHKERRQ(ierr);
6119     if (nroots > pEnd-pStart) {
6120       ierr = PetscCalloc1(nroots, &tmpOff);CHKERRQ(ierr);
6121     } else {
6122       tmpOff = &(*gsection)->atlasDof[-pStart];
6123     }
6124   }
6125   /* Mark ghost points with negative dof */
6126   for (p = pStart; p < pEnd; ++p) {
6127     PetscInt value;
6128 
6129     ierr = DMLabelGetValue(label, p, &value);CHKERRQ(ierr);
6130     if (value != labelValue) continue;
6131     ierr = PetscSectionGetDof(s, p, &dof);CHKERRQ(ierr);
6132     ierr = PetscSectionSetDof(*gsection, p, dof);CHKERRQ(ierr);
6133     ierr = PetscSectionGetConstraintDof(s, p, &cdof);CHKERRQ(ierr);
6134     if (!includeConstraints && cdof > 0) {ierr = PetscSectionSetConstraintDof(*gsection, p, cdof);CHKERRQ(ierr);}
6135     if (neg) neg[p] = -(dof+1);
6136   }
6137   ierr = PetscSectionSetUpBC(*gsection);CHKERRQ(ierr);
6138   if (nroots >= 0) {
6139     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6140     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6141     if (nroots > pEnd-pStart) {
6142       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasDof[p-pStart] = tmpOff[p];}
6143     }
6144   }
6145   /* Calculate new sizes, get proccess offset, and calculate point offsets */
6146   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6147     cdof = (!includeConstraints && s->bc) ? s->bc->atlasDof[p] : 0;
6148     (*gsection)->atlasOff[p] = off;
6149     off += (*gsection)->atlasDof[p] > 0 ? (*gsection)->atlasDof[p]-cdof : 0;
6150   }
6151   ierr       = MPI_Scan(&off, &globalOff, 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) s));CHKERRQ(ierr);
6152   globalOff -= off;
6153   for (p = 0, off = 0; p < pEnd-pStart; ++p) {
6154     (*gsection)->atlasOff[p] += globalOff;
6155     if (neg) neg[p] = -((*gsection)->atlasOff[p]+1);
6156   }
6157   /* Put in negative offsets for ghost points */
6158   if (nroots >= 0) {
6159     ierr = PetscSFBcastBegin(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6160     ierr = PetscSFBcastEnd(sf, MPIU_INT, neg, tmpOff);CHKERRQ(ierr);
6161     if (nroots > pEnd-pStart) {
6162       for (p = pStart; p < pEnd; ++p) {if (tmpOff[p] < 0) (*gsection)->atlasOff[p-pStart] = tmpOff[p];}
6163     }
6164   }
6165   if (nroots >= 0 && nroots > pEnd-pStart) {ierr = PetscFree(tmpOff);CHKERRQ(ierr);}
6166   ierr = PetscFree(neg);CHKERRQ(ierr);
6167   PetscFunctionReturn(0);
6168 }
6169 
6170 #undef __FUNCT__
6171 #define __FUNCT__ "DMPlexCheckSymmetry"
6172 /*@
6173   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
6174 
6175   Input Parameters:
6176   + dm - The DMPlex object
6177 
6178   Note: This is a useful diagnostic when creating meshes programmatically.
6179 
6180   Level: developer
6181 
6182 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
6183 @*/
6184 PetscErrorCode DMPlexCheckSymmetry(DM dm)
6185 {
6186   PetscSection    coneSection, supportSection;
6187   const PetscInt *cone, *support;
6188   PetscInt        coneSize, c, supportSize, s;
6189   PetscInt        pStart, pEnd, p, csize, ssize;
6190   PetscErrorCode  ierr;
6191 
6192   PetscFunctionBegin;
6193   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6194   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
6195   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
6196   /* Check that point p is found in the support of its cone points, and vice versa */
6197   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
6198   for (p = pStart; p < pEnd; ++p) {
6199     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
6200     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
6201     for (c = 0; c < coneSize; ++c) {
6202       PetscBool dup = PETSC_FALSE;
6203       PetscInt  d;
6204       for (d = c-1; d >= 0; --d) {
6205         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
6206       }
6207       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
6208       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
6209       for (s = 0; s < supportSize; ++s) {
6210         if (support[s] == p) break;
6211       }
6212       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
6213         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", p);
6214         for (s = 0; s < coneSize; ++s) {
6215           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[s]);
6216         }
6217         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6218         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", cone[c]);
6219         for (s = 0; s < supportSize; ++s) {
6220           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[s]);
6221         }
6222         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6223         if (dup) {
6224           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not repeatedly found in support of repeated cone point %d", p, cone[c]);
6225         } else {
6226           SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in support of cone point %d", p, cone[c]);
6227         }
6228       }
6229     }
6230     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
6231     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
6232     for (s = 0; s < supportSize; ++s) {
6233       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
6234       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
6235       for (c = 0; c < coneSize; ++c) {
6236         if (cone[c] == p) break;
6237       }
6238       if (c >= coneSize) {
6239         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d support: ", p);
6240         for (c = 0; c < supportSize; ++c) {
6241           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", support[c]);
6242         }
6243         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6244         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %d cone: ", support[s]);
6245         for (c = 0; c < coneSize; ++c) {
6246           ierr = PetscPrintf(PETSC_COMM_SELF, "%d, ", cone[c]);
6247         }
6248         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");
6249         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %d not found in cone of support point %d", p, support[s]);
6250       }
6251     }
6252   }
6253   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
6254   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
6255   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %d != Total support size %d", csize, ssize);
6256   PetscFunctionReturn(0);
6257 }
6258 
6259 #undef __FUNCT__
6260 #define __FUNCT__ "DMPlexCheckSkeleton"
6261 /*@
6262   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
6263 
6264   Input Parameters:
6265 + dm - The DMPlex object
6266 . isSimplex - Are the cells simplices or tensor products
6267 - cellHeight - Normally 0
6268 
6269   Note: This is a useful diagnostic when creating meshes programmatically.
6270 
6271   Level: developer
6272 
6273 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
6274 @*/
6275 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6276 {
6277   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
6278   PetscErrorCode ierr;
6279 
6280   PetscFunctionBegin;
6281   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6282   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6283   switch (dim) {
6284   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
6285   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
6286   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
6287   default:
6288     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %d", dim);
6289   }
6290   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6291   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
6292   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
6293   cMax = cMax >= 0 ? cMax : cEnd;
6294   for (c = cStart; c < cMax; ++c) {
6295     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6296 
6297     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6298     for (cl = 0; cl < closureSize*2; cl += 2) {
6299       const PetscInt p = closure[cl];
6300       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6301     }
6302     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6303     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has  %d vertices != %d", c, coneSize, numCorners);
6304   }
6305   for (c = cMax; c < cEnd; ++c) {
6306     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
6307 
6308     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6309     for (cl = 0; cl < closureSize*2; cl += 2) {
6310       const PetscInt p = closure[cl];
6311       if ((p >= vStart) && (p < vEnd)) ++coneSize;
6312     }
6313     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6314     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %d has  %d vertices > %d", c, coneSize, numHybridCorners);
6315   }
6316   PetscFunctionReturn(0);
6317 }
6318 
6319 #undef __FUNCT__
6320 #define __FUNCT__ "DMPlexCheckFaces"
6321 /*@
6322   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
6323 
6324   Input Parameters:
6325 + dm - The DMPlex object
6326 . isSimplex - Are the cells simplices or tensor products
6327 - cellHeight - Normally 0
6328 
6329   Note: This is a useful diagnostic when creating meshes programmatically.
6330 
6331   Level: developer
6332 
6333 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
6334 @*/
6335 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
6336 {
6337   PetscInt       pMax[4];
6338   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
6339   PetscErrorCode ierr;
6340 
6341   PetscFunctionBegin;
6342   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6343   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6344   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
6345   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
6346   for (h = cellHeight; h < dim; ++h) {
6347     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
6348     for (c = cStart; c < cEnd; ++c) {
6349       const PetscInt *cone, *ornt, *faces;
6350       PetscInt        numFaces, faceSize, coneSize,f;
6351       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
6352 
6353       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
6354       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
6355       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
6356       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
6357       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6358       for (cl = 0; cl < closureSize*2; cl += 2) {
6359         const PetscInt p = closure[cl];
6360         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
6361       }
6362       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6363       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %d has %d faces but should have %d", c, coneSize, numFaces);
6364       for (f = 0; f < numFaces; ++f) {
6365         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
6366 
6367         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6368         for (cl = 0; cl < fclosureSize*2; cl += 2) {
6369           const PetscInt p = fclosure[cl];
6370           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
6371         }
6372         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);
6373         for (v = 0; v < fnumCorners; ++v) {
6374           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]);
6375         }
6376         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
6377       }
6378       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
6379       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
6380     }
6381   }
6382   PetscFunctionReturn(0);
6383 }
6384 
6385 #undef __FUNCT__
6386 #define __FUNCT__ "DMCreateInterpolation_Plex"
6387 /* Pointwise interpolation
6388      Just code FEM for now
6389      u^f = I u^c
6390      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
6391      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
6392      I_{ij} = psi^f_i phi^c_j
6393 */
6394 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6395 {
6396   PetscSection   gsc, gsf;
6397   PetscInt       m, n;
6398   void          *ctx;
6399   PetscErrorCode ierr;
6400 
6401   PetscFunctionBegin;
6402   /*
6403   Loop over coarse cells
6404     Loop over coarse basis functions
6405       Loop over fine cells in coarse cell
6406         Loop over fine dual basis functions
6407           Evaluate coarse basis on fine dual basis quad points
6408           Sum
6409           Update local element matrix
6410     Accumulate to interpolation matrix
6411 
6412    Can extend PetscFEIntegrateJacobian_Basic() to do a specialized cell loop
6413   */
6414   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6415   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6416   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6417   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6418   /* We need to preallocate properly */
6419   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6420   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6421   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6422   ierr = MatSetUp(*interpolation);CHKERRQ(ierr);
6423   ierr = MatSetFromOptions(*interpolation);CHKERRQ(ierr);
6424   ierr = MatSetOption(*interpolation, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
6425   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6426   ierr = DMPlexComputeInterpolatorFEM(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);
6427   /* Use naive scaling */
6428   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6429   PetscFunctionReturn(0);
6430 }
6431 
6432 #undef __FUNCT__
6433 #define __FUNCT__ "DMCreateInjection_Plex"
6434 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, VecScatter *ctx)
6435 {
6436   Vec             cv,  fv;
6437   IS              cis, fis, fpointIS;
6438   PetscSection    sc, gsc, gsf;
6439   const PetscInt *fpoints;
6440   PetscInt       *cindices, *findices;
6441   PetscInt        cpStart, cpEnd, m, off, cp;
6442   PetscErrorCode  ierr;
6443 
6444   PetscFunctionBegin;
6445   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6446   ierr = DMGetGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6447   ierr = DMGetDefaultSection(dmCoarse, &sc);CHKERRQ(ierr);
6448   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6449   ierr = DMGetGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6450   ierr = DMPlexCreateCoarsePointIS(dmCoarse, &fpointIS);CHKERRQ(ierr);
6451   ierr = PetscSectionGetConstrainedStorageSize(gsc, &m);CHKERRQ(ierr);
6452   ierr = PetscMalloc2(m,&cindices,m,&findices);CHKERRQ(ierr);
6453   ierr = PetscSectionGetChart(gsc, &cpStart, &cpEnd);CHKERRQ(ierr);
6454   ierr = ISGetIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6455   for (cp = cpStart, off = 0; cp < cpEnd; ++cp) {
6456     const PetscInt *cdofsC = NULL;
6457     PetscInt        fp     = fpoints[cp-cpStart], dofC, cdofC, dofF, offC, offF, d, e;
6458 
6459     ierr = PetscSectionGetDof(gsc, cp, &dofC);CHKERRQ(ierr);
6460     if (dofC <= 0) continue;
6461     ierr = PetscSectionGetConstraintDof(sc, cp, &cdofC);CHKERRQ(ierr);
6462     ierr = PetscSectionGetDof(gsf, fp, &dofF);CHKERRQ(ierr);
6463     ierr = PetscSectionGetOffset(gsc, cp, &offC);CHKERRQ(ierr);
6464     ierr = PetscSectionGetOffset(gsf, fp, &offF);CHKERRQ(ierr);
6465     if (cdofC) {ierr = PetscSectionGetConstraintIndices(sc, cp, &cdofsC);CHKERRQ(ierr);}
6466     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);
6467     if (offC < 0 || offF < 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Coarse point %d has invalid offset %d (%d)", cp, offC, offF);
6468     for (d = 0, e = 0; d < dofC; ++d) {
6469       if (cdofsC && cdofsC[e] == d) {++e; continue;}
6470       cindices[off+d-e] = offC+d; findices[off+d-e] = offF+d;
6471     }
6472     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);
6473     off += dofC-cdofC;
6474   }
6475   ierr = ISRestoreIndices(fpointIS, &fpoints);CHKERRQ(ierr);
6476   if (off != m) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of coarse dofs %d != %d", off, m);
6477   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
6478   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
6479   ierr = VecScatterCreate(cv, cis, fv, fis, ctx);CHKERRQ(ierr);
6480   ierr = ISDestroy(&cis);CHKERRQ(ierr);
6481   ierr = ISDestroy(&fis);CHKERRQ(ierr);
6482   ierr = DMRestoreGlobalVector(dmFine, &fv);CHKERRQ(ierr);
6483   ierr = DMRestoreGlobalVector(dmCoarse, &cv);CHKERRQ(ierr);
6484   ierr = ISDestroy(&fpointIS);CHKERRQ(ierr);
6485   PetscFunctionReturn(0);
6486 }
6487 
6488 #undef __FUNCT__
6489 #define __FUNCT__ "DMCreateDefaultSection_Plex"
6490 /* Pointwise interpolation
6491      Just code FEM for now
6492      u^f = I u^c
6493      sum_k u^f_k phi^f_k = I sum_l u^c_l phi^c_l
6494      u^f_i = sum_l int psi^f_i I phi^c_l u^c_l
6495      I_{ij} = int psi^f_i phi^c_j
6496 */
6497 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6498 {
6499   PetscSection   section;
6500   IS            *bcPoints;
6501   PetscInt      *bcFields, *numComp, *numDof;
6502   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc, f;
6503   PetscErrorCode ierr;
6504 
6505   PetscFunctionBegin;
6506   /* Handle boundary conditions */
6507   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6508   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
6509   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
6510   for (bd = 0; bd < numBd; ++bd) {
6511     PetscBool isEssential;
6512     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6513     if (isEssential) ++numBC;
6514   }
6515   ierr = PetscMalloc2(numBC,&bcFields,numBC,&bcPoints);CHKERRQ(ierr);
6516   for (bd = 0, bc = 0; bd < numBd; ++bd) {
6517     const char     *bdLabel;
6518     DMLabel         label;
6519     const PetscInt *values;
6520     PetscInt        field, numValues;
6521     PetscBool       isEssential, has;
6522 
6523     ierr = DMPlexGetBoundary(dm, bd, &isEssential, &bdLabel, &field, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6524     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
6525     ierr = DMPlexHasLabel(dm, bdLabel, &has);CHKERRQ(ierr);
6526     if (!has) {
6527       ierr = DMPlexCreateLabel(dm, bdLabel);CHKERRQ(ierr);
6528       ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6529       ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
6530     }
6531     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6532     /* Only want to do this for FEM */
6533     ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6534     ierr = DMPlexLabelAddCells(dm, label);CHKERRQ(ierr);
6535     /* Filter out cells, if you actually want to constraint cells you need to do things by hand right now */
6536     if (isEssential) {
6537       IS              tmp;
6538       PetscInt       *newidx;
6539       const PetscInt *idx;
6540       PetscInt        cStart, cEnd, n, p, newn = 0;
6541 
6542       bcFields[bc] = field;
6543       ierr = DMPlexGetStratumIS(dm, bdLabel, values[0], &tmp);CHKERRQ(ierr);
6544       ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6545       ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6546       ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6547       for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
6548       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
6549       newn = 0;
6550       for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
6551       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6552       ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6553       ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6554     }
6555   }
6556   /* Handle discretization */
6557   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6558   ierr = PetscMalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6559   for (f = 0; f < numFields; ++f) {
6560     PetscFE         fe;
6561     const PetscInt *numFieldDof;
6562     PetscInt        d;
6563 
6564     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6565     ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6566     ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6567     for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6568   }
6569   for (f = 0; f < numFields; ++f) {
6570     PetscInt d;
6571     for (d = 1; d < dim; ++d) {
6572       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.");
6573     }
6574   }
6575   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcPoints, NULL, &section);CHKERRQ(ierr);
6576   for (f = 0; f < numFields; ++f) {
6577     PetscFE     fe;
6578     const char *name;
6579 
6580     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6581     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6582     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6583   }
6584   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6585   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6586   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);}
6587   ierr = PetscFree2(bcFields,bcPoints);CHKERRQ(ierr);
6588   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6589   PetscFunctionReturn(0);
6590 }
6591 
6592 #undef __FUNCT__
6593 #define __FUNCT__ "DMPlexGetCoarseDM"
6594 /*@
6595   DMPlexGetCoarseDM - Get the coarse mesh from which this was obtained by refinement
6596 
6597   Input Parameter:
6598 . dm - The DMPlex object
6599 
6600   Output Parameter:
6601 . cdm - The coarse DM
6602 
6603   Level: intermediate
6604 
6605 .seealso: DMPlexSetCoarseDM()
6606 @*/
6607 PetscErrorCode DMPlexGetCoarseDM(DM dm, DM *cdm)
6608 {
6609   PetscFunctionBegin;
6610   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6611   PetscValidPointer(cdm, 2);
6612   *cdm = ((DM_Plex *) dm->data)->coarseMesh;
6613   PetscFunctionReturn(0);
6614 }
6615 
6616 #undef __FUNCT__
6617 #define __FUNCT__ "DMPlexSetCoarseDM"
6618 /*@
6619   DMPlexSetCoarseDM - Set the coarse mesh from which this was obtained by refinement
6620 
6621   Input Parameters:
6622 + dm - The DMPlex object
6623 - cdm - The coarse DM
6624 
6625   Level: intermediate
6626 
6627 .seealso: DMPlexGetCoarseDM()
6628 @*/
6629 PetscErrorCode DMPlexSetCoarseDM(DM dm, DM cdm)
6630 {
6631   DM_Plex       *mesh;
6632   PetscErrorCode ierr;
6633 
6634   PetscFunctionBegin;
6635   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6636   if (cdm) PetscValidHeaderSpecific(cdm, DM_CLASSID, 2);
6637   mesh = (DM_Plex *) dm->data;
6638   ierr = DMDestroy(&mesh->coarseMesh);CHKERRQ(ierr);
6639   mesh->coarseMesh = cdm;
6640   ierr = PetscObjectReference((PetscObject) mesh->coarseMesh);CHKERRQ(ierr);
6641   PetscFunctionReturn(0);
6642 }
6643