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