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