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