1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petsc/private/isimpl.h>
3 #include <petsc/private/vecimpl.h>
4 #include <petsc/private/glvisvecimpl.h>
5 #include <petscsf.h>
6 #include <petscds.h>
7 #include <petscdraw.h>
8 #include <petscdmfield.h>
9 
10 /* Logging support */
11 PetscLogEvent DMPLEX_Interpolate, DMPLEX_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_Symmetrize, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM, DMPLEX_InterpolatorFEM, DMPLEX_InjectorFEM, DMPLEX_IntegralFEM, DMPLEX_CreateGmsh, DMPLEX_RebalanceSharedPoints, DMPLEX_PartSelf, DMPLEX_PartLabelInvert, DMPLEX_PartLabelCreateSF, DMPLEX_PartStratSF, DMPLEX_CreatePointSF,DMPLEX_LocatePoints;
12 
13 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
14 
15 /*@
16   DMPlexGetSimplexOrBoxCells - Get the range of cells which are neither prisms nor ghost FV cells
17 
18   Input Parameter:
19 + dm     - The DMPlex object
20 - height - The cell height in the Plex, 0 is the default
21 
22   Output Parameters:
23 + cStart - The first "normal" cell
24 - cEnd   - The upper bound on "normal"" cells
25 
26   Note: This just gives the first range of cells found. If the mesh has several cell types, it will only give the first.
27 
28   Level: developer
29 
30 .seealso DMPlexConstructGhostCells(), DMPlexSetGhostCellStratum()
31 @*/
DMPlexGetSimplexOrBoxCells(DM dm,PetscInt height,PetscInt * cStart,PetscInt * cEnd)32 PetscErrorCode DMPlexGetSimplexOrBoxCells(DM dm, PetscInt height, PetscInt *cStart, PetscInt *cEnd)
33 {
34   DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
35   PetscInt       cS, cE, c;
36   PetscErrorCode ierr;
37 
38   PetscFunctionBegin;
39   ierr = DMPlexGetHeightStratum(dm, PetscMax(height, 0), &cS, &cE);CHKERRQ(ierr);
40   for (c = cS; c < cE; ++c) {
41     DMPolytopeType cct;
42 
43     ierr = DMPlexGetCellType(dm, c, &cct);CHKERRQ(ierr);
44     if ((PetscInt) cct < 0) break;
45     switch (cct) {
46       case DM_POLYTOPE_POINT:
47       case DM_POLYTOPE_SEGMENT:
48       case DM_POLYTOPE_TRIANGLE:
49       case DM_POLYTOPE_QUADRILATERAL:
50       case DM_POLYTOPE_TETRAHEDRON:
51       case DM_POLYTOPE_HEXAHEDRON:
52         ct = cct;
53         break;
54       default: break;
55     }
56     if (ct != DM_POLYTOPE_UNKNOWN) break;
57   }
58   if (ct != DM_POLYTOPE_UNKNOWN) {
59     DMLabel ctLabel;
60 
61     ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
62     ierr = DMLabelGetStratumBounds(ctLabel, ct, &cS, &cE);CHKERRQ(ierr);
63   }
64   if (cStart) *cStart = cS;
65   if (cEnd)   *cEnd   = cE;
66   PetscFunctionReturn(0);
67 }
68 
DMPlexGetFieldType_Internal(DM dm,PetscSection section,PetscInt field,PetscInt * sStart,PetscInt * sEnd,PetscViewerVTKFieldType * ft)69 PetscErrorCode DMPlexGetFieldType_Internal(DM dm, PetscSection section, PetscInt field, PetscInt *sStart, PetscInt *sEnd, PetscViewerVTKFieldType *ft)
70 {
71   PetscInt       cdim, pStart, pEnd, vStart, vEnd, cStart, cEnd;
72   PetscInt       vcdof[2] = {0,0}, globalvcdof[2];
73   PetscErrorCode ierr;
74 
75   PetscFunctionBegin;
76   *ft  = PETSC_VTK_INVALID;
77   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
78   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
79   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
80   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
81   if (field >= 0) {
82     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, vStart, field, &vcdof[0]);CHKERRQ(ierr);}
83     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, cStart, field, &vcdof[1]);CHKERRQ(ierr);}
84   } else {
85     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vcdof[0]);CHKERRQ(ierr);}
86     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &vcdof[1]);CHKERRQ(ierr);}
87   }
88   ierr = MPI_Allreduce(vcdof, globalvcdof, 2, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
89   if (globalvcdof[0]) {
90     *sStart = vStart;
91     *sEnd   = vEnd;
92     if (globalvcdof[0] == cdim) *ft = PETSC_VTK_POINT_VECTOR_FIELD;
93     else                        *ft = PETSC_VTK_POINT_FIELD;
94   } else if (globalvcdof[1]) {
95     *sStart = cStart;
96     *sEnd   = cEnd;
97     if (globalvcdof[1] == cdim) *ft = PETSC_VTK_CELL_VECTOR_FIELD;
98     else                        *ft = PETSC_VTK_CELL_FIELD;
99   } else {
100     if (field >= 0) {
101       const char *fieldname;
102 
103       ierr = PetscSectionGetFieldName(section, field, &fieldname);CHKERRQ(ierr);
104       ierr = PetscInfo2((PetscObject) dm, "Could not classify VTK output type of section field %D \"%s\"\n", field, fieldname);CHKERRQ(ierr);
105     } else {
106       ierr = PetscInfo((PetscObject) dm, "Could not classify VTK output typp of section\"%s\"\n");CHKERRQ(ierr);
107     }
108   }
109   PetscFunctionReturn(0);
110 }
111 
VecView_Plex_Local_Draw(Vec v,PetscViewer viewer)112 static PetscErrorCode VecView_Plex_Local_Draw(Vec v, PetscViewer viewer)
113 {
114   DM                 dm;
115   PetscSection       s;
116   PetscDraw          draw, popup;
117   DM                 cdm;
118   PetscSection       coordSection;
119   Vec                coordinates;
120   const PetscScalar *coords, *array;
121   PetscReal          bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
122   PetscReal          vbound[2], time;
123   PetscBool          isnull, flg;
124   PetscInt           dim, Nf, f, Nc, comp, vStart, vEnd, cStart, cEnd, c, N, level, step, w = 0;
125   const char        *name;
126   char               title[PETSC_MAX_PATH_LEN];
127   PetscErrorCode     ierr;
128 
129   PetscFunctionBegin;
130   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
131   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
132   if (isnull) PetscFunctionReturn(0);
133 
134   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
135   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
136   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D. Use PETSCVIEWERGLVIS", dim);
137   ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
138   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
139   ierr = DMGetCoarsenLevel(dm, &level);CHKERRQ(ierr);
140   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
141   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
142   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
143   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
144   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
145 
146   ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
147   ierr = DMGetOutputSequenceNumber(dm, &step, &time);CHKERRQ(ierr);
148 
149   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
150   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
151   for (c = 0; c < N; c += dim) {
152     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
153     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
154   }
155   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
156   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
157 
158   /* Could implement something like DMDASelectFields() */
159   for (f = 0; f < Nf; ++f) {
160     DM   fdm = dm;
161     Vec  fv  = v;
162     IS   fis;
163     char prefix[PETSC_MAX_PATH_LEN];
164     const char *fname;
165 
166     ierr = PetscSectionGetFieldComponents(s, f, &Nc);CHKERRQ(ierr);
167     ierr = PetscSectionGetFieldName(s, f, &fname);CHKERRQ(ierr);
168 
169     if (v->hdr.prefix) {ierr = PetscStrncpy(prefix, v->hdr.prefix,sizeof(prefix));CHKERRQ(ierr);}
170     else               {prefix[0] = '\0';}
171     if (Nf > 1) {
172       ierr = DMCreateSubDM(dm, 1, &f, &fis, &fdm);CHKERRQ(ierr);
173       ierr = VecGetSubVector(v, fis, &fv);CHKERRQ(ierr);
174       ierr = PetscStrlcat(prefix, fname,sizeof(prefix));CHKERRQ(ierr);
175       ierr = PetscStrlcat(prefix, "_",sizeof(prefix));CHKERRQ(ierr);
176     }
177     for (comp = 0; comp < Nc; ++comp, ++w) {
178       PetscInt nmax = 2;
179 
180       ierr = PetscViewerDrawGetDraw(viewer, w, &draw);CHKERRQ(ierr);
181       if (Nc > 1) {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s_%D Step: %D Time: %.4g", name, fname, comp, step, time);CHKERRQ(ierr);}
182       else        {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s Step: %D Time: %.4g", name, fname, step, time);CHKERRQ(ierr);}
183       ierr = PetscDrawSetTitle(draw, title);CHKERRQ(ierr);
184 
185       /* TODO Get max and min only for this component */
186       ierr = PetscOptionsGetRealArray(NULL, prefix, "-vec_view_bounds", vbound, &nmax, &flg);CHKERRQ(ierr);
187       if (!flg) {
188         ierr = VecMin(fv, NULL, &vbound[0]);CHKERRQ(ierr);
189         ierr = VecMax(fv, NULL, &vbound[1]);CHKERRQ(ierr);
190         if (vbound[1] <= vbound[0]) vbound[1] = vbound[0] + 1.0;
191       }
192       ierr = PetscDrawGetPopup(draw, &popup);CHKERRQ(ierr);
193       ierr = PetscDrawScalePopup(popup, vbound[0], vbound[1]);CHKERRQ(ierr);
194       ierr = PetscDrawSetCoordinates(draw, bound[0], bound[1], bound[2], bound[3]);CHKERRQ(ierr);
195 
196       ierr = VecGetArrayRead(fv, &array);CHKERRQ(ierr);
197       for (c = cStart; c < cEnd; ++c) {
198         PetscScalar *coords = NULL, *a = NULL;
199         PetscInt     numCoords, color[4] = {-1,-1,-1,-1};
200 
201         ierr = DMPlexPointLocalRead(fdm, c, array, &a);CHKERRQ(ierr);
202         if (a) {
203           color[0] = PetscDrawRealToColor(PetscRealPart(a[comp]), vbound[0], vbound[1]);
204           color[1] = color[2] = color[3] = color[0];
205         } else {
206           PetscScalar *vals = NULL;
207           PetscInt     numVals, va;
208 
209           ierr = DMPlexVecGetClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
210           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);
211           switch (numVals/Nc) {
212           case 3: /* P1 Triangle */
213           case 4: /* P1 Quadrangle */
214             for (va = 0; va < numVals/Nc; ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp]), vbound[0], vbound[1]);
215             break;
216           case 6: /* P2 Triangle */
217           case 8: /* P2 Quadrangle */
218             for (va = 0; va < numVals/(Nc*2); ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp + numVals/(Nc*2)]), vbound[0], vbound[1]);
219             break;
220           default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of values for cell closure %D cannot be handled", numVals/Nc);
221           }
222           ierr = DMPlexVecRestoreClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
223         }
224         ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
225         switch (numCoords) {
226         case 6:
227           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);
228           break;
229         case 8:
230           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);
231           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);
232           break;
233         default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells with %D coordinates", numCoords);
234         }
235         ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
236       }
237       ierr = VecRestoreArrayRead(fv, &array);CHKERRQ(ierr);
238       ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
239       ierr = PetscDrawPause(draw);CHKERRQ(ierr);
240       ierr = PetscDrawSave(draw);CHKERRQ(ierr);
241     }
242     if (Nf > 1) {
243       ierr = VecRestoreSubVector(v, fis, &fv);CHKERRQ(ierr);
244       ierr = ISDestroy(&fis);CHKERRQ(ierr);
245       ierr = DMDestroy(&fdm);CHKERRQ(ierr);
246     }
247   }
248   PetscFunctionReturn(0);
249 }
250 
VecView_Plex_Local_VTK(Vec v,PetscViewer viewer)251 static PetscErrorCode VecView_Plex_Local_VTK(Vec v, PetscViewer viewer)
252 {
253   DM                      dm;
254   Vec                     locv;
255   const char              *name;
256   PetscSection            section;
257   PetscInt                pStart, pEnd;
258   PetscInt                numFields;
259   PetscViewerVTKFieldType ft;
260   PetscErrorCode          ierr;
261 
262   PetscFunctionBegin;
263   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
264   ierr = DMCreateLocalVector(dm, &locv);CHKERRQ(ierr); /* VTK viewer requires exclusive ownership of the vector */
265   ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
266   ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
267   ierr = VecCopy(v, locv);CHKERRQ(ierr);
268   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
269   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
270   if (!numFields) {
271     ierr = DMPlexGetFieldType_Internal(dm, section, PETSC_DETERMINE, &pStart, &pEnd, &ft);CHKERRQ(ierr);
272     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, PETSC_DEFAULT, ft, PETSC_TRUE,(PetscObject) locv);CHKERRQ(ierr);
273   } else {
274     PetscInt f;
275 
276     for (f = 0; f < numFields; f++) {
277       ierr = DMPlexGetFieldType_Internal(dm, section, f, &pStart, &pEnd, &ft);CHKERRQ(ierr);
278       if (ft == PETSC_VTK_INVALID) continue;
279       ierr = PetscObjectReference((PetscObject)locv);CHKERRQ(ierr);
280       ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, f, ft, PETSC_TRUE,(PetscObject) locv);CHKERRQ(ierr);
281     }
282     ierr = VecDestroy(&locv);CHKERRQ(ierr);
283   }
284   PetscFunctionReturn(0);
285 }
286 
VecView_Plex_Local(Vec v,PetscViewer viewer)287 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
288 {
289   DM             dm;
290   PetscBool      isvtk, ishdf5, isdraw, isglvis;
291   PetscErrorCode ierr;
292 
293   PetscFunctionBegin;
294   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
295   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
296   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
297   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
298   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,  &isdraw);CHKERRQ(ierr);
299   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS, &isglvis);CHKERRQ(ierr);
300   if (isvtk || ishdf5 || isdraw || isglvis) {
301     PetscInt    i,numFields;
302     PetscObject fe;
303     PetscBool   fem = PETSC_FALSE;
304     Vec         locv = v;
305     const char  *name;
306     PetscInt    step;
307     PetscReal   time;
308 
309     ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
310     for (i=0; i<numFields; i++) {
311       ierr = DMGetField(dm, i, NULL, &fe);CHKERRQ(ierr);
312       if (fe->classid == PETSCFE_CLASSID) { fem = PETSC_TRUE; break; }
313     }
314     if (fem) {
315       ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
316       ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
317       ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
318       ierr = VecCopy(v, locv);CHKERRQ(ierr);
319       ierr = DMGetOutputSequenceNumber(dm, NULL, &time);CHKERRQ(ierr);
320       ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locv, time, NULL, NULL, NULL);CHKERRQ(ierr);
321     }
322     if (isvtk) {
323       ierr = VecView_Plex_Local_VTK(locv, viewer);CHKERRQ(ierr);
324     } else if (ishdf5) {
325 #if defined(PETSC_HAVE_HDF5)
326       ierr = VecView_Plex_Local_HDF5_Internal(locv, viewer);CHKERRQ(ierr);
327 #else
328       SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
329 #endif
330     } else if (isdraw) {
331       ierr = VecView_Plex_Local_Draw(locv, viewer);CHKERRQ(ierr);
332     } else if (isglvis) {
333       ierr = DMGetOutputSequenceNumber(dm, &step, NULL);CHKERRQ(ierr);
334       ierr = PetscViewerGLVisSetSnapId(viewer, step);CHKERRQ(ierr);
335       ierr = VecView_GLVis(locv, viewer);CHKERRQ(ierr);
336     }
337     if (fem) {ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);}
338   } else {
339     PetscBool isseq;
340 
341     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
342     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
343     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
344   }
345   PetscFunctionReturn(0);
346 }
347 
VecView_Plex(Vec v,PetscViewer viewer)348 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
349 {
350   DM             dm;
351   PetscBool      isvtk, ishdf5, isdraw, isglvis;
352   PetscErrorCode ierr;
353 
354   PetscFunctionBegin;
355   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
356   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
357   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
358   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
359   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,  &isdraw);CHKERRQ(ierr);
360   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS, &isglvis);CHKERRQ(ierr);
361   if (isvtk || isdraw || isglvis) {
362     Vec         locv;
363     const char *name;
364 
365     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
366     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
367     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
368     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
369     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
370     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
371     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
372   } else if (ishdf5) {
373 #if defined(PETSC_HAVE_HDF5)
374     ierr = VecView_Plex_HDF5_Internal(v, viewer);CHKERRQ(ierr);
375 #else
376     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
377 #endif
378   } else {
379     PetscBool isseq;
380 
381     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
382     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
383     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
384   }
385   PetscFunctionReturn(0);
386 }
387 
VecView_Plex_Native(Vec originalv,PetscViewer viewer)388 PetscErrorCode VecView_Plex_Native(Vec originalv, PetscViewer viewer)
389 {
390   DM                dm;
391   MPI_Comm          comm;
392   PetscViewerFormat format;
393   Vec               v;
394   PetscBool         isvtk, ishdf5;
395   PetscErrorCode    ierr;
396 
397   PetscFunctionBegin;
398   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
399   ierr = PetscObjectGetComm((PetscObject) originalv, &comm);CHKERRQ(ierr);
400   if (!dm) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
401   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
402   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
403   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
404   if (format == PETSC_VIEWER_NATIVE) {
405     /* Natural ordering is the common case for DMDA, NATIVE means plain vector, for PLEX is the opposite */
406     /* this need a better fix */
407     if (dm->useNatural) {
408       if (dm->sfNatural) {
409         const char *vecname;
410         PetscInt    n, nroots;
411 
412         ierr = VecGetLocalSize(originalv, &n);CHKERRQ(ierr);
413         ierr = PetscSFGetGraph(dm->sfNatural, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
414         if (n == nroots) {
415           ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
416           ierr = DMPlexGlobalToNaturalBegin(dm, originalv, v);CHKERRQ(ierr);
417           ierr = DMPlexGlobalToNaturalEnd(dm, originalv, v);CHKERRQ(ierr);
418           ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
419           ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
420         } else SETERRQ(comm, PETSC_ERR_ARG_WRONG, "DM global to natural SF only handles global vectors");
421       } else SETERRQ(comm, PETSC_ERR_ARG_WRONGSTATE, "DM global to natural SF was not created");
422     } else v = originalv;
423   } else v = originalv;
424 
425   if (ishdf5) {
426 #if defined(PETSC_HAVE_HDF5)
427     ierr = VecView_Plex_HDF5_Native_Internal(v, viewer);CHKERRQ(ierr);
428 #else
429     SETERRQ(comm, PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
430 #endif
431   } else if (isvtk) {
432     SETERRQ(comm, PETSC_ERR_SUP, "VTK format does not support viewing in natural order. Please switch to HDF5.");
433   } else {
434     PetscBool isseq;
435 
436     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
437     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
438     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
439   }
440   if (v != originalv) {ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);}
441   PetscFunctionReturn(0);
442 }
443 
VecLoad_Plex_Local(Vec v,PetscViewer viewer)444 PetscErrorCode VecLoad_Plex_Local(Vec v, PetscViewer viewer)
445 {
446   DM             dm;
447   PetscBool      ishdf5;
448   PetscErrorCode ierr;
449 
450   PetscFunctionBegin;
451   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
452   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
453   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
454   if (ishdf5) {
455     DM          dmBC;
456     Vec         gv;
457     const char *name;
458 
459     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
460     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
461     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
462     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
463     ierr = VecLoad_Default(gv, viewer);CHKERRQ(ierr);
464     ierr = DMGlobalToLocalBegin(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
465     ierr = DMGlobalToLocalEnd(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
466     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
467   } else {
468     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
469   }
470   PetscFunctionReturn(0);
471 }
472 
VecLoad_Plex(Vec v,PetscViewer viewer)473 PetscErrorCode VecLoad_Plex(Vec v, PetscViewer viewer)
474 {
475   DM             dm;
476   PetscBool      ishdf5;
477   PetscErrorCode ierr;
478 
479   PetscFunctionBegin;
480   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
481   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
482   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
483   if (ishdf5) {
484 #if defined(PETSC_HAVE_HDF5)
485     ierr = VecLoad_Plex_HDF5_Internal(v, viewer);CHKERRQ(ierr);
486 #else
487     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
488 #endif
489   } else {
490     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
491   }
492   PetscFunctionReturn(0);
493 }
494 
VecLoad_Plex_Native(Vec originalv,PetscViewer viewer)495 PetscErrorCode VecLoad_Plex_Native(Vec originalv, PetscViewer viewer)
496 {
497   DM                dm;
498   PetscViewerFormat format;
499   PetscBool         ishdf5;
500   PetscErrorCode    ierr;
501 
502   PetscFunctionBegin;
503   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
504   if (!dm) SETERRQ(PetscObjectComm((PetscObject) originalv), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
505   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
506   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
507   if (format == PETSC_VIEWER_NATIVE) {
508     if (dm->useNatural) {
509       if (dm->sfNatural) {
510         if (ishdf5) {
511 #if defined(PETSC_HAVE_HDF5)
512           Vec         v;
513           const char *vecname;
514 
515           ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
516           ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
517           ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
518           ierr = VecLoad_Plex_HDF5_Native_Internal(v, viewer);CHKERRQ(ierr);
519           ierr = DMPlexNaturalToGlobalBegin(dm, v, originalv);CHKERRQ(ierr);
520           ierr = DMPlexNaturalToGlobalEnd(dm, v, originalv);CHKERRQ(ierr);
521           ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
522 #else
523           SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
524 #endif
525         } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Reading in natural order is not supported for anything but HDF5.");
526       }
527     } else {
528       ierr = VecLoad_Default(originalv, viewer);CHKERRQ(ierr);
529     }
530   }
531   PetscFunctionReturn(0);
532 }
533 
DMPlexView_Ascii_Geometry(DM dm,PetscViewer viewer)534 PETSC_UNUSED static PetscErrorCode DMPlexView_Ascii_Geometry(DM dm, PetscViewer viewer)
535 {
536   PetscSection       coordSection;
537   Vec                coordinates;
538   DMLabel            depthLabel, celltypeLabel;
539   const char        *name[4];
540   const PetscScalar *a;
541   PetscInt           dim, pStart, pEnd, cStart, cEnd, c;
542   PetscErrorCode     ierr;
543 
544   PetscFunctionBegin;
545   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
546   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
547   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
548   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
549   ierr = DMPlexGetCellTypeLabel(dm, &celltypeLabel);CHKERRQ(ierr);
550   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
551   ierr = PetscSectionGetChart(coordSection, &pStart, &pEnd);CHKERRQ(ierr);
552   ierr = VecGetArrayRead(coordinates, &a);CHKERRQ(ierr);
553   name[0]     = "vertex";
554   name[1]     = "edge";
555   name[dim-1] = "face";
556   name[dim]   = "cell";
557   for (c = cStart; c < cEnd; ++c) {
558     PetscInt *closure = NULL;
559     PetscInt  closureSize, cl, ct;
560 
561     ierr = DMLabelGetValue(celltypeLabel, c, &ct);CHKERRQ(ierr);
562     ierr = PetscViewerASCIIPrintf(viewer, "Geometry for cell %D polytope type %s:\n", c, DMPolytopeTypes[ct]);CHKERRQ(ierr);
563     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
564     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
565     for (cl = 0; cl < closureSize*2; cl += 2) {
566       PetscInt point = closure[cl], depth, dof, off, d, p;
567 
568       if ((point < pStart) || (point >= pEnd)) continue;
569       ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
570       if (!dof) continue;
571       ierr = DMLabelGetValue(depthLabel, point, &depth);CHKERRQ(ierr);
572       ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
573       ierr = PetscViewerASCIIPrintf(viewer, "%s %D coords:", name[depth], point);CHKERRQ(ierr);
574       for (p = 0; p < dof/dim; ++p) {
575         ierr = PetscViewerASCIIPrintf(viewer, " (");CHKERRQ(ierr);
576         for (d = 0; d < dim; ++d) {
577           if (d > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
578           ierr = PetscViewerASCIIPrintf(viewer, "%g", (double) PetscRealPart(a[off+p*dim+d]));CHKERRQ(ierr);
579         }
580         ierr = PetscViewerASCIIPrintf(viewer, ")");CHKERRQ(ierr);
581       }
582       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
583     }
584     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
585     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
586   }
587   ierr = VecRestoreArrayRead(coordinates, &a);CHKERRQ(ierr);
588   PetscFunctionReturn(0);
589 }
590 
DMPlexView_Ascii(DM dm,PetscViewer viewer)591 static PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
592 {
593   DM_Plex          *mesh = (DM_Plex*) dm->data;
594   DM                cdm;
595   DMLabel           markers, celltypes;
596   PetscSection      coordSection;
597   Vec               coordinates;
598   PetscViewerFormat format;
599   PetscErrorCode    ierr;
600 
601   PetscFunctionBegin;
602   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
603   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
604   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
605   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
606   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
607     const char *name;
608     PetscInt    dim, cellHeight, maxConeSize, maxSupportSize;
609     PetscInt    pStart, pEnd, p;
610     PetscMPIInt rank, size;
611 
612     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
613     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
614     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
615     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
616     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
617     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
618     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
619     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimension%s:\n", name, dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
620     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimension%s:\n", dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
621     if (cellHeight) {ierr = PetscViewerASCIIPrintf(viewer, "  Cells are at height %D\n", cellHeight);CHKERRQ(ierr);}
622     ierr = PetscViewerASCIIPrintf(viewer, "Supports:\n", name);CHKERRQ(ierr);
623     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
624     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d] Max support size: %D\n", rank, maxSupportSize);CHKERRQ(ierr);
625     for (p = pStart; p < pEnd; ++p) {
626       PetscInt dof, off, s;
627 
628       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
629       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
630       for (s = off; s < off+dof; ++s) {
631         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
632       }
633     }
634     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
635     ierr = PetscViewerASCIIPrintf(viewer, "Cones:\n", name);CHKERRQ(ierr);
636     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d] Max cone size: %D\n", rank, maxConeSize);CHKERRQ(ierr);
637     for (p = pStart; p < pEnd; ++p) {
638       PetscInt dof, off, c;
639 
640       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
641       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
642       for (c = off; c < off+dof; ++c) {
643         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
644       }
645     }
646     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
647     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
648     if (coordSection && coordinates) {
649       ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);
650     }
651     ierr = DMGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
652     if (markers) {ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);}
653     ierr = DMPlexGetCellTypeLabel(dm, &celltypes);CHKERRQ(ierr);
654     if (celltypes) {ierr = DMLabelView(celltypes, viewer);CHKERRQ(ierr);}
655     if (size > 1) {
656       PetscSF sf;
657 
658       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
659       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
660     }
661     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
662   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
663     const char  *name, *color;
664     const char  *defcolors[3]  = {"gray", "orange", "green"};
665     const char  *deflcolors[4] = {"blue", "cyan", "red", "magenta"};
666     char         lname[PETSC_MAX_PATH_LEN];
667     PetscReal    scale         = 2.0;
668     PetscReal    tikzscale     = 1.0;
669     PetscBool    useNumbers    = PETSC_TRUE, useLabels, useColors;
670     double       tcoords[3];
671     PetscScalar *coords;
672     PetscInt     numLabels, l, numColors, numLColors, dim, depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
673     PetscMPIInt  rank, size;
674     char         **names, **colors, **lcolors;
675     PetscBool    plotEdges, flg, lflg;
676     PetscBT      wp = NULL;
677     PetscInt     pEnd, pStart;
678 
679     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
680     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
681     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
682     numLabels  = PetscMax(numLabels, 10);
683     numColors  = 10;
684     numLColors = 10;
685     ierr = PetscCalloc3(numLabels, &names, numColors, &colors, numLColors, &lcolors);CHKERRQ(ierr);
686     ierr = PetscOptionsGetReal(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_scale", &scale, NULL);CHKERRQ(ierr);
687     ierr = PetscOptionsGetReal(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_tikzscale", &tikzscale, NULL);CHKERRQ(ierr);
688     ierr = PetscOptionsGetBool(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_numbers", &useNumbers, NULL);CHKERRQ(ierr);
689     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_labels", names, &numLabels, &useLabels);CHKERRQ(ierr);
690     if (!useLabels) numLabels = 0;
691     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_colors", colors, &numColors, &useColors);CHKERRQ(ierr);
692     if (!useColors) {
693       numColors = 3;
694       for (c = 0; c < numColors; ++c) {ierr = PetscStrallocpy(defcolors[c], &colors[c]);CHKERRQ(ierr);}
695     }
696     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_lcolors", lcolors, &numLColors, &useColors);CHKERRQ(ierr);
697     if (!useColors) {
698       numLColors = 4;
699       for (c = 0; c < numLColors; ++c) {ierr = PetscStrallocpy(deflcolors[c], &lcolors[c]);CHKERRQ(ierr);}
700     }
701     ierr = PetscOptionsGetString(((PetscObject) viewer)->options, ((PetscObject) viewer)->prefix, "-dm_plex_view_label_filter", lname, sizeof(lname), &lflg);CHKERRQ(ierr);
702     plotEdges = (PetscBool)(depth > 1 && useNumbers && dim < 3);
703     ierr = PetscOptionsGetBool(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_edges", &plotEdges, &flg);CHKERRQ(ierr);
704     if (flg && plotEdges && depth < dim) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Mesh must be interpolated");
705     if (depth < dim) plotEdges = PETSC_FALSE;
706 
707     /* filter points with labelvalue != labeldefaultvalue */
708     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
709     if (lflg) {
710       DMLabel lbl;
711 
712       ierr = DMGetLabel(dm, lname, &lbl);CHKERRQ(ierr);
713       if (lbl) {
714         PetscInt val, defval;
715 
716         ierr = DMLabelGetDefaultValue(lbl, &defval);CHKERRQ(ierr);
717         ierr = PetscBTCreate(pEnd-pStart, &wp);CHKERRQ(ierr);
718         for (c = pStart;  c < pEnd; c++) {
719           PetscInt *closure = NULL;
720           PetscInt  closureSize;
721 
722           ierr = DMLabelGetValue(lbl, c, &val);CHKERRQ(ierr);
723           if (val == defval) continue;
724 
725           ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
726           for (p = 0; p < closureSize*2; p += 2) {
727             ierr = PetscBTSet(wp, closure[p] - pStart);CHKERRQ(ierr);
728           }
729           ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
730         }
731       }
732     }
733 
734     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
735     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
736     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
737     ierr = PetscViewerASCIIPrintf(viewer, "\
738 \\documentclass[tikz]{standalone}\n\n\
739 \\usepackage{pgflibraryshapes}\n\
740 \\usetikzlibrary{backgrounds}\n\
741 \\usetikzlibrary{arrows}\n\
742 \\begin{document}\n");CHKERRQ(ierr);
743     if (size > 1) {
744       ierr = PetscViewerASCIIPrintf(viewer, "%s for process ", name);CHKERRQ(ierr);
745       for (p = 0; p < size; ++p) {
746         if (p > 0 && p == size-1) {
747           ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
748         } else if (p > 0) {
749           ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
750         }
751         ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
752       }
753       ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n");CHKERRQ(ierr);
754     }
755     ierr = PetscViewerASCIIPrintf(viewer, "\\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n", (double) tikzscale);CHKERRQ(ierr);
756 
757     /* Plot vertices */
758     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
759     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
760     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
761     for (v = vStart; v < vEnd; ++v) {
762       PetscInt  off, dof, d;
763       PetscBool isLabeled = PETSC_FALSE;
764 
765       if (wp && !PetscBTLookup(wp,v - pStart)) continue;
766       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
767       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
768       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
769       if (PetscUnlikely(dof > 3)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"coordSection vertex %D has dof %D > 3",v,dof);
770       for (d = 0; d < dof; ++d) {
771         tcoords[d] = (double) (scale*PetscRealPart(coords[off+d]));
772         tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
773       }
774       /* Rotate coordinates since PGF makes z point out of the page instead of up */
775       if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
776       for (d = 0; d < dof; ++d) {
777         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
778         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double) tcoords[d]);CHKERRQ(ierr);
779       }
780       color = colors[rank%numColors];
781       for (l = 0; l < numLabels; ++l) {
782         PetscInt val;
783         ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
784         if (val >= 0) {color = lcolors[l%numLColors]; isLabeled = PETSC_TRUE; break;}
785       }
786       if (useNumbers) {
787         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D};\n", v, rank, color, v);CHKERRQ(ierr);
788       } else {
789         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [fill,inner sep=%dpt,shape=circle,color=%s] {};\n", v, rank, !isLabeled ? 1 : 2, color);CHKERRQ(ierr);
790       }
791     }
792     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
793     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
794     /* Plot cells */
795     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
796     ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);
797     if (dim == 3 || !useNumbers) {
798       for (e = eStart; e < eEnd; ++e) {
799         const PetscInt *cone;
800 
801         if (wp && !PetscBTLookup(wp,e - pStart)) continue;
802         color = colors[rank%numColors];
803         for (l = 0; l < numLabels; ++l) {
804           PetscInt val;
805           ierr = DMGetLabelValue(dm, names[l], e, &val);CHKERRQ(ierr);
806           if (val >= 0) {color = lcolors[l%numLColors]; break;}
807         }
808         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
809         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] (%D_%d) -- (%D_%d);\n", color, cone[0], rank, cone[1], rank);CHKERRQ(ierr);
810       }
811     } else {
812       for (c = cStart; c < cEnd; ++c) {
813         PetscInt *closure = NULL;
814         PetscInt  closureSize, firstPoint = -1;
815 
816         if (wp && !PetscBTLookup(wp,c - pStart)) continue;
817         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
818         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
819         for (p = 0; p < closureSize*2; p += 2) {
820           const PetscInt point = closure[p];
821 
822           if ((point < vStart) || (point >= vEnd)) continue;
823           if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
824           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%d)", point, rank);CHKERRQ(ierr);
825           if (firstPoint < 0) firstPoint = point;
826         }
827         /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
828         ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%d);\n", firstPoint, rank);CHKERRQ(ierr);
829         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
830       }
831     }
832     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
833     for (c = cStart; c < cEnd; ++c) {
834       double    ccoords[3] = {0.0, 0.0, 0.0};
835       PetscBool isLabeled  = PETSC_FALSE;
836       PetscInt *closure    = NULL;
837       PetscInt  closureSize, dof, d, n = 0;
838 
839       if (wp && !PetscBTLookup(wp,c - pStart)) continue;
840       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
841       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
842       for (p = 0; p < closureSize*2; p += 2) {
843         const PetscInt point = closure[p];
844         PetscInt       off;
845 
846         if ((point < vStart) || (point >= vEnd)) continue;
847         ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
848         ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
849         for (d = 0; d < dof; ++d) {
850           tcoords[d] = (double) (scale*PetscRealPart(coords[off+d]));
851           tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
852         }
853         /* Rotate coordinates since PGF makes z point out of the page instead of up */
854         if (dof == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
855         for (d = 0; d < dof; ++d) {ccoords[d] += tcoords[d];}
856         ++n;
857       }
858       for (d = 0; d < dof; ++d) {ccoords[d] /= n;}
859       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
860       for (d = 0; d < dof; ++d) {
861         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
862         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double) ccoords[d]);CHKERRQ(ierr);
863       }
864       color = colors[rank%numColors];
865       for (l = 0; l < numLabels; ++l) {
866         PetscInt val;
867         ierr = DMGetLabelValue(dm, names[l], c, &val);CHKERRQ(ierr);
868         if (val >= 0) {color = lcolors[l%numLColors]; isLabeled = PETSC_TRUE; break;}
869       }
870       if (useNumbers) {
871         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D};\n", c, rank, color, c);CHKERRQ(ierr);
872       } else {
873         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [fill,inner sep=%dpt,shape=circle,color=%s] {};\n", c, rank, !isLabeled ? 1 : 2, color);CHKERRQ(ierr);
874       }
875     }
876     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
877     /* Plot edges */
878     if (plotEdges) {
879       ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
880       ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
881       for (e = eStart; e < eEnd; ++e) {
882         const PetscInt *cone;
883         PetscInt        coneSize, offA, offB, dof, d;
884 
885         if (wp && !PetscBTLookup(wp,e - pStart)) continue;
886         ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
887         if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %D cone should have two vertices, not %D", e, coneSize);
888         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
889         ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
890         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
891         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
892         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
893         for (d = 0; d < dof; ++d) {
894           tcoords[d] = (double) (0.5*scale*PetscRealPart(coords[offA+d]+coords[offB+d]));
895           tcoords[d] = PetscAbs(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
896         }
897         /* Rotate coordinates since PGF makes z point out of the page instead of up */
898         if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
899         for (d = 0; d < dof; ++d) {
900           if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
901           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)tcoords[d]);CHKERRQ(ierr);
902         }
903         color = colors[rank%numColors];
904         for (l = 0; l < numLabels; ++l) {
905           PetscInt val;
906           ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
907           if (val >= 0) {color = lcolors[l%numLColors]; break;}
908         }
909         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D} --\n", e, rank, color, e);CHKERRQ(ierr);
910       }
911       ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
912       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
913       ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
914     }
915     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
916     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
917     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n");CHKERRQ(ierr);
918     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
919     for (l = 0; l < numLabels;  ++l) {ierr = PetscFree(names[l]);CHKERRQ(ierr);}
920     for (c = 0; c < numColors;  ++c) {ierr = PetscFree(colors[c]);CHKERRQ(ierr);}
921     for (c = 0; c < numLColors; ++c) {ierr = PetscFree(lcolors[c]);CHKERRQ(ierr);}
922     ierr = PetscFree3(names, colors, lcolors);CHKERRQ(ierr);
923     ierr = PetscBTDestroy(&wp);CHKERRQ(ierr);
924   } else if (format == PETSC_VIEWER_LOAD_BALANCE) {
925     Vec                    cown,acown;
926     VecScatter             sct;
927     ISLocalToGlobalMapping g2l;
928     IS                     gid,acis;
929     MPI_Comm               comm,ncomm = MPI_COMM_NULL;
930     MPI_Group              ggroup,ngroup;
931     PetscScalar            *array,nid;
932     const PetscInt         *idxs;
933     PetscInt               *idxs2,*start,*adjacency,*work;
934     PetscInt64             lm[3],gm[3];
935     PetscInt               i,c,cStart,cEnd,cum,numVertices,ect,ectn,cellHeight;
936     PetscMPIInt            d1,d2,rank;
937 
938     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
939     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
940 #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
941     ierr = MPI_Comm_split_type(comm,MPI_COMM_TYPE_SHARED,rank,MPI_INFO_NULL,&ncomm);CHKERRQ(ierr);
942 #endif
943     if (ncomm != MPI_COMM_NULL) {
944       ierr = MPI_Comm_group(comm,&ggroup);CHKERRQ(ierr);
945       ierr = MPI_Comm_group(ncomm,&ngroup);CHKERRQ(ierr);
946       d1   = 0;
947       ierr = MPI_Group_translate_ranks(ngroup,1,&d1,ggroup,&d2);CHKERRQ(ierr);
948       nid  = d2;
949       ierr = MPI_Group_free(&ggroup);CHKERRQ(ierr);
950       ierr = MPI_Group_free(&ngroup);CHKERRQ(ierr);
951       ierr = MPI_Comm_free(&ncomm);CHKERRQ(ierr);
952     } else nid = 0.0;
953 
954     /* Get connectivity */
955     ierr = DMPlexGetVTKCellHeight(dm,&cellHeight);CHKERRQ(ierr);
956     ierr = DMPlexCreatePartitionerGraph(dm,cellHeight,&numVertices,&start,&adjacency,&gid);CHKERRQ(ierr);
957 
958     /* filter overlapped local cells */
959     ierr = DMPlexGetHeightStratum(dm,cellHeight,&cStart,&cEnd);CHKERRQ(ierr);
960     ierr = ISGetIndices(gid,&idxs);CHKERRQ(ierr);
961     ierr = ISGetLocalSize(gid,&cum);CHKERRQ(ierr);
962     ierr = PetscMalloc1(cum,&idxs2);CHKERRQ(ierr);
963     for (c = cStart, cum = 0; c < cEnd; c++) {
964       if (idxs[c-cStart] < 0) continue;
965       idxs2[cum++] = idxs[c-cStart];
966     }
967     ierr = ISRestoreIndices(gid,&idxs);CHKERRQ(ierr);
968     if (numVertices != cum) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected %D != %D",numVertices,cum);
969     ierr = ISDestroy(&gid);CHKERRQ(ierr);
970     ierr = ISCreateGeneral(comm,numVertices,idxs2,PETSC_OWN_POINTER,&gid);CHKERRQ(ierr);
971 
972     /* support for node-aware cell locality */
973     ierr = ISCreateGeneral(comm,start[numVertices],adjacency,PETSC_USE_POINTER,&acis);CHKERRQ(ierr);
974     ierr = VecCreateSeq(PETSC_COMM_SELF,start[numVertices],&acown);CHKERRQ(ierr);
975     ierr = VecCreateMPI(comm,numVertices,PETSC_DECIDE,&cown);CHKERRQ(ierr);
976     ierr = VecGetArray(cown,&array);CHKERRQ(ierr);
977     for (c = 0; c < numVertices; c++) array[c] = nid;
978     ierr = VecRestoreArray(cown,&array);CHKERRQ(ierr);
979     ierr = VecScatterCreate(cown,acis,acown,NULL,&sct);CHKERRQ(ierr);
980     ierr = VecScatterBegin(sct,cown,acown,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
981     ierr = VecScatterEnd(sct,cown,acown,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
982     ierr = ISDestroy(&acis);CHKERRQ(ierr);
983     ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
984     ierr = VecDestroy(&cown);CHKERRQ(ierr);
985 
986     /* compute edgeCut */
987     for (c = 0, cum = 0; c < numVertices; c++) cum = PetscMax(cum,start[c+1]-start[c]);
988     ierr = PetscMalloc1(cum,&work);CHKERRQ(ierr);
989     ierr = ISLocalToGlobalMappingCreateIS(gid,&g2l);CHKERRQ(ierr);
990     ierr = ISLocalToGlobalMappingSetType(g2l,ISLOCALTOGLOBALMAPPINGHASH);CHKERRQ(ierr);
991     ierr = ISDestroy(&gid);CHKERRQ(ierr);
992     ierr = VecGetArray(acown,&array);CHKERRQ(ierr);
993     for (c = 0, ect = 0, ectn = 0; c < numVertices; c++) {
994       PetscInt totl;
995 
996       totl = start[c+1]-start[c];
997       ierr = ISGlobalToLocalMappingApply(g2l,IS_GTOLM_MASK,totl,adjacency+start[c],NULL,work);CHKERRQ(ierr);
998       for (i = 0; i < totl; i++) {
999         if (work[i] < 0) {
1000           ect  += 1;
1001           ectn += (array[i + start[c]] != nid) ? 0 : 1;
1002         }
1003       }
1004     }
1005     ierr  = PetscFree(work);CHKERRQ(ierr);
1006     ierr  = VecRestoreArray(acown,&array);CHKERRQ(ierr);
1007     lm[0] = numVertices > 0 ?  numVertices : PETSC_MAX_INT;
1008     lm[1] = -numVertices;
1009     ierr  = MPIU_Allreduce(lm,gm,2,MPIU_INT64,MPI_MIN,comm);CHKERRQ(ierr);
1010     ierr  = PetscViewerASCIIPrintf(viewer,"  Cell balance: %.2f (max %D, min %D",-((double)gm[1])/((double)gm[0]),-(PetscInt)gm[1],(PetscInt)gm[0]);CHKERRQ(ierr);
1011     lm[0] = ect; /* edgeCut */
1012     lm[1] = ectn; /* node-aware edgeCut */
1013     lm[2] = numVertices > 0 ? 0 : 1; /* empty processes */
1014     ierr  = MPIU_Allreduce(lm,gm,3,MPIU_INT64,MPI_SUM,comm);CHKERRQ(ierr);
1015     ierr  = PetscViewerASCIIPrintf(viewer,", empty %D)\n",(PetscInt)gm[2]);CHKERRQ(ierr);
1016 #if defined(PETSC_HAVE_MPI_PROCESS_SHARED_MEMORY)
1017     ierr  = PetscViewerASCIIPrintf(viewer,"  Edge Cut: %D (on node %.3f)\n",(PetscInt)(gm[0]/2),gm[0] ? ((double)(gm[1]))/((double)gm[0]) : 1.);CHKERRQ(ierr);
1018 #else
1019     ierr  = PetscViewerASCIIPrintf(viewer,"  Edge Cut: %D (on node %.3f)\n",(PetscInt)(gm[0]/2),0.0);CHKERRQ(ierr);
1020 #endif
1021     ierr  = ISLocalToGlobalMappingDestroy(&g2l);CHKERRQ(ierr);
1022     ierr  = PetscFree(start);CHKERRQ(ierr);
1023     ierr  = PetscFree(adjacency);CHKERRQ(ierr);
1024     ierr  = VecDestroy(&acown);CHKERRQ(ierr);
1025   } else {
1026     const char    *name;
1027     PetscInt      *sizes, *hybsizes, *ghostsizes;
1028     PetscInt       locDepth, depth, cellHeight, dim, d;
1029     PetscInt       pStart, pEnd, p, gcStart, gcEnd, gcNum;
1030     PetscInt       numLabels, l;
1031     DMPolytopeType ct0;
1032     MPI_Comm       comm;
1033     PetscMPIInt    size, rank;
1034 
1035     ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
1036     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
1037     ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
1038     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1039     ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1040     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
1041     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimension%s:\n", name, dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
1042     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimension%s:\n", dim, dim == 1 ? "" : "s");CHKERRQ(ierr);}
1043     if (cellHeight) {ierr = PetscViewerASCIIPrintf(viewer, "  Cells are at height %D\n", cellHeight);CHKERRQ(ierr);}
1044     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
1045     ierr = MPIU_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
1046     ierr = DMPlexGetGhostCellStratum(dm, &gcStart, &gcEnd);CHKERRQ(ierr);
1047     gcNum = gcEnd - gcStart;
1048     ierr = PetscCalloc3(size,&sizes,size,&hybsizes,size,&ghostsizes);CHKERRQ(ierr);
1049     for (d = 0; d <= depth; d++) {
1050       PetscInt Nc[2] = {0, 0}, ict;
1051 
1052       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
1053       ierr = DMPlexGetCellType(dm, pStart, &ct0);CHKERRQ(ierr);
1054       ict  = ct0;
1055       ierr = MPI_Bcast(&ict, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
1056       ct0  = (DMPolytopeType) ict;
1057       for (p = pStart; p < pEnd; ++p) {
1058         DMPolytopeType ct;
1059 
1060         ierr = DMPlexGetCellType(dm, p, &ct);CHKERRQ(ierr);
1061         if (ct == ct0) ++Nc[0];
1062         else           ++Nc[1];
1063       }
1064       ierr = MPI_Gather(&Nc[0], 1, MPIU_INT, sizes,    1, MPIU_INT, 0, comm);CHKERRQ(ierr);
1065       ierr = MPI_Gather(&Nc[1], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
1066       if (d == depth) {ierr = MPI_Gather(&gcNum, 1, MPIU_INT, ghostsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);}
1067       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", (depth == 1) && d ? dim : d);CHKERRQ(ierr);
1068       for (p = 0; p < size; ++p) {
1069         if (!rank) {
1070           ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]+hybsizes[p]);CHKERRQ(ierr);
1071           if (hybsizes[p]   > 0) {ierr = PetscViewerASCIIPrintf(viewer, " (%D)", hybsizes[p]);CHKERRQ(ierr);}
1072           if (ghostsizes[p] > 0) {ierr = PetscViewerASCIIPrintf(viewer, " [%D]", ghostsizes[p]);CHKERRQ(ierr);}
1073         }
1074       }
1075       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
1076     }
1077     ierr = PetscFree3(sizes,hybsizes,ghostsizes);CHKERRQ(ierr);
1078     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
1079     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
1080     for (l = 0; l < numLabels; ++l) {
1081       DMLabel         label;
1082       const char     *name;
1083       IS              valueIS;
1084       const PetscInt *values;
1085       PetscInt        numValues, v;
1086 
1087       ierr = DMGetLabelName(dm, l, &name);CHKERRQ(ierr);
1088       ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
1089       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
1090       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %D strata with value/size (", name, numValues);CHKERRQ(ierr);
1091       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
1092       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
1093       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_FALSE);CHKERRQ(ierr);
1094       for (v = 0; v < numValues; ++v) {
1095         PetscInt size;
1096 
1097         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
1098         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
1099         ierr = PetscViewerASCIIPrintf(viewer, "%D (%D)", values[v], size);CHKERRQ(ierr);
1100       }
1101       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
1102       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_TRUE);CHKERRQ(ierr);
1103       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
1104       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
1105     }
1106     /* If no fields are specified, people do not want to see adjacency */
1107     if (dm->Nf) {
1108       PetscInt f;
1109 
1110       for (f = 0; f < dm->Nf; ++f) {
1111         const char *name;
1112 
1113         ierr = PetscObjectGetName(dm->fields[f].disc, &name);CHKERRQ(ierr);
1114         if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Field %s:\n", name);CHKERRQ(ierr);}
1115         ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
1116         if (dm->fields[f].label) {ierr = DMLabelView(dm->fields[f].label, viewer);CHKERRQ(ierr);}
1117         if (dm->fields[f].adjacency[0]) {
1118           if (dm->fields[f].adjacency[1]) {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FVM++\n");CHKERRQ(ierr);}
1119           else                            {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FVM\n");CHKERRQ(ierr);}
1120         } else {
1121           if (dm->fields[f].adjacency[1]) {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FEM\n");CHKERRQ(ierr);}
1122           else                            {ierr = PetscViewerASCIIPrintf(viewer, "adjacency FUNKY\n");CHKERRQ(ierr);}
1123         }
1124         ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
1125       }
1126     }
1127     ierr = DMGetCoarseDM(dm, &cdm);CHKERRQ(ierr);
1128     if (cdm) {
1129       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
1130       ierr = DMPlexView_Ascii(cdm, viewer);CHKERRQ(ierr);
1131       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
1132     }
1133   }
1134   PetscFunctionReturn(0);
1135 }
1136 
DMPlexDrawCell(DM dm,PetscDraw draw,PetscInt cell,const PetscScalar coords[])1137 static PetscErrorCode DMPlexDrawCell(DM dm, PetscDraw draw, PetscInt cell, const PetscScalar coords[])
1138 {
1139   DMPolytopeType ct;
1140   PetscMPIInt    rank;
1141   PetscErrorCode ierr;
1142 
1143   PetscFunctionBegin;
1144   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
1145   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1146   switch (ct) {
1147   case DM_POLYTOPE_TRIANGLE:
1148     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]),
1149                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1150                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1151                              PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1152     ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1153     ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1154     ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1155     break;
1156   case DM_POLYTOPE_QUADRILATERAL:
1157     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]),
1158                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1159                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1160                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1161     ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]),
1162                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1163                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2,
1164                               PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2);CHKERRQ(ierr);
1165     ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1166     ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1167     ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1168     ierr = PetscDrawLine(draw, PetscRealPart(coords[6]), PetscRealPart(coords[7]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
1169     break;
1170   default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells of type %s", DMPolytopeTypes[ct]);
1171   }
1172   PetscFunctionReturn(0);
1173 }
1174 
DMPlexDrawCellHighOrder(DM dm,PetscDraw draw,PetscInt cell,const PetscScalar coords[],PetscInt edgeDiv,PetscReal refCoords[],PetscReal edgeCoords[])1175 static PetscErrorCode DMPlexDrawCellHighOrder(DM dm, PetscDraw draw, PetscInt cell, const PetscScalar coords[], PetscInt edgeDiv, PetscReal refCoords[], PetscReal edgeCoords[])
1176 {
1177   DMPolytopeType ct;
1178   PetscReal      centroid[2] = {0., 0.};
1179   PetscMPIInt    rank;
1180   PetscInt       fillColor, v, e, d;
1181   PetscErrorCode ierr;
1182 
1183   PetscFunctionBegin;
1184   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
1185   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1186   fillColor = PETSC_DRAW_WHITE + rank % (PETSC_DRAW_BASIC_COLORS-2) + 2;
1187   switch (ct) {
1188   case DM_POLYTOPE_TRIANGLE:
1189     {
1190       PetscReal refVertices[6] = {-1., -1., 1., -1., -1., 1.};
1191 
1192       for (v = 0; v < 3; ++v) {centroid[0] += PetscRealPart(coords[v*2+0])/3.;centroid[1] += PetscRealPart(coords[v*2+1])/3.;}
1193       for (e = 0; e < 3; ++e) {
1194         refCoords[0] = refVertices[e*2+0];
1195         refCoords[1] = refVertices[e*2+1];
1196         for (d = 1; d <= edgeDiv; ++d) {
1197           refCoords[d*2+0] = refCoords[0] + (refVertices[(e+1)%3 * 2 + 0] - refCoords[0])*d/edgeDiv;
1198           refCoords[d*2+1] = refCoords[1] + (refVertices[(e+1)%3 * 2 + 1] - refCoords[1])*d/edgeDiv;
1199         }
1200         ierr = DMPlexReferenceToCoordinates(dm, cell, edgeDiv+1, refCoords, edgeCoords);CHKERRQ(ierr);
1201         for (d = 0; d < edgeDiv; ++d) {
1202           ierr = PetscDrawTriangle(draw, centroid[0], centroid[1], edgeCoords[d*2+0], edgeCoords[d*2+1], edgeCoords[(d+1)*2+0], edgeCoords[(d+1)*2+1], fillColor, fillColor, fillColor);CHKERRQ(ierr);
1203           ierr = PetscDrawLine(draw, edgeCoords[d*2+0], edgeCoords[d*2+1], edgeCoords[(d+1)*2+0], edgeCoords[(d+1)*2+1], PETSC_DRAW_BLACK);CHKERRQ(ierr);
1204         }
1205       }
1206     }
1207     break;
1208   default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells of type %s", DMPolytopeTypes[ct]);
1209   }
1210   PetscFunctionReturn(0);
1211 }
1212 
DMPlexView_Draw(DM dm,PetscViewer viewer)1213 static PetscErrorCode DMPlexView_Draw(DM dm, PetscViewer viewer)
1214 {
1215   PetscDraw          draw;
1216   DM                 cdm;
1217   PetscSection       coordSection;
1218   Vec                coordinates;
1219   const PetscScalar *coords;
1220   PetscReal          xyl[2],xyr[2],bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
1221   PetscReal         *refCoords, *edgeCoords;
1222   PetscBool          isnull, drawAffine = PETSC_TRUE;
1223   PetscInt           dim, vStart, vEnd, cStart, cEnd, c, N, edgeDiv = 4;
1224   PetscErrorCode     ierr;
1225 
1226   PetscFunctionBegin;
1227   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
1228   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D", dim);
1229   ierr = PetscOptionsGetBool(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_view_draw_affine", &drawAffine, NULL);CHKERRQ(ierr);
1230   if (!drawAffine) {ierr = PetscMalloc2((edgeDiv+1)*dim, &refCoords, (edgeDiv+1)*dim, &edgeCoords);CHKERRQ(ierr);}
1231   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
1232   ierr = DMGetLocalSection(cdm, &coordSection);CHKERRQ(ierr);
1233   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1234   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
1235   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1236 
1237   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
1238   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
1239   if (isnull) PetscFunctionReturn(0);
1240   ierr = PetscDrawSetTitle(draw, "Mesh");CHKERRQ(ierr);
1241 
1242   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
1243   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
1244   for (c = 0; c < N; c += dim) {
1245     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
1246     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
1247   }
1248   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
1249   ierr = MPIU_Allreduce(&bound[0],xyl,2,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1250   ierr = MPIU_Allreduce(&bound[2],xyr,2,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1251   ierr = PetscDrawSetCoordinates(draw, xyl[0], xyl[1], xyr[0], xyr[1]);CHKERRQ(ierr);
1252   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
1253 
1254   for (c = cStart; c < cEnd; ++c) {
1255     PetscScalar *coords = NULL;
1256     PetscInt     numCoords;
1257 
1258     ierr = DMPlexVecGetClosureAtDepth_Internal(dm, coordSection, coordinates, c, 0, &numCoords, &coords);CHKERRQ(ierr);
1259     if (drawAffine) {
1260       ierr = DMPlexDrawCell(dm, draw, c, coords);CHKERRQ(ierr);
1261     } else {
1262       ierr = DMPlexDrawCellHighOrder(dm, draw, c, coords, edgeDiv, refCoords, edgeCoords);CHKERRQ(ierr);
1263     }
1264     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
1265   }
1266   if (!drawAffine) {ierr = PetscFree2(refCoords, edgeCoords);CHKERRQ(ierr);}
1267   ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
1268   ierr = PetscDrawPause(draw);CHKERRQ(ierr);
1269   ierr = PetscDrawSave(draw);CHKERRQ(ierr);
1270   PetscFunctionReturn(0);
1271 }
1272 
1273 #if defined(PETSC_HAVE_EXODUSII)
1274 #include <exodusII.h>
1275 #endif
1276 
DMView_Plex(DM dm,PetscViewer viewer)1277 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
1278 {
1279   PetscBool      iascii, ishdf5, isvtk, isdraw, flg, isglvis, isexodus;
1280   char           name[PETSC_MAX_PATH_LEN];
1281   PetscErrorCode ierr;
1282 
1283   PetscFunctionBegin;
1284   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1285   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1286   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII,    &iascii);CHKERRQ(ierr);
1287   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,      &isvtk);CHKERRQ(ierr);
1288   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,     &ishdf5);CHKERRQ(ierr);
1289   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,     &isdraw);CHKERRQ(ierr);
1290   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERGLVIS,    &isglvis);CHKERRQ(ierr);
1291   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWEREXODUSII, &isexodus);CHKERRQ(ierr);
1292   if (iascii) {
1293     PetscViewerFormat format;
1294     ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
1295     if (format == PETSC_VIEWER_ASCII_GLVIS) {
1296       ierr = DMPlexView_GLVis(dm, viewer);CHKERRQ(ierr);
1297     } else {
1298       ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
1299     }
1300   } else if (ishdf5) {
1301 #if defined(PETSC_HAVE_HDF5)
1302     ierr = DMPlexView_HDF5_Internal(dm, viewer);CHKERRQ(ierr);
1303 #else
1304     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
1305 #endif
1306   } else if (isvtk) {
1307     ierr = DMPlexVTKWriteAll((PetscObject) dm,viewer);CHKERRQ(ierr);
1308   } else if (isdraw) {
1309     ierr = DMPlexView_Draw(dm, viewer);CHKERRQ(ierr);
1310   } else if (isglvis) {
1311     ierr = DMPlexView_GLVis(dm, viewer);CHKERRQ(ierr);
1312 #if defined(PETSC_HAVE_EXODUSII)
1313   } else if (isexodus) {
1314     int exoid;
1315     PetscInt cStart, cEnd, c;
1316 
1317     ierr = DMCreateLabel(dm, "Cell Sets");CHKERRQ(ierr);
1318     ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1319     for (c = cStart; c < cEnd; ++c) {ierr = DMSetLabelValue(dm, "Cell Sets", c, 1);CHKERRQ(ierr);}
1320     ierr = PetscViewerExodusIIGetId(viewer, &exoid);CHKERRQ(ierr);
1321     ierr = DMPlexView_ExodusII_Internal(dm, exoid, 1);CHKERRQ(ierr);
1322 #endif
1323   } else {
1324     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Viewer type %s not yet supported for DMPlex writing", ((PetscObject)viewer)->type_name);
1325   }
1326   /* Optionally view the partition */
1327   ierr = PetscOptionsHasName(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_partition_view", &flg);CHKERRQ(ierr);
1328   if (flg) {
1329     Vec ranks;
1330     ierr = DMPlexCreateRankField(dm, &ranks);CHKERRQ(ierr);
1331     ierr = VecView(ranks, viewer);CHKERRQ(ierr);
1332     ierr = VecDestroy(&ranks);CHKERRQ(ierr);
1333   }
1334   /* Optionally view a label */
1335   ierr = PetscOptionsGetString(((PetscObject) dm)->options, ((PetscObject) dm)->prefix, "-dm_label_view", name, sizeof(name), &flg);CHKERRQ(ierr);
1336   if (flg) {
1337     DMLabel label;
1338     Vec     val;
1339 
1340     ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
1341     if (!label) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Label %s provided to -dm_label_view does not exist in this DM", name);
1342     ierr = DMPlexCreateLabelField(dm, label, &val);CHKERRQ(ierr);
1343     ierr = VecView(val, viewer);CHKERRQ(ierr);
1344     ierr = VecDestroy(&val);CHKERRQ(ierr);
1345   }
1346   PetscFunctionReturn(0);
1347 }
1348 
DMLoad_Plex(DM dm,PetscViewer viewer)1349 PetscErrorCode DMLoad_Plex(DM dm, PetscViewer viewer)
1350 {
1351   PetscBool      ishdf5;
1352   PetscErrorCode ierr;
1353 
1354   PetscFunctionBegin;
1355   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1356   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1357   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,   &ishdf5);CHKERRQ(ierr);
1358   if (ishdf5) {
1359 #if defined(PETSC_HAVE_HDF5)
1360     PetscViewerFormat format;
1361     ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
1362     if (format == PETSC_VIEWER_HDF5_XDMF || format == PETSC_VIEWER_HDF5_VIZ) {
1363       ierr = DMPlexLoad_HDF5_Xdmf_Internal(dm, viewer);CHKERRQ(ierr);
1364     } else if (format == PETSC_VIEWER_HDF5_PETSC || format == PETSC_VIEWER_DEFAULT || format == PETSC_VIEWER_NATIVE) {
1365       ierr = DMPlexLoad_HDF5_Internal(dm, viewer);CHKERRQ(ierr);
1366     } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "PetscViewerFormat %s not supported for HDF5 input.", PetscViewerFormats[format]);
1367 #else
1368     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
1369 #endif
1370   } else {
1371     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Viewer type %s not yet supported for DMPlex loading", ((PetscObject)viewer)->type_name);
1372   }
1373   PetscFunctionReturn(0);
1374 }
1375 
DMDestroy_Plex(DM dm)1376 PetscErrorCode DMDestroy_Plex(DM dm)
1377 {
1378   DM_Plex       *mesh = (DM_Plex*) dm->data;
1379   PetscErrorCode ierr;
1380 
1381   PetscFunctionBegin;
1382   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMSetUpGLVisViewer_C",NULL);CHKERRQ(ierr);
1383   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMPlexInsertBoundaryValues_C", NULL);CHKERRQ(ierr);
1384   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMCreateNeumannOverlap_C", NULL);CHKERRQ(ierr);
1385   if (--mesh->refct > 0) PetscFunctionReturn(0);
1386   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
1387   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
1388   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
1389   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
1390   ierr = PetscSectionDestroy(&mesh->subdomainSection);CHKERRQ(ierr);
1391   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
1392   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
1393   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
1394   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
1395   ierr = PetscPartitionerDestroy(&mesh->partitioner);CHKERRQ(ierr);
1396   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
1397   ierr = ISDestroy(&mesh->subpointIS);CHKERRQ(ierr);
1398   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
1399   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
1400   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
1401   ierr = ISDestroy(&mesh->anchorIS);CHKERRQ(ierr);
1402   ierr = PetscSectionDestroy(&mesh->parentSection);CHKERRQ(ierr);
1403   ierr = PetscFree(mesh->parents);CHKERRQ(ierr);
1404   ierr = PetscFree(mesh->childIDs);CHKERRQ(ierr);
1405   ierr = PetscSectionDestroy(&mesh->childSection);CHKERRQ(ierr);
1406   ierr = PetscFree(mesh->children);CHKERRQ(ierr);
1407   ierr = DMDestroy(&mesh->referenceTree);CHKERRQ(ierr);
1408   ierr = PetscGridHashDestroy(&mesh->lbox);CHKERRQ(ierr);
1409   ierr = PetscFree(mesh->neighbors);CHKERRQ(ierr);
1410   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
1411   ierr = PetscFree(mesh);CHKERRQ(ierr);
1412   PetscFunctionReturn(0);
1413 }
1414 
DMCreateMatrix_Plex(DM dm,Mat * J)1415 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
1416 {
1417   PetscSection           sectionGlobal;
1418   PetscInt               bs = -1, mbs;
1419   PetscInt               localSize;
1420   PetscBool              isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock, isMatIS;
1421   PetscErrorCode         ierr;
1422   MatType                mtype;
1423   ISLocalToGlobalMapping ltog;
1424 
1425   PetscFunctionBegin;
1426   ierr = MatInitializePackage();CHKERRQ(ierr);
1427   mtype = dm->mattype;
1428   ierr = DMGetGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
1429   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
1430   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
1431   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
1432   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
1433   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
1434   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
1435   ierr = MatGetBlockSize(*J, &mbs);CHKERRQ(ierr);
1436   if (mbs > 1) bs = mbs;
1437   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
1438   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
1439   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
1440   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
1441   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
1442   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
1443   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
1444   ierr = PetscStrcmp(mtype, MATIS, &isMatIS);CHKERRQ(ierr);
1445   if (!isShell) {
1446     PetscSection subSection;
1447     PetscBool    fillMatrix = (PetscBool)(!dm->prealloc_only && !isMatIS);
1448     PetscInt    *dnz, *onz, *dnzu, *onzu, bsLocal[2], bsMinMax[2], *ltogidx, lsize;
1449     PetscInt     pStart, pEnd, p, dof, cdof;
1450 
1451     /* Set localtoglobalmapping on the matrix for MatSetValuesLocal() to work (it also creates the local matrices in case of MATIS) */
1452     if (isMatIS) { /* need a different l2g map than the one computed by DMGetLocalToGlobalMapping */
1453       PetscSection section;
1454       PetscInt     size;
1455 
1456       ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
1457       ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
1458       ierr = PetscMalloc1(size,&ltogidx);CHKERRQ(ierr);
1459       ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);
1460     } else {
1461       ierr = DMGetLocalToGlobalMapping(dm,&ltog);CHKERRQ(ierr);
1462     }
1463     ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
1464     for (p = pStart, lsize = 0; p < pEnd; ++p) {
1465       PetscInt bdof;
1466 
1467       ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
1468       ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
1469       dof  = dof < 0 ? -(dof+1) : dof;
1470       bdof = cdof && (dof-cdof) ? 1 : dof;
1471       if (dof) {
1472         if (bs < 0)          {bs = bdof;}
1473         else if (bs != bdof) {bs = 1; if (!isMatIS) break;}
1474       }
1475       if (isMatIS) {
1476         PetscInt loff,c,off;
1477         ierr = PetscSectionGetOffset(subSection, p, &loff);CHKERRQ(ierr);
1478         ierr = PetscSectionGetOffset(sectionGlobal, p, &off);CHKERRQ(ierr);
1479         for (c = 0; c < dof-cdof; ++c, ++lsize) ltogidx[loff+c] = off > -1 ? off+c : -(off+1)+c;
1480       }
1481     }
1482     /* Must have same blocksize on all procs (some might have no points) */
1483     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
1484     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
1485     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
1486     else                            {bs = bsMinMax[0];}
1487     bs = PetscMax(1,bs);
1488     if (isMatIS) { /* Must reduce indices by blocksize */
1489       PetscInt l;
1490 
1491       lsize = lsize/bs;
1492       if (bs > 1) for (l = 0; l < lsize; ++l) ltogidx[l] = ltogidx[l*bs]/bs;
1493       ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)dm), bs, lsize, ltogidx, PETSC_OWN_POINTER, &ltog);CHKERRQ(ierr);
1494     }
1495     ierr = MatSetLocalToGlobalMapping(*J,ltog,ltog);CHKERRQ(ierr);
1496     if (isMatIS) {
1497       ierr = ISLocalToGlobalMappingDestroy(&ltog);CHKERRQ(ierr);
1498     }
1499     ierr = PetscCalloc4(localSize/bs, &dnz, localSize/bs, &onz, localSize/bs, &dnzu, localSize/bs, &onzu);CHKERRQ(ierr);
1500     ierr = DMPlexPreallocateOperator(dm, bs, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
1501     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
1502   }
1503   ierr = MatSetDM(*J, dm);CHKERRQ(ierr);
1504   PetscFunctionReturn(0);
1505 }
1506 
1507 /*@
1508   DMPlexGetSubdomainSection - Returns the section associated with the subdomain
1509 
1510   Not collective
1511 
1512   Input Parameter:
1513 . mesh - The DMPlex
1514 
1515   Output Parameters:
1516 . subsection - The subdomain section
1517 
1518   Level: developer
1519 
1520 .seealso:
1521 @*/
DMPlexGetSubdomainSection(DM dm,PetscSection * subsection)1522 PetscErrorCode DMPlexGetSubdomainSection(DM dm, PetscSection *subsection)
1523 {
1524   DM_Plex       *mesh = (DM_Plex*) dm->data;
1525   PetscErrorCode ierr;
1526 
1527   PetscFunctionBegin;
1528   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1529   if (!mesh->subdomainSection) {
1530     PetscSection section;
1531     PetscSF      sf;
1532 
1533     ierr = PetscSFCreate(PETSC_COMM_SELF,&sf);CHKERRQ(ierr);
1534     ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1535     ierr = PetscSectionCreateGlobalSection(section,sf,PETSC_FALSE,PETSC_TRUE,&mesh->subdomainSection);CHKERRQ(ierr);
1536     ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1537   }
1538   *subsection = mesh->subdomainSection;
1539   PetscFunctionReturn(0);
1540 }
1541 
1542 /*@
1543   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
1544 
1545   Not collective
1546 
1547   Input Parameter:
1548 . mesh - The DMPlex
1549 
1550   Output Parameters:
1551 + pStart - The first mesh point
1552 - pEnd   - The upper bound for mesh points
1553 
1554   Level: beginner
1555 
1556 .seealso: DMPlexCreate(), DMPlexSetChart()
1557 @*/
DMPlexGetChart(DM dm,PetscInt * pStart,PetscInt * pEnd)1558 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
1559 {
1560   DM_Plex       *mesh = (DM_Plex*) dm->data;
1561   PetscErrorCode ierr;
1562 
1563   PetscFunctionBegin;
1564   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1565   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1566   PetscFunctionReturn(0);
1567 }
1568 
1569 /*@
1570   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
1571 
1572   Not collective
1573 
1574   Input Parameters:
1575 + mesh - The DMPlex
1576 . pStart - The first mesh point
1577 - pEnd   - The upper bound for mesh points
1578 
1579   Output Parameters:
1580 
1581   Level: beginner
1582 
1583 .seealso: DMPlexCreate(), DMPlexGetChart()
1584 @*/
DMPlexSetChart(DM dm,PetscInt pStart,PetscInt pEnd)1585 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
1586 {
1587   DM_Plex       *mesh = (DM_Plex*) dm->data;
1588   PetscErrorCode ierr;
1589 
1590   PetscFunctionBegin;
1591   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1592   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1593   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
1594   PetscFunctionReturn(0);
1595 }
1596 
1597 /*@
1598   DMPlexGetConeSize - Return the number of in-edges for this point in the DAG
1599 
1600   Not collective
1601 
1602   Input Parameters:
1603 + mesh - The DMPlex
1604 - p - The point, which must lie in the chart set with DMPlexSetChart()
1605 
1606   Output Parameter:
1607 . size - The cone size for point p
1608 
1609   Level: beginner
1610 
1611 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1612 @*/
DMPlexGetConeSize(DM dm,PetscInt p,PetscInt * size)1613 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
1614 {
1615   DM_Plex       *mesh = (DM_Plex*) dm->data;
1616   PetscErrorCode ierr;
1617 
1618   PetscFunctionBegin;
1619   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1620   PetscValidPointer(size, 3);
1621   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1622   PetscFunctionReturn(0);
1623 }
1624 
1625 /*@
1626   DMPlexSetConeSize - Set the number of in-edges for this point in the DAG
1627 
1628   Not collective
1629 
1630   Input Parameters:
1631 + mesh - The DMPlex
1632 . p - The point, which must lie in the chart set with DMPlexSetChart()
1633 - size - The cone size for point p
1634 
1635   Output Parameter:
1636 
1637   Note:
1638   This should be called after DMPlexSetChart().
1639 
1640   Level: beginner
1641 
1642 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
1643 @*/
DMPlexSetConeSize(DM dm,PetscInt p,PetscInt size)1644 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
1645 {
1646   DM_Plex       *mesh = (DM_Plex*) dm->data;
1647   PetscErrorCode ierr;
1648 
1649   PetscFunctionBegin;
1650   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1651   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1652 
1653   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
1654   PetscFunctionReturn(0);
1655 }
1656 
1657 /*@
1658   DMPlexAddConeSize - Add the given number of in-edges to this point in the DAG
1659 
1660   Not collective
1661 
1662   Input Parameters:
1663 + mesh - The DMPlex
1664 . p - The point, which must lie in the chart set with DMPlexSetChart()
1665 - size - The additional cone size for point p
1666 
1667   Output Parameter:
1668 
1669   Note:
1670   This should be called after DMPlexSetChart().
1671 
1672   Level: beginner
1673 
1674 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexGetConeSize(), DMPlexSetChart()
1675 @*/
DMPlexAddConeSize(DM dm,PetscInt p,PetscInt size)1676 PetscErrorCode DMPlexAddConeSize(DM dm, PetscInt p, PetscInt size)
1677 {
1678   DM_Plex       *mesh = (DM_Plex*) dm->data;
1679   PetscInt       csize;
1680   PetscErrorCode ierr;
1681 
1682   PetscFunctionBegin;
1683   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1684   ierr = PetscSectionAddDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1685   ierr = PetscSectionGetDof(mesh->coneSection, p, &csize);CHKERRQ(ierr);
1686 
1687   mesh->maxConeSize = PetscMax(mesh->maxConeSize, csize);
1688   PetscFunctionReturn(0);
1689 }
1690 
1691 /*@C
1692   DMPlexGetCone - Return the points on the in-edges for this point in the DAG
1693 
1694   Not collective
1695 
1696   Input Parameters:
1697 + dm - The DMPlex
1698 - p - The point, which must lie in the chart set with DMPlexSetChart()
1699 
1700   Output Parameter:
1701 . cone - An array of points which are on the in-edges for point p
1702 
1703   Level: beginner
1704 
1705   Fortran Notes:
1706   Since it returns an array, this routine is only available in Fortran 90, and you must
1707   include petsc.h90 in your code.
1708   You must also call DMPlexRestoreCone() after you finish using the returned array.
1709   DMPlexRestoreCone() is not needed/available in C.
1710 
1711 .seealso: DMPlexGetConeSize(), DMPlexSetCone(), DMPlexGetConeTuple(), DMPlexSetChart()
1712 @*/
DMPlexGetCone(DM dm,PetscInt p,const PetscInt * cone[])1713 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
1714 {
1715   DM_Plex       *mesh = (DM_Plex*) dm->data;
1716   PetscInt       off;
1717   PetscErrorCode ierr;
1718 
1719   PetscFunctionBegin;
1720   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1721   PetscValidPointer(cone, 3);
1722   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1723   *cone = &mesh->cones[off];
1724   PetscFunctionReturn(0);
1725 }
1726 
1727 /*@C
1728   DMPlexGetConeTuple - Return the points on the in-edges of several points in the DAG
1729 
1730   Not collective
1731 
1732   Input Parameters:
1733 + dm - The DMPlex
1734 - p - The IS of points, which must lie in the chart set with DMPlexSetChart()
1735 
1736   Output Parameter:
1737 + pConesSection - PetscSection describing the layout of pCones
1738 - pCones - An array of points which are on the in-edges for the point set p
1739 
1740   Level: intermediate
1741 
1742 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeRecursive(), DMPlexSetChart()
1743 @*/
DMPlexGetConeTuple(DM dm,IS p,PetscSection * pConesSection,IS * pCones)1744 PetscErrorCode DMPlexGetConeTuple(DM dm, IS p, PetscSection *pConesSection, IS *pCones)
1745 {
1746   PetscSection        cs, newcs;
1747   PetscInt            *cones;
1748   PetscInt            *newarr=NULL;
1749   PetscInt            n;
1750   PetscErrorCode      ierr;
1751 
1752   PetscFunctionBegin;
1753   ierr = DMPlexGetCones(dm, &cones);CHKERRQ(ierr);
1754   ierr = DMPlexGetConeSection(dm, &cs);CHKERRQ(ierr);
1755   ierr = PetscSectionExtractDofsFromArray(cs, MPIU_INT, cones, p, &newcs, pCones ? ((void**)&newarr) : NULL);CHKERRQ(ierr);
1756   if (pConesSection) *pConesSection = newcs;
1757   if (pCones) {
1758     ierr = PetscSectionGetStorageSize(newcs, &n);CHKERRQ(ierr);
1759     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)p), n, newarr, PETSC_OWN_POINTER, pCones);CHKERRQ(ierr);
1760   }
1761   PetscFunctionReturn(0);
1762 }
1763 
1764 /*@
1765   DMPlexGetConeRecursiveVertices - Expand each given point into its cone points and do that recursively until we end up just with vertices.
1766 
1767   Not collective
1768 
1769   Input Parameters:
1770 + dm - The DMPlex
1771 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1772 
1773   Output Parameter:
1774 . expandedPoints - An array of vertices recursively expanded from input points
1775 
1776   Level: advanced
1777 
1778   Notes:
1779   Like DMPlexGetConeRecursive but returns only the 0-depth IS (i.e. vertices only) and no sections.
1780   There is no corresponding Restore function, just call ISDestroy() on the returned IS to deallocate.
1781 
1782 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexGetConeRecursive(), DMPlexRestoreConeRecursive(), DMPlexGetDepth()
1783 @*/
DMPlexGetConeRecursiveVertices(DM dm,IS points,IS * expandedPoints)1784 PetscErrorCode DMPlexGetConeRecursiveVertices(DM dm, IS points, IS *expandedPoints)
1785 {
1786   IS                  *expandedPointsAll;
1787   PetscInt            depth;
1788   PetscErrorCode      ierr;
1789 
1790   PetscFunctionBegin;
1791   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1792   PetscValidHeaderSpecific(points, IS_CLASSID, 2);
1793   PetscValidPointer(expandedPoints, 3);
1794   ierr = DMPlexGetConeRecursive(dm, points, &depth, &expandedPointsAll, NULL);CHKERRQ(ierr);
1795   *expandedPoints = expandedPointsAll[0];
1796   ierr = PetscObjectReference((PetscObject)expandedPointsAll[0]);
1797   ierr = DMPlexRestoreConeRecursive(dm, points, &depth, &expandedPointsAll, NULL);CHKERRQ(ierr);
1798   PetscFunctionReturn(0);
1799 }
1800 
1801 /*@
1802   DMPlexGetConeRecursive - Expand each given point into its cone points and do that recursively until we end up just with vertices (DAG points of depth 0, i.e. without cones).
1803 
1804   Not collective
1805 
1806   Input Parameters:
1807 + dm - The DMPlex
1808 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1809 
1810   Output Parameter:
1811 + depth - (optional) Size of the output arrays, equal to DMPlex depth, returned by DMPlexGetDepth()
1812 . expandedPoints - (optional) An array of index sets with recursively expanded cones
1813 - sections - (optional) An array of sections which describe mappings from points to their cone points
1814 
1815   Level: advanced
1816 
1817   Notes:
1818   Like DMPlexGetConeTuple() but recursive.
1819 
1820   Array expandedPoints has size equal to depth. Each expandedPoints[d] contains DAG points with maximum depth d, recursively cone-wise expanded from the input points.
1821   For example, for d=0 it contains only vertices, for d=1 it can contain vertices and edges, etc.
1822 
1823   Array section has size equal to depth.  Each PetscSection sections[d] realizes mapping from expandedPoints[d+1] (section points) to expandedPoints[d] (section dofs) as follows:
1824   (1) DAG points in expandedPoints[d+1] with depth d+1 to their cone points in expandedPoints[d];
1825   (2) DAG points in expandedPoints[d+1] with depth in [0,d] to the same points in expandedPoints[d].
1826 
1827 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexRestoreConeRecursive(), DMPlexGetConeRecursiveVertices(), DMPlexGetDepth()
1828 @*/
DMPlexGetConeRecursive(DM dm,IS points,PetscInt * depth,IS * expandedPoints[],PetscSection * sections[])1829 PetscErrorCode DMPlexGetConeRecursive(DM dm, IS points, PetscInt *depth, IS *expandedPoints[], PetscSection *sections[])
1830 {
1831   const PetscInt      *arr0=NULL, *cone=NULL;
1832   PetscInt            *arr=NULL, *newarr=NULL;
1833   PetscInt            d, depth_, i, n, newn, cn, co, start, end;
1834   IS                  *expandedPoints_;
1835   PetscSection        *sections_;
1836   PetscErrorCode      ierr;
1837 
1838   PetscFunctionBegin;
1839   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1840   PetscValidHeaderSpecific(points, IS_CLASSID, 2);
1841   if (depth) PetscValidIntPointer(depth, 3);
1842   if (expandedPoints) PetscValidPointer(expandedPoints, 4);
1843   if (sections) PetscValidPointer(sections, 5);
1844   ierr = ISGetLocalSize(points, &n);CHKERRQ(ierr);
1845   ierr = ISGetIndices(points, &arr0);CHKERRQ(ierr);
1846   ierr = DMPlexGetDepth(dm, &depth_);CHKERRQ(ierr);
1847   ierr = PetscCalloc1(depth_, &expandedPoints_);CHKERRQ(ierr);
1848   ierr = PetscCalloc1(depth_, &sections_);CHKERRQ(ierr);
1849   arr = (PetscInt*) arr0; /* this is ok because first generation of arr is not modified */
1850   for (d=depth_-1; d>=0; d--) {
1851     ierr = PetscSectionCreate(PETSC_COMM_SELF, &sections_[d]);CHKERRQ(ierr);
1852     ierr = PetscSectionSetChart(sections_[d], 0, n);CHKERRQ(ierr);
1853     for (i=0; i<n; i++) {
1854       ierr = DMPlexGetDepthStratum(dm, d+1, &start, &end);CHKERRQ(ierr);
1855       if (arr[i] >= start && arr[i] < end) {
1856         ierr = DMPlexGetConeSize(dm, arr[i], &cn);CHKERRQ(ierr);
1857         ierr = PetscSectionSetDof(sections_[d], i, cn);CHKERRQ(ierr);
1858       } else {
1859         ierr = PetscSectionSetDof(sections_[d], i, 1);CHKERRQ(ierr);
1860       }
1861     }
1862     ierr = PetscSectionSetUp(sections_[d]);CHKERRQ(ierr);
1863     ierr = PetscSectionGetStorageSize(sections_[d], &newn);CHKERRQ(ierr);
1864     ierr = PetscMalloc1(newn, &newarr);CHKERRQ(ierr);
1865     for (i=0; i<n; i++) {
1866       ierr = PetscSectionGetDof(sections_[d], i, &cn);CHKERRQ(ierr);
1867       ierr = PetscSectionGetOffset(sections_[d], i, &co);CHKERRQ(ierr);
1868       if (cn > 1) {
1869         ierr = DMPlexGetCone(dm, arr[i], &cone);CHKERRQ(ierr);
1870         ierr = PetscMemcpy(&newarr[co], cone, cn*sizeof(PetscInt));CHKERRQ(ierr);
1871       } else {
1872         newarr[co] = arr[i];
1873       }
1874     }
1875     ierr = ISCreateGeneral(PETSC_COMM_SELF, newn, newarr, PETSC_OWN_POINTER, &expandedPoints_[d]);CHKERRQ(ierr);
1876     arr = newarr;
1877     n = newn;
1878   }
1879   ierr = ISRestoreIndices(points, &arr0);CHKERRQ(ierr);
1880   *depth = depth_;
1881   if (expandedPoints) *expandedPoints = expandedPoints_;
1882   else {
1883     for (d=0; d<depth_; d++) {ierr = ISDestroy(&expandedPoints_[d]);CHKERRQ(ierr);}
1884     ierr = PetscFree(expandedPoints_);CHKERRQ(ierr);
1885   }
1886   if (sections) *sections = sections_;
1887   else {
1888     for (d=0; d<depth_; d++) {ierr = PetscSectionDestroy(&sections_[d]);CHKERRQ(ierr);}
1889     ierr = PetscFree(sections_);CHKERRQ(ierr);
1890   }
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 /*@
1895   DMPlexRestoreConeRecursive - Deallocates arrays created by DMPlexGetConeRecursive
1896 
1897   Not collective
1898 
1899   Input Parameters:
1900 + dm - The DMPlex
1901 - points - The IS of points, which must lie in the chart set with DMPlexSetChart()
1902 
1903   Output Parameter:
1904 + depth - (optional) Size of the output arrays, equal to DMPlex depth, returned by DMPlexGetDepth()
1905 . expandedPoints - (optional) An array of recursively expanded cones
1906 - sections - (optional) An array of sections which describe mappings from points to their cone points
1907 
1908   Level: advanced
1909 
1910   Notes:
1911   See DMPlexGetConeRecursive() for details.
1912 
1913 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexGetConeTuple(), DMPlexGetConeRecursive(), DMPlexGetConeRecursiveVertices(), DMPlexGetDepth()
1914 @*/
DMPlexRestoreConeRecursive(DM dm,IS points,PetscInt * depth,IS * expandedPoints[],PetscSection * sections[])1915 PetscErrorCode DMPlexRestoreConeRecursive(DM dm, IS points, PetscInt *depth, IS *expandedPoints[], PetscSection *sections[])
1916 {
1917   PetscInt            d, depth_;
1918   PetscErrorCode      ierr;
1919 
1920   PetscFunctionBegin;
1921   ierr = DMPlexGetDepth(dm, &depth_);CHKERRQ(ierr);
1922   if (depth && *depth != depth_) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "depth changed since last call to DMPlexGetConeRecursive");
1923   if (depth) *depth = 0;
1924   if (expandedPoints) {
1925     for (d=0; d<depth_; d++) {ierr = ISDestroy(&((*expandedPoints)[d]));CHKERRQ(ierr);}
1926     ierr = PetscFree(*expandedPoints);CHKERRQ(ierr);
1927   }
1928   if (sections)  {
1929     for (d=0; d<depth_; d++) {ierr = PetscSectionDestroy(&((*sections)[d]));CHKERRQ(ierr);}
1930     ierr = PetscFree(*sections);CHKERRQ(ierr);
1931   }
1932   PetscFunctionReturn(0);
1933 }
1934 
1935 /*@
1936   DMPlexSetCone - Set the points on the in-edges for this point in the DAG; that is these are the points that cover the specific point
1937 
1938   Not collective
1939 
1940   Input Parameters:
1941 + mesh - The DMPlex
1942 . p - The point, which must lie in the chart set with DMPlexSetChart()
1943 - cone - An array of points which are on the in-edges for point p
1944 
1945   Output Parameter:
1946 
1947   Note:
1948   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1949 
1950   Developer Note: Why not call this DMPlexSetCover()
1951 
1952   Level: beginner
1953 
1954 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp(), DMPlexSetSupport(), DMPlexSetSupportSize()
1955 @*/
DMPlexSetCone(DM dm,PetscInt p,const PetscInt cone[])1956 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
1957 {
1958   DM_Plex       *mesh = (DM_Plex*) dm->data;
1959   PetscInt       pStart, pEnd;
1960   PetscInt       dof, off, c;
1961   PetscErrorCode ierr;
1962 
1963   PetscFunctionBegin;
1964   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1965   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1966   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1967   if (dof) PetscValidPointer(cone, 3);
1968   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1969   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);
1970   for (c = 0; c < dof; ++c) {
1971     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);
1972     mesh->cones[off+c] = cone[c];
1973   }
1974   PetscFunctionReturn(0);
1975 }
1976 
1977 /*@C
1978   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the DAG
1979 
1980   Not collective
1981 
1982   Input Parameters:
1983 + mesh - The DMPlex
1984 - p - The point, which must lie in the chart set with DMPlexSetChart()
1985 
1986   Output Parameter:
1987 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1988                     integer giving the prescription for cone traversal. If it is negative, the cone is
1989                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1990                     the index of the cone point on which to start.
1991 
1992   Level: beginner
1993 
1994   Fortran Notes:
1995   Since it returns an array, this routine is only available in Fortran 90, and you must
1996   include petsc.h90 in your code.
1997   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
1998   DMPlexRestoreConeOrientation() is not needed/available in C.
1999 
2000 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
2001 @*/
DMPlexGetConeOrientation(DM dm,PetscInt p,const PetscInt * coneOrientation[])2002 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
2003 {
2004   DM_Plex       *mesh = (DM_Plex*) dm->data;
2005   PetscInt       off;
2006   PetscErrorCode ierr;
2007 
2008   PetscFunctionBegin;
2009   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2010   if (PetscDefined(USE_DEBUG)) {
2011     PetscInt dof;
2012     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2013     if (dof) PetscValidPointer(coneOrientation, 3);
2014   }
2015   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2016 
2017   *coneOrientation = &mesh->coneOrientations[off];
2018   PetscFunctionReturn(0);
2019 }
2020 
2021 /*@
2022   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the DAG
2023 
2024   Not collective
2025 
2026   Input Parameters:
2027 + mesh - The DMPlex
2028 . p - The point, which must lie in the chart set with DMPlexSetChart()
2029 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
2030                     integer giving the prescription for cone traversal. If it is negative, the cone is
2031                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
2032                     the index of the cone point on which to start.
2033 
2034   Output Parameter:
2035 
2036   Note:
2037   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
2038 
2039   Level: beginner
2040 
2041 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2042 @*/
DMPlexSetConeOrientation(DM dm,PetscInt p,const PetscInt coneOrientation[])2043 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
2044 {
2045   DM_Plex       *mesh = (DM_Plex*) dm->data;
2046   PetscInt       pStart, pEnd;
2047   PetscInt       dof, off, c;
2048   PetscErrorCode ierr;
2049 
2050   PetscFunctionBegin;
2051   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2052   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2053   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2054   if (dof) PetscValidPointer(coneOrientation, 3);
2055   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2056   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);
2057   for (c = 0; c < dof; ++c) {
2058     PetscInt cdof, o = coneOrientation[c];
2059 
2060     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
2061     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);
2062     mesh->coneOrientations[off+c] = o;
2063   }
2064   PetscFunctionReturn(0);
2065 }
2066 
2067 /*@
2068   DMPlexInsertCone - Insert a point into the in-edges for the point p in the DAG
2069 
2070   Not collective
2071 
2072   Input Parameters:
2073 + mesh - The DMPlex
2074 . p - The point, which must lie in the chart set with DMPlexSetChart()
2075 . conePos - The local index in the cone where the point should be put
2076 - conePoint - The mesh point to insert
2077 
2078   Level: beginner
2079 
2080 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2081 @*/
DMPlexInsertCone(DM dm,PetscInt p,PetscInt conePos,PetscInt conePoint)2082 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
2083 {
2084   DM_Plex       *mesh = (DM_Plex*) dm->data;
2085   PetscInt       pStart, pEnd;
2086   PetscInt       dof, off;
2087   PetscErrorCode ierr;
2088 
2089   PetscFunctionBegin;
2090   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2091   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2092   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);
2093   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);
2094   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2095   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2096   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);
2097   mesh->cones[off+conePos] = conePoint;
2098   PetscFunctionReturn(0);
2099 }
2100 
2101 /*@
2102   DMPlexInsertConeOrientation - Insert a point orientation for the in-edge for the point p in the DAG
2103 
2104   Not collective
2105 
2106   Input Parameters:
2107 + mesh - The DMPlex
2108 . p - The point, which must lie in the chart set with DMPlexSetChart()
2109 . conePos - The local index in the cone where the point should be put
2110 - coneOrientation - The point orientation to insert
2111 
2112   Level: beginner
2113 
2114 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2115 @*/
DMPlexInsertConeOrientation(DM dm,PetscInt p,PetscInt conePos,PetscInt coneOrientation)2116 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
2117 {
2118   DM_Plex       *mesh = (DM_Plex*) dm->data;
2119   PetscInt       pStart, pEnd;
2120   PetscInt       dof, off;
2121   PetscErrorCode ierr;
2122 
2123   PetscFunctionBegin;
2124   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2125   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
2126   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);
2127   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2128   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2129   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);
2130   mesh->coneOrientations[off+conePos] = coneOrientation;
2131   PetscFunctionReturn(0);
2132 }
2133 
2134 /*@
2135   DMPlexGetSupportSize - Return the number of out-edges for this point in the DAG
2136 
2137   Not collective
2138 
2139   Input Parameters:
2140 + mesh - The DMPlex
2141 - p - The point, which must lie in the chart set with DMPlexSetChart()
2142 
2143   Output Parameter:
2144 . size - The support size for point p
2145 
2146   Level: beginner
2147 
2148 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
2149 @*/
DMPlexGetSupportSize(DM dm,PetscInt p,PetscInt * size)2150 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
2151 {
2152   DM_Plex       *mesh = (DM_Plex*) dm->data;
2153   PetscErrorCode ierr;
2154 
2155   PetscFunctionBegin;
2156   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2157   PetscValidPointer(size, 3);
2158   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 /*@
2163   DMPlexSetSupportSize - Set the number of out-edges for this point in the DAG
2164 
2165   Not collective
2166 
2167   Input Parameters:
2168 + mesh - The DMPlex
2169 . p - The point, which must lie in the chart set with DMPlexSetChart()
2170 - size - The support size for point p
2171 
2172   Output Parameter:
2173 
2174   Note:
2175   This should be called after DMPlexSetChart().
2176 
2177   Level: beginner
2178 
2179 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
2180 @*/
DMPlexSetSupportSize(DM dm,PetscInt p,PetscInt size)2181 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
2182 {
2183   DM_Plex       *mesh = (DM_Plex*) dm->data;
2184   PetscErrorCode ierr;
2185 
2186   PetscFunctionBegin;
2187   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2188   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
2189 
2190   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
2191   PetscFunctionReturn(0);
2192 }
2193 
2194 /*@C
2195   DMPlexGetSupport - Return the points on the out-edges for this point in the DAG
2196 
2197   Not collective
2198 
2199   Input Parameters:
2200 + mesh - The DMPlex
2201 - p - The point, which must lie in the chart set with DMPlexSetChart()
2202 
2203   Output Parameter:
2204 . support - An array of points which are on the out-edges for point p
2205 
2206   Level: beginner
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   You must also call DMPlexRestoreSupport() after you finish using the returned array.
2212   DMPlexRestoreSupport() is not needed/available in C.
2213 
2214 .seealso: DMPlexGetSupportSize(), DMPlexSetSupport(), DMPlexGetCone(), DMPlexSetChart()
2215 @*/
DMPlexGetSupport(DM dm,PetscInt p,const PetscInt * support[])2216 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
2217 {
2218   DM_Plex       *mesh = (DM_Plex*) dm->data;
2219   PetscInt       off;
2220   PetscErrorCode ierr;
2221 
2222   PetscFunctionBegin;
2223   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2224   PetscValidPointer(support, 3);
2225   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2226   *support = &mesh->supports[off];
2227   PetscFunctionReturn(0);
2228 }
2229 
2230 /*@
2231   DMPlexSetSupport - Set the points on the out-edges for this point in the DAG, that is the list of points that this point covers
2232 
2233   Not collective
2234 
2235   Input Parameters:
2236 + mesh - The DMPlex
2237 . p - The point, which must lie in the chart set with DMPlexSetChart()
2238 - support - An array of points which are on the out-edges for point p
2239 
2240   Output Parameter:
2241 
2242   Note:
2243   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
2244 
2245   Level: beginner
2246 
2247 .seealso: DMPlexSetCone(), DMPlexSetConeSize(), DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
2248 @*/
DMPlexSetSupport(DM dm,PetscInt p,const PetscInt support[])2249 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
2250 {
2251   DM_Plex       *mesh = (DM_Plex*) dm->data;
2252   PetscInt       pStart, pEnd;
2253   PetscInt       dof, off, c;
2254   PetscErrorCode ierr;
2255 
2256   PetscFunctionBegin;
2257   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2258   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
2259   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2260   if (dof) PetscValidPointer(support, 3);
2261   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2262   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);
2263   for (c = 0; c < dof; ++c) {
2264     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);
2265     mesh->supports[off+c] = support[c];
2266   }
2267   PetscFunctionReturn(0);
2268 }
2269 
2270 /*@
2271   DMPlexInsertSupport - Insert a point into the out-edges for the point p in the DAG
2272 
2273   Not collective
2274 
2275   Input Parameters:
2276 + mesh - The DMPlex
2277 . p - The point, which must lie in the chart set with DMPlexSetChart()
2278 . supportPos - The local index in the cone where the point should be put
2279 - supportPoint - The mesh point to insert
2280 
2281   Level: beginner
2282 
2283 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
2284 @*/
DMPlexInsertSupport(DM dm,PetscInt p,PetscInt supportPos,PetscInt supportPoint)2285 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
2286 {
2287   DM_Plex       *mesh = (DM_Plex*) dm->data;
2288   PetscInt       pStart, pEnd;
2289   PetscInt       dof, off;
2290   PetscErrorCode ierr;
2291 
2292   PetscFunctionBegin;
2293   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2294   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
2295   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2296   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
2297   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);
2298   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);
2299   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);
2300   mesh->supports[off+supportPos] = supportPoint;
2301   PetscFunctionReturn(0);
2302 }
2303 
2304 /*@C
2305   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the DAG
2306 
2307   Not collective
2308 
2309   Input Parameters:
2310 + mesh - The DMPlex
2311 . p - The point, which must lie in the chart set with DMPlexSetChart()
2312 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2313 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
2314 
2315   Output Parameters:
2316 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
2317 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
2318 
2319   Note:
2320   If using internal storage (points is NULL on input), each call overwrites the last output.
2321 
2322   Fortran Notes:
2323   Since it returns an array, this routine is only available in Fortran 90, and you must
2324   include petsc.h90 in your code.
2325 
2326   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2327 
2328   Level: beginner
2329 
2330 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2331 @*/
DMPlexGetTransitiveClosure(DM dm,PetscInt p,PetscBool useCone,PetscInt * numPoints,PetscInt * points[])2332 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2333 {
2334   DM_Plex        *mesh = (DM_Plex*) dm->data;
2335   PetscInt       *closure, *fifo;
2336   const PetscInt *tmp = NULL, *tmpO = NULL;
2337   PetscInt        tmpSize, t;
2338   PetscInt        depth       = 0, maxSize;
2339   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
2340   PetscErrorCode  ierr;
2341 
2342   PetscFunctionBegin;
2343   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2344   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2345   /* This is only 1-level */
2346   if (useCone) {
2347     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
2348     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
2349     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
2350   } else {
2351     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
2352     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
2353   }
2354   if (depth == 1) {
2355     if (*points) {
2356       closure = *points;
2357     } else {
2358       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
2359       ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2360     }
2361     closure[0] = p; closure[1] = 0;
2362     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
2363       closure[closureSize]   = tmp[t];
2364       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
2365     }
2366     if (numPoints) *numPoints = closureSize/2;
2367     if (points)    *points    = closure;
2368     PetscFunctionReturn(0);
2369   }
2370   {
2371     PetscInt c, coneSeries, s,supportSeries;
2372 
2373     c = mesh->maxConeSize;
2374     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
2375     s = mesh->maxSupportSize;
2376     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
2377     maxSize = 2*PetscMax(coneSeries,supportSeries);
2378   }
2379   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2380   if (*points) {
2381     closure = *points;
2382   } else {
2383     ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2384   }
2385   closure[0] = p; closure[1] = 0;
2386   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
2387     const PetscInt cp = tmp[t];
2388     const PetscInt co = tmpO ? tmpO[t] : 0;
2389 
2390     closure[closureSize]   = cp;
2391     closure[closureSize+1] = co;
2392     fifo[fifoSize]         = cp;
2393     fifo[fifoSize+1]       = co;
2394   }
2395   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
2396   while (fifoSize - fifoStart) {
2397     const PetscInt q   = fifo[fifoStart];
2398     const PetscInt o   = fifo[fifoStart+1];
2399     const PetscInt rev = o >= 0 ? 0 : 1;
2400     const PetscInt off = rev ? -(o+1) : o;
2401 
2402     if (useCone) {
2403       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
2404       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
2405       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
2406     } else {
2407       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
2408       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
2409       tmpO = NULL;
2410     }
2411     for (t = 0; t < tmpSize; ++t) {
2412       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
2413       const PetscInt cp = tmp[i];
2414       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
2415       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
2416        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
2417       PetscInt       co = tmpO ? tmpO[i] : 0;
2418       PetscInt       c;
2419 
2420       if (rev) {
2421         PetscInt childSize, coff;
2422         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2423         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
2424         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2425       }
2426       /* Check for duplicate */
2427       for (c = 0; c < closureSize; c += 2) {
2428         if (closure[c] == cp) break;
2429       }
2430       if (c == closureSize) {
2431         closure[closureSize]   = cp;
2432         closure[closureSize+1] = co;
2433         fifo[fifoSize]         = cp;
2434         fifo[fifoSize+1]       = co;
2435         closureSize           += 2;
2436         fifoSize              += 2;
2437       }
2438     }
2439     fifoStart += 2;
2440   }
2441   if (numPoints) *numPoints = closureSize/2;
2442   if (points)    *points    = closure;
2443   ierr = DMRestoreWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2444   PetscFunctionReturn(0);
2445 }
2446 
2447 /*@C
2448   DMPlexGetTransitiveClosure_Internal - Return the points on the transitive closure of the in-edges or out-edges for this point in the DAG with a specified initial orientation
2449 
2450   Not collective
2451 
2452   Input Parameters:
2453 + mesh - The DMPlex
2454 . p - The point, which must lie in the chart set with DMPlexSetChart()
2455 . orientation - The orientation of the point
2456 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2457 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
2458 
2459   Output Parameters:
2460 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
2461 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
2462 
2463   Note:
2464   If using internal storage (points is NULL on input), each call overwrites the last output.
2465 
2466   Fortran Notes:
2467   Since it returns an array, this routine is only available in Fortran 90, and you must
2468   include petsc.h90 in your code.
2469 
2470   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2471 
2472   Level: beginner
2473 
2474 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2475 @*/
DMPlexGetTransitiveClosure_Internal(DM dm,PetscInt p,PetscInt ornt,PetscBool useCone,PetscInt * numPoints,PetscInt * points[])2476 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM dm, PetscInt p, PetscInt ornt, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2477 {
2478   DM_Plex        *mesh = (DM_Plex*) dm->data;
2479   PetscInt       *closure, *fifo;
2480   const PetscInt *tmp = NULL, *tmpO = NULL;
2481   PetscInt        tmpSize, t;
2482   PetscInt        depth       = 0, maxSize;
2483   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
2484   PetscErrorCode  ierr;
2485 
2486   PetscFunctionBegin;
2487   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2488   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2489   /* This is only 1-level */
2490   if (useCone) {
2491     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
2492     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
2493     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
2494   } else {
2495     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
2496     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
2497   }
2498   if (depth == 1) {
2499     if (*points) {
2500       closure = *points;
2501     } else {
2502       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
2503       ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2504     }
2505     closure[0] = p; closure[1] = ornt;
2506     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
2507       const PetscInt i = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
2508       closure[closureSize]   = tmp[i];
2509       closure[closureSize+1] = tmpO ? tmpO[i] : 0;
2510     }
2511     if (numPoints) *numPoints = closureSize/2;
2512     if (points)    *points    = closure;
2513     PetscFunctionReturn(0);
2514   }
2515   {
2516     PetscInt c, coneSeries, s,supportSeries;
2517 
2518     c = mesh->maxConeSize;
2519     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
2520     s = mesh->maxSupportSize;
2521     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
2522     maxSize = 2*PetscMax(coneSeries,supportSeries);
2523   }
2524   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2525   if (*points) {
2526     closure = *points;
2527   } else {
2528     ierr = DMGetWorkArray(dm, maxSize, MPIU_INT, &closure);CHKERRQ(ierr);
2529   }
2530   closure[0] = p; closure[1] = ornt;
2531   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
2532     const PetscInt i  = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
2533     const PetscInt cp = tmp[i];
2534     PetscInt       co = tmpO ? tmpO[i] : 0;
2535 
2536     if (ornt < 0) {
2537       PetscInt childSize, coff;
2538       ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2539       coff = co < 0 ? -(tmpO[i]+1) : tmpO[i];
2540       co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2541     }
2542     closure[closureSize]   = cp;
2543     closure[closureSize+1] = co;
2544     fifo[fifoSize]         = cp;
2545     fifo[fifoSize+1]       = co;
2546   }
2547   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
2548   while (fifoSize - fifoStart) {
2549     const PetscInt q   = fifo[fifoStart];
2550     const PetscInt o   = fifo[fifoStart+1];
2551     const PetscInt rev = o >= 0 ? 0 : 1;
2552     const PetscInt off = rev ? -(o+1) : o;
2553 
2554     if (useCone) {
2555       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
2556       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
2557       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
2558     } else {
2559       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
2560       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
2561       tmpO = NULL;
2562     }
2563     for (t = 0; t < tmpSize; ++t) {
2564       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
2565       const PetscInt cp = tmp[i];
2566       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
2567       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
2568        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
2569       PetscInt       co = tmpO ? tmpO[i] : 0;
2570       PetscInt       c;
2571 
2572       if (rev) {
2573         PetscInt childSize, coff;
2574         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
2575         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
2576         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
2577       }
2578       /* Check for duplicate */
2579       for (c = 0; c < closureSize; c += 2) {
2580         if (closure[c] == cp) break;
2581       }
2582       if (c == closureSize) {
2583         closure[closureSize]   = cp;
2584         closure[closureSize+1] = co;
2585         fifo[fifoSize]         = cp;
2586         fifo[fifoSize+1]       = co;
2587         closureSize           += 2;
2588         fifoSize              += 2;
2589       }
2590     }
2591     fifoStart += 2;
2592   }
2593   if (numPoints) *numPoints = closureSize/2;
2594   if (points)    *points    = closure;
2595   ierr = DMRestoreWorkArray(dm, maxSize, MPIU_INT, &fifo);CHKERRQ(ierr);
2596   PetscFunctionReturn(0);
2597 }
2598 
2599 /*@C
2600   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the DAG
2601 
2602   Not collective
2603 
2604   Input Parameters:
2605 + mesh - The DMPlex
2606 . p - The point, which must lie in the chart set with DMPlexSetChart()
2607 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
2608 . numPoints - The number of points in the closure, so points[] is of size 2*numPoints, zeroed on exit
2609 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...], zeroed on exit
2610 
2611   Note:
2612   If not using internal storage (points is not NULL on input), this call is unnecessary
2613 
2614   Fortran Notes:
2615   Since it returns an array, this routine is only available in Fortran 90, and you must
2616   include petsc.h90 in your code.
2617 
2618   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2619 
2620   Level: beginner
2621 
2622 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
2623 @*/
DMPlexRestoreTransitiveClosure(DM dm,PetscInt p,PetscBool useCone,PetscInt * numPoints,PetscInt * points[])2624 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
2625 {
2626   PetscErrorCode ierr;
2627 
2628   PetscFunctionBegin;
2629   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2630   if (numPoints) PetscValidIntPointer(numPoints,4);
2631   if (points) PetscValidPointer(points,5);
2632   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, points);CHKERRQ(ierr);
2633   if (numPoints) *numPoints = 0;
2634   PetscFunctionReturn(0);
2635 }
2636 
2637 /*@
2638   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the DAG
2639 
2640   Not collective
2641 
2642   Input Parameter:
2643 . mesh - The DMPlex
2644 
2645   Output Parameters:
2646 + maxConeSize - The maximum number of in-edges
2647 - maxSupportSize - The maximum number of out-edges
2648 
2649   Level: beginner
2650 
2651 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
2652 @*/
DMPlexGetMaxSizes(DM dm,PetscInt * maxConeSize,PetscInt * maxSupportSize)2653 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
2654 {
2655   DM_Plex *mesh = (DM_Plex*) dm->data;
2656 
2657   PetscFunctionBegin;
2658   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2659   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
2660   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
2661   PetscFunctionReturn(0);
2662 }
2663 
DMSetUp_Plex(DM dm)2664 PetscErrorCode DMSetUp_Plex(DM dm)
2665 {
2666   DM_Plex       *mesh = (DM_Plex*) dm->data;
2667   PetscInt       size;
2668   PetscErrorCode ierr;
2669 
2670   PetscFunctionBegin;
2671   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2672   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
2673   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
2674   ierr = PetscMalloc1(size, &mesh->cones);CHKERRQ(ierr);
2675   ierr = PetscCalloc1(size, &mesh->coneOrientations);CHKERRQ(ierr);
2676   ierr = PetscLogObjectMemory((PetscObject) dm, size*2*sizeof(PetscInt));CHKERRQ(ierr);
2677   if (mesh->maxSupportSize) {
2678     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2679     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
2680     ierr = PetscMalloc1(size, &mesh->supports);CHKERRQ(ierr);
2681     ierr = PetscLogObjectMemory((PetscObject) dm, size*sizeof(PetscInt));CHKERRQ(ierr);
2682   }
2683   PetscFunctionReturn(0);
2684 }
2685 
DMCreateSubDM_Plex(DM dm,PetscInt numFields,const PetscInt fields[],IS * is,DM * subdm)2686 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, const PetscInt fields[], IS *is, DM *subdm)
2687 {
2688   PetscErrorCode ierr;
2689 
2690   PetscFunctionBegin;
2691   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
2692   ierr = DMCreateSectionSubDM(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
2693   if (subdm) {(*subdm)->useNatural = dm->useNatural;}
2694   if (dm->useNatural && dm->sfMigration) {
2695     PetscSF        sfMigrationInv,sfNatural;
2696     PetscSection   section, sectionSeq;
2697 
2698     (*subdm)->sfMigration = dm->sfMigration;
2699     ierr = PetscObjectReference((PetscObject) dm->sfMigration);CHKERRQ(ierr);
2700     ierr = DMGetLocalSection((*subdm), &section);CHKERRQ(ierr);
2701     ierr = PetscSFCreateInverseSF((*subdm)->sfMigration, &sfMigrationInv);CHKERRQ(ierr);
2702     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) (*subdm)), &sectionSeq);CHKERRQ(ierr);
2703     ierr = PetscSFDistributeSection(sfMigrationInv, section, NULL, sectionSeq);CHKERRQ(ierr);
2704 
2705     ierr = DMPlexCreateGlobalToNaturalSF(*subdm, sectionSeq, (*subdm)->sfMigration, &sfNatural);CHKERRQ(ierr);
2706     (*subdm)->sfNatural = sfNatural;
2707     ierr = PetscSectionDestroy(&sectionSeq);CHKERRQ(ierr);
2708     ierr = PetscSFDestroy(&sfMigrationInv);CHKERRQ(ierr);
2709   }
2710   PetscFunctionReturn(0);
2711 }
2712 
DMCreateSuperDM_Plex(DM dms[],PetscInt len,IS ** is,DM * superdm)2713 PetscErrorCode DMCreateSuperDM_Plex(DM dms[], PetscInt len, IS **is, DM *superdm)
2714 {
2715   PetscErrorCode ierr;
2716   PetscInt       i = 0;
2717 
2718   PetscFunctionBegin;
2719   ierr = DMClone(dms[0], superdm);CHKERRQ(ierr);
2720   ierr = DMCreateSectionSuperDM(dms, len, is, superdm);CHKERRQ(ierr);
2721   (*superdm)->useNatural = PETSC_FALSE;
2722   for (i = 0; i < len; i++){
2723     if (dms[i]->useNatural && dms[i]->sfMigration) {
2724       PetscSF        sfMigrationInv,sfNatural;
2725       PetscSection   section, sectionSeq;
2726 
2727       (*superdm)->sfMigration = dms[i]->sfMigration;
2728       ierr = PetscObjectReference((PetscObject) dms[i]->sfMigration);CHKERRQ(ierr);
2729       (*superdm)->useNatural = PETSC_TRUE;
2730       ierr = DMGetLocalSection((*superdm), &section);CHKERRQ(ierr);
2731       ierr = PetscSFCreateInverseSF((*superdm)->sfMigration, &sfMigrationInv);CHKERRQ(ierr);
2732       ierr = PetscSectionCreate(PetscObjectComm((PetscObject) (*superdm)), &sectionSeq);CHKERRQ(ierr);
2733       ierr = PetscSFDistributeSection(sfMigrationInv, section, NULL, sectionSeq);CHKERRQ(ierr);
2734 
2735       ierr = DMPlexCreateGlobalToNaturalSF(*superdm, sectionSeq, (*superdm)->sfMigration, &sfNatural);CHKERRQ(ierr);
2736       (*superdm)->sfNatural = sfNatural;
2737       ierr = PetscSectionDestroy(&sectionSeq);CHKERRQ(ierr);
2738       ierr = PetscSFDestroy(&sfMigrationInv);CHKERRQ(ierr);
2739       break;
2740     }
2741   }
2742   PetscFunctionReturn(0);
2743 }
2744 
2745 /*@
2746   DMPlexSymmetrize - Create support (out-edge) information from cone (in-edge) information
2747 
2748   Not collective
2749 
2750   Input Parameter:
2751 . mesh - The DMPlex
2752 
2753   Output Parameter:
2754 
2755   Note:
2756   This should be called after all calls to DMPlexSetCone()
2757 
2758   Level: beginner
2759 
2760 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
2761 @*/
DMPlexSymmetrize(DM dm)2762 PetscErrorCode DMPlexSymmetrize(DM dm)
2763 {
2764   DM_Plex       *mesh = (DM_Plex*) dm->data;
2765   PetscInt      *offsets;
2766   PetscInt       supportSize;
2767   PetscInt       pStart, pEnd, p;
2768   PetscErrorCode ierr;
2769 
2770   PetscFunctionBegin;
2771   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2772   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
2773   ierr = PetscLogEventBegin(DMPLEX_Symmetrize,dm,0,0,0);CHKERRQ(ierr);
2774   /* Calculate support sizes */
2775   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2776   for (p = pStart; p < pEnd; ++p) {
2777     PetscInt dof, off, c;
2778 
2779     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2780     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2781     for (c = off; c < off+dof; ++c) {
2782       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
2783     }
2784   }
2785   for (p = pStart; p < pEnd; ++p) {
2786     PetscInt dof;
2787 
2788     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2789 
2790     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
2791   }
2792   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2793   /* Calculate supports */
2794   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
2795   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
2796   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
2797   for (p = pStart; p < pEnd; ++p) {
2798     PetscInt dof, off, c;
2799 
2800     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2801     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2802     for (c = off; c < off+dof; ++c) {
2803       const PetscInt q = mesh->cones[c];
2804       PetscInt       offS;
2805 
2806       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
2807 
2808       mesh->supports[offS+offsets[q]] = p;
2809       ++offsets[q];
2810     }
2811   }
2812   ierr = PetscFree(offsets);CHKERRQ(ierr);
2813   ierr = PetscLogEventEnd(DMPLEX_Symmetrize,dm,0,0,0);CHKERRQ(ierr);
2814   PetscFunctionReturn(0);
2815 }
2816 
DMPlexCreateDepthStratum(DM dm,DMLabel label,PetscInt depth,PetscInt pStart,PetscInt pEnd)2817 static PetscErrorCode DMPlexCreateDepthStratum(DM dm, DMLabel label, PetscInt depth, PetscInt pStart, PetscInt pEnd)
2818 {
2819   IS             stratumIS;
2820   PetscErrorCode ierr;
2821 
2822   PetscFunctionBegin;
2823   if (pStart >= pEnd) PetscFunctionReturn(0);
2824   if (PetscDefined(USE_DEBUG)) {
2825     PetscInt  qStart, qEnd, numLevels, level;
2826     PetscBool overlap = PETSC_FALSE;
2827     ierr = DMLabelGetNumValues(label, &numLevels);CHKERRQ(ierr);
2828     for (level = 0; level < numLevels; level++) {
2829       ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2830       if ((pStart >= qStart && pStart < qEnd) || (pEnd > qStart && pEnd <= qEnd)) {overlap = PETSC_TRUE; break;}
2831     }
2832     if (overlap) SETERRQ6(PETSC_COMM_SELF, PETSC_ERR_PLIB, "New depth %D range [%D,%D) overlaps with depth %D range [%D,%D)", depth, pStart, pEnd, level, qStart, qEnd);
2833   }
2834   ierr = ISCreateStride(PETSC_COMM_SELF, pEnd-pStart, pStart, 1, &stratumIS);CHKERRQ(ierr);
2835   ierr = DMLabelSetStratumIS(label, depth, stratumIS);CHKERRQ(ierr);
2836   ierr = ISDestroy(&stratumIS);CHKERRQ(ierr);
2837   PetscFunctionReturn(0);
2838 }
2839 
2840 /*@
2841   DMPlexStratify - The DAG for most topologies is a graded poset (https://en.wikipedia.org/wiki/Graded_poset), and
2842   can be illustrated by a Hasse Diagram (https://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
2843   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
2844   the DAG.
2845 
2846   Collective on dm
2847 
2848   Input Parameter:
2849 . mesh - The DMPlex
2850 
2851   Output Parameter:
2852 
2853   Notes:
2854   Concretely, DMPlexStratify() creates a new label named "depth" containing the depth in the DAG of each point. For cell-vertex
2855   meshes, vertices are depth 0 and cells are depth 1. For fully interpolated meshes, depth 0 for vertices, 1 for edges, and so on
2856   until cells have depth equal to the dimension of the mesh. The depth label can be accessed through DMPlexGetDepthLabel() or DMPlexGetDepthStratum(), or
2857   manually via DMGetLabel().  The height is defined implicitly by height = maxDimension - depth, and can be accessed
2858   via DMPlexGetHeightStratum().  For example, cells have height 0 and faces have height 1.
2859 
2860   The depth of a point is calculated by executing a breadth-first search (BFS) on the DAG. This could produce surprising results
2861   if run on a partially interpolated mesh, meaning one that had some edges and faces, but not others. For example, suppose that
2862   we had a mesh consisting of one triangle (c0) and three vertices (v0, v1, v2), and only one edge is on the boundary so we choose
2863   to interpolate only that one (e0), so that
2864 $  cone(c0) = {e0, v2}
2865 $  cone(e0) = {v0, v1}
2866   If DMPlexStratify() is run on this mesh, it will give depths
2867 $  depth 0 = {v0, v1, v2}
2868 $  depth 1 = {e0, c0}
2869   where the triangle has been given depth 1, instead of 2, because it is reachable from vertex v2.
2870 
2871   DMPlexStratify() should be called after all calls to DMPlexSymmetrize()
2872 
2873   Level: beginner
2874 
2875 .seealso: DMPlexCreate(), DMPlexSymmetrize(), DMPlexComputeCellTypes()
2876 @*/
DMPlexStratify(DM dm)2877 PetscErrorCode DMPlexStratify(DM dm)
2878 {
2879   DM_Plex       *mesh = (DM_Plex*) dm->data;
2880   DMLabel        label;
2881   PetscInt       pStart, pEnd, p;
2882   PetscInt       numRoots = 0, numLeaves = 0;
2883   PetscErrorCode ierr;
2884 
2885   PetscFunctionBegin;
2886   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2887   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2888 
2889   /* Create depth label */
2890   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2891   ierr = DMCreateLabel(dm, "depth");CHKERRQ(ierr);
2892   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2893 
2894   {
2895     /* Initialize roots and count leaves */
2896     PetscInt sMin = PETSC_MAX_INT;
2897     PetscInt sMax = PETSC_MIN_INT;
2898     PetscInt coneSize, supportSize;
2899 
2900     for (p = pStart; p < pEnd; ++p) {
2901       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2902       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2903       if (!coneSize && supportSize) {
2904         sMin = PetscMin(p, sMin);
2905         sMax = PetscMax(p, sMax);
2906         ++numRoots;
2907       } else if (!supportSize && coneSize) {
2908         ++numLeaves;
2909       } else if (!supportSize && !coneSize) {
2910         /* Isolated points */
2911         sMin = PetscMin(p, sMin);
2912         sMax = PetscMax(p, sMax);
2913       }
2914     }
2915     ierr = DMPlexCreateDepthStratum(dm, label, 0, sMin, sMax+1);CHKERRQ(ierr);
2916   }
2917 
2918   if (numRoots + numLeaves == (pEnd - pStart)) {
2919     PetscInt sMin = PETSC_MAX_INT;
2920     PetscInt sMax = PETSC_MIN_INT;
2921     PetscInt coneSize, supportSize;
2922 
2923     for (p = pStart; p < pEnd; ++p) {
2924       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2925       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2926       if (!supportSize && coneSize) {
2927         sMin = PetscMin(p, sMin);
2928         sMax = PetscMax(p, sMax);
2929       }
2930     }
2931     ierr = DMPlexCreateDepthStratum(dm, label, 1, sMin, sMax+1);CHKERRQ(ierr);
2932   } else {
2933     PetscInt level = 0;
2934     PetscInt qStart, qEnd, q;
2935 
2936     ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2937     while (qEnd > qStart) {
2938       PetscInt sMin = PETSC_MAX_INT;
2939       PetscInt sMax = PETSC_MIN_INT;
2940 
2941       for (q = qStart; q < qEnd; ++q) {
2942         const PetscInt *support;
2943         PetscInt        supportSize, s;
2944 
2945         ierr = DMPlexGetSupportSize(dm, q, &supportSize);CHKERRQ(ierr);
2946         ierr = DMPlexGetSupport(dm, q, &support);CHKERRQ(ierr);
2947         for (s = 0; s < supportSize; ++s) {
2948           sMin = PetscMin(support[s], sMin);
2949           sMax = PetscMax(support[s], sMax);
2950         }
2951       }
2952       ierr = DMLabelGetNumValues(label, &level);CHKERRQ(ierr);
2953       ierr = DMPlexCreateDepthStratum(dm, label, level, sMin, sMax+1);CHKERRQ(ierr);
2954       ierr = DMLabelGetStratumBounds(label, level, &qStart, &qEnd);CHKERRQ(ierr);
2955     }
2956   }
2957   { /* just in case there is an empty process */
2958     PetscInt numValues, maxValues = 0, v;
2959 
2960     ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
2961     ierr = MPI_Allreduce(&numValues,&maxValues,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
2962     for (v = numValues; v < maxValues; v++) {
2963       ierr = DMLabelAddStratum(label, v);CHKERRQ(ierr);
2964     }
2965   }
2966   ierr = PetscObjectStateGet((PetscObject) label, &mesh->depthState);CHKERRQ(ierr);
2967   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2968   PetscFunctionReturn(0);
2969 }
2970 
DMPlexComputeCellType_Internal(DM dm,PetscInt p,PetscInt pdepth,DMPolytopeType * pt)2971 PetscErrorCode DMPlexComputeCellType_Internal(DM dm, PetscInt p, PetscInt pdepth, DMPolytopeType *pt)
2972 {
2973   DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
2974   PetscInt       dim, depth, pheight, coneSize;
2975   PetscErrorCode ierr;
2976 
2977   PetscFunctionBeginHot;
2978   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2979   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2980   ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2981   pheight = depth - pdepth;
2982   if (depth <= 1) {
2983     switch (pdepth) {
2984       case 0: ct = DM_POLYTOPE_POINT;break;
2985       case 1:
2986         switch (coneSize) {
2987           case 2: ct = DM_POLYTOPE_SEGMENT;break;
2988           case 3: ct = DM_POLYTOPE_TRIANGLE;break;
2989           case 4:
2990           switch (dim) {
2991             case 2: ct = DM_POLYTOPE_QUADRILATERAL;break;
2992             case 3: ct = DM_POLYTOPE_TETRAHEDRON;break;
2993             default: break;
2994           }
2995           break;
2996         case 6: ct = DM_POLYTOPE_TRI_PRISM_TENSOR;break;
2997         case 8: ct = DM_POLYTOPE_HEXAHEDRON;break;
2998         default: break;
2999       }
3000     }
3001   } else {
3002     if (pdepth == 0) {
3003       ct = DM_POLYTOPE_POINT;
3004     } else if (pheight == 0) {
3005       switch (dim) {
3006         case 1:
3007           switch (coneSize) {
3008             case 2: ct = DM_POLYTOPE_SEGMENT;break;
3009             default: break;
3010           }
3011           break;
3012         case 2:
3013           switch (coneSize) {
3014             case 3: ct = DM_POLYTOPE_TRIANGLE;break;
3015             case 4: ct = DM_POLYTOPE_QUADRILATERAL;break;
3016             default: break;
3017           }
3018           break;
3019         case 3:
3020           switch (coneSize) {
3021             case 4: ct = DM_POLYTOPE_TETRAHEDRON;break;
3022             case 5: ct = DM_POLYTOPE_TRI_PRISM_TENSOR;break;
3023             case 6: ct = DM_POLYTOPE_HEXAHEDRON;break;
3024             default: break;
3025           }
3026           break;
3027         default: break;
3028       }
3029     } else if (pheight > 0) {
3030       switch (coneSize) {
3031         case 2: ct = DM_POLYTOPE_SEGMENT;break;
3032         case 3: ct = DM_POLYTOPE_TRIANGLE;break;
3033         case 4: ct = DM_POLYTOPE_QUADRILATERAL;break;
3034         default: break;
3035       }
3036     }
3037   }
3038   *pt = ct;
3039   PetscFunctionReturn(0);
3040 }
3041 
3042 /*@
3043   DMPlexComputeCellTypes - Infer the polytope type of every cell using its dimension and cone size.
3044 
3045   Collective on dm
3046 
3047   Input Parameter:
3048 . mesh - The DMPlex
3049 
3050   DMPlexComputeCellTypes() should be called after all calls to DMPlexSymmetrize() and DMPlexStratify()
3051 
3052   Level: developer
3053 
3054   Note: This function is normally called automatically by Plex when a cell type is requested. It creates an
3055   internal DMLabel named "celltype" which can be directly accessed using DMGetLabel(). A user may disable
3056   automatic creation by creating the label manually, using DMCreateLabel(dm, "celltype").
3057 
3058 .seealso: DMPlexCreate(), DMPlexSymmetrize(), DMPlexStratify(), DMGetLabel(), DMCreateLabel()
3059 @*/
DMPlexComputeCellTypes(DM dm)3060 PetscErrorCode DMPlexComputeCellTypes(DM dm)
3061 {
3062   DM_Plex       *mesh;
3063   DMLabel        ctLabel;
3064   PetscInt       pStart, pEnd, p;
3065   PetscErrorCode ierr;
3066 
3067   PetscFunctionBegin;
3068   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3069   mesh = (DM_Plex *) dm->data;
3070   ierr = DMCreateLabel(dm, "celltype");CHKERRQ(ierr);
3071   ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
3072   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3073   for (p = pStart; p < pEnd; ++p) {
3074     DMPolytopeType ct = DM_POLYTOPE_UNKNOWN;
3075     PetscInt       pdepth;
3076 
3077     ierr = DMPlexGetPointDepth(dm, p, &pdepth);CHKERRQ(ierr);
3078     ierr = DMPlexComputeCellType_Internal(dm, p, pdepth, &ct);CHKERRQ(ierr);
3079     if (ct == DM_POLYTOPE_UNKNOWN) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Point %D is screwed up", p);
3080     ierr = DMLabelSetValue(ctLabel, p, ct);CHKERRQ(ierr);
3081   }
3082   ierr = PetscObjectStateGet((PetscObject) ctLabel, &mesh->celltypeState);CHKERRQ(ierr);
3083   ierr = PetscObjectViewFromOptions((PetscObject) ctLabel, NULL, "-dm_plex_celltypes_view");CHKERRQ(ierr);
3084   PetscFunctionReturn(0);
3085 }
3086 
3087 /*@C
3088   DMPlexGetJoin - Get an array for the join of the set of points
3089 
3090   Not Collective
3091 
3092   Input Parameters:
3093 + dm - The DMPlex object
3094 . numPoints - The number of input points for the join
3095 - points - The input points
3096 
3097   Output Parameters:
3098 + numCoveredPoints - The number of points in the join
3099 - coveredPoints - The points in the join
3100 
3101   Level: intermediate
3102 
3103   Note: Currently, this is restricted to a single level join
3104 
3105   Fortran Notes:
3106   Since it returns an array, this routine is only available in Fortran 90, and you must
3107   include petsc.h90 in your code.
3108 
3109   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3110 
3111 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
3112 @*/
DMPlexGetJoin(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveredPoints,const PetscInt ** coveredPoints)3113 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3114 {
3115   DM_Plex       *mesh = (DM_Plex*) dm->data;
3116   PetscInt      *join[2];
3117   PetscInt       joinSize, i = 0;
3118   PetscInt       dof, off, p, c, m;
3119   PetscErrorCode ierr;
3120 
3121   PetscFunctionBegin;
3122   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3123   PetscValidIntPointer(points, 3);
3124   PetscValidIntPointer(numCoveredPoints, 4);
3125   PetscValidPointer(coveredPoints, 5);
3126   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
3127   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
3128   /* Copy in support of first point */
3129   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
3130   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
3131   for (joinSize = 0; joinSize < dof; ++joinSize) {
3132     join[i][joinSize] = mesh->supports[off+joinSize];
3133   }
3134   /* Check each successive support */
3135   for (p = 1; p < numPoints; ++p) {
3136     PetscInt newJoinSize = 0;
3137 
3138     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
3139     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
3140     for (c = 0; c < dof; ++c) {
3141       const PetscInt point = mesh->supports[off+c];
3142 
3143       for (m = 0; m < joinSize; ++m) {
3144         if (point == join[i][m]) {
3145           join[1-i][newJoinSize++] = point;
3146           break;
3147         }
3148       }
3149     }
3150     joinSize = newJoinSize;
3151     i        = 1-i;
3152   }
3153   *numCoveredPoints = joinSize;
3154   *coveredPoints    = join[i];
3155   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
3156   PetscFunctionReturn(0);
3157 }
3158 
3159 /*@C
3160   DMPlexRestoreJoin - Restore an array for the join of the set of points
3161 
3162   Not Collective
3163 
3164   Input Parameters:
3165 + dm - The DMPlex object
3166 . numPoints - The number of input points for the join
3167 - points - The input points
3168 
3169   Output Parameters:
3170 + numCoveredPoints - The number of points in the join
3171 - coveredPoints - The points in the join
3172 
3173   Fortran Notes:
3174   Since it returns an array, this routine is only available in Fortran 90, and you must
3175   include petsc.h90 in your code.
3176 
3177   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3178 
3179   Level: intermediate
3180 
3181 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
3182 @*/
DMPlexRestoreJoin(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveredPoints,const PetscInt ** coveredPoints)3183 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3184 {
3185   PetscErrorCode ierr;
3186 
3187   PetscFunctionBegin;
3188   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3189   if (points) PetscValidIntPointer(points,3);
3190   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
3191   PetscValidPointer(coveredPoints, 5);
3192   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
3193   if (numCoveredPoints) *numCoveredPoints = 0;
3194   PetscFunctionReturn(0);
3195 }
3196 
3197 /*@C
3198   DMPlexGetFullJoin - Get an array for the join of the set of points
3199 
3200   Not Collective
3201 
3202   Input Parameters:
3203 + dm - The DMPlex object
3204 . numPoints - The number of input points for the join
3205 - points - The input points
3206 
3207   Output Parameters:
3208 + numCoveredPoints - The number of points in the join
3209 - coveredPoints - The points in the join
3210 
3211   Fortran Notes:
3212   Since it returns an array, this routine is only available in Fortran 90, and you must
3213   include petsc.h90 in your code.
3214 
3215   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3216 
3217   Level: intermediate
3218 
3219 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
3220 @*/
DMPlexGetFullJoin(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveredPoints,const PetscInt ** coveredPoints)3221 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3222 {
3223   DM_Plex       *mesh = (DM_Plex*) dm->data;
3224   PetscInt      *offsets, **closures;
3225   PetscInt      *join[2];
3226   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
3227   PetscInt       p, d, c, m, ms;
3228   PetscErrorCode ierr;
3229 
3230   PetscFunctionBegin;
3231   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3232   PetscValidIntPointer(points, 3);
3233   PetscValidIntPointer(numCoveredPoints, 4);
3234   PetscValidPointer(coveredPoints, 5);
3235 
3236   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3237   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
3238   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3239   ms      = mesh->maxSupportSize;
3240   maxSize = (ms > 1) ? ((PetscPowInt(ms,depth+1)-1)/(ms-1)) : depth + 1;
3241   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[0]);CHKERRQ(ierr);
3242   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &join[1]);CHKERRQ(ierr);
3243 
3244   for (p = 0; p < numPoints; ++p) {
3245     PetscInt closureSize;
3246 
3247     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
3248 
3249     offsets[p*(depth+2)+0] = 0;
3250     for (d = 0; d < depth+1; ++d) {
3251       PetscInt pStart, pEnd, i;
3252 
3253       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
3254       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
3255         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
3256           offsets[p*(depth+2)+d+1] = i;
3257           break;
3258         }
3259       }
3260       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
3261     }
3262     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);
3263   }
3264   for (d = 0; d < depth+1; ++d) {
3265     PetscInt dof;
3266 
3267     /* Copy in support of first point */
3268     dof = offsets[d+1] - offsets[d];
3269     for (joinSize = 0; joinSize < dof; ++joinSize) {
3270       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
3271     }
3272     /* Check each successive cone */
3273     for (p = 1; p < numPoints && joinSize; ++p) {
3274       PetscInt newJoinSize = 0;
3275 
3276       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
3277       for (c = 0; c < dof; ++c) {
3278         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
3279 
3280         for (m = 0; m < joinSize; ++m) {
3281           if (point == join[i][m]) {
3282             join[1-i][newJoinSize++] = point;
3283             break;
3284           }
3285         }
3286       }
3287       joinSize = newJoinSize;
3288       i        = 1-i;
3289     }
3290     if (joinSize) break;
3291   }
3292   *numCoveredPoints = joinSize;
3293   *coveredPoints    = join[i];
3294   for (p = 0; p < numPoints; ++p) {
3295     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
3296   }
3297   ierr = PetscFree(closures);CHKERRQ(ierr);
3298   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3299   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, MPIU_INT, &join[1-i]);CHKERRQ(ierr);
3300   PetscFunctionReturn(0);
3301 }
3302 
3303 /*@C
3304   DMPlexGetMeet - Get an array for the meet of the set of points
3305 
3306   Not Collective
3307 
3308   Input Parameters:
3309 + dm - The DMPlex object
3310 . numPoints - The number of input points for the meet
3311 - points - The input points
3312 
3313   Output Parameters:
3314 + numCoveredPoints - The number of points in the meet
3315 - coveredPoints - The points in the meet
3316 
3317   Level: intermediate
3318 
3319   Note: Currently, this is restricted to a single level meet
3320 
3321   Fortran Notes:
3322   Since it returns an array, this routine is only available in Fortran 90, and you must
3323   include petsc.h90 in your code.
3324 
3325   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3326 
3327 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
3328 @*/
DMPlexGetMeet(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveringPoints,const PetscInt ** coveringPoints)3329 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
3330 {
3331   DM_Plex       *mesh = (DM_Plex*) dm->data;
3332   PetscInt      *meet[2];
3333   PetscInt       meetSize, i = 0;
3334   PetscInt       dof, off, p, c, m;
3335   PetscErrorCode ierr;
3336 
3337   PetscFunctionBegin;
3338   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3339   PetscValidPointer(points, 2);
3340   PetscValidPointer(numCoveringPoints, 3);
3341   PetscValidPointer(coveringPoints, 4);
3342   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
3343   ierr = DMGetWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
3344   /* Copy in cone of first point */
3345   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
3346   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
3347   for (meetSize = 0; meetSize < dof; ++meetSize) {
3348     meet[i][meetSize] = mesh->cones[off+meetSize];
3349   }
3350   /* Check each successive cone */
3351   for (p = 1; p < numPoints; ++p) {
3352     PetscInt newMeetSize = 0;
3353 
3354     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
3355     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
3356     for (c = 0; c < dof; ++c) {
3357       const PetscInt point = mesh->cones[off+c];
3358 
3359       for (m = 0; m < meetSize; ++m) {
3360         if (point == meet[i][m]) {
3361           meet[1-i][newMeetSize++] = point;
3362           break;
3363         }
3364       }
3365     }
3366     meetSize = newMeetSize;
3367     i        = 1-i;
3368   }
3369   *numCoveringPoints = meetSize;
3370   *coveringPoints    = meet[i];
3371   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
3372   PetscFunctionReturn(0);
3373 }
3374 
3375 /*@C
3376   DMPlexRestoreMeet - Restore an array for the meet of the set of points
3377 
3378   Not Collective
3379 
3380   Input Parameters:
3381 + dm - The DMPlex object
3382 . numPoints - The number of input points for the meet
3383 - points - The input points
3384 
3385   Output Parameters:
3386 + numCoveredPoints - The number of points in the meet
3387 - coveredPoints - The points in the meet
3388 
3389   Level: intermediate
3390 
3391   Fortran Notes:
3392   Since it returns an array, this routine is only available in Fortran 90, and you must
3393   include petsc.h90 in your code.
3394 
3395   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3396 
3397 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
3398 @*/
DMPlexRestoreMeet(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveredPoints,const PetscInt ** coveredPoints)3399 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3400 {
3401   PetscErrorCode ierr;
3402 
3403   PetscFunctionBegin;
3404   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3405   if (points) PetscValidIntPointer(points,3);
3406   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
3407   PetscValidPointer(coveredPoints,5);
3408   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, (void*) coveredPoints);CHKERRQ(ierr);
3409   if (numCoveredPoints) *numCoveredPoints = 0;
3410   PetscFunctionReturn(0);
3411 }
3412 
3413 /*@C
3414   DMPlexGetFullMeet - Get an array for the meet of the set of points
3415 
3416   Not Collective
3417 
3418   Input Parameters:
3419 + dm - The DMPlex object
3420 . numPoints - The number of input points for the meet
3421 - points - The input points
3422 
3423   Output Parameters:
3424 + numCoveredPoints - The number of points in the meet
3425 - coveredPoints - The points in the meet
3426 
3427   Level: intermediate
3428 
3429   Fortran Notes:
3430   Since it returns an array, this routine is only available in Fortran 90, and you must
3431   include petsc.h90 in your code.
3432 
3433   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
3434 
3435 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
3436 @*/
DMPlexGetFullMeet(DM dm,PetscInt numPoints,const PetscInt points[],PetscInt * numCoveredPoints,const PetscInt ** coveredPoints)3437 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
3438 {
3439   DM_Plex       *mesh = (DM_Plex*) dm->data;
3440   PetscInt      *offsets, **closures;
3441   PetscInt      *meet[2];
3442   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
3443   PetscInt       p, h, c, m, mc;
3444   PetscErrorCode ierr;
3445 
3446   PetscFunctionBegin;
3447   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3448   PetscValidPointer(points, 2);
3449   PetscValidPointer(numCoveredPoints, 3);
3450   PetscValidPointer(coveredPoints, 4);
3451 
3452   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
3453   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
3454   ierr    = DMGetWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3455   mc      = mesh->maxConeSize;
3456   maxSize = (mc > 1) ? ((PetscPowInt(mc,height+1)-1)/(mc-1)) : height + 1;
3457   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[0]);CHKERRQ(ierr);
3458   ierr    = DMGetWorkArray(dm, maxSize, MPIU_INT, &meet[1]);CHKERRQ(ierr);
3459 
3460   for (p = 0; p < numPoints; ++p) {
3461     PetscInt closureSize;
3462 
3463     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
3464 
3465     offsets[p*(height+2)+0] = 0;
3466     for (h = 0; h < height+1; ++h) {
3467       PetscInt pStart, pEnd, i;
3468 
3469       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
3470       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
3471         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
3472           offsets[p*(height+2)+h+1] = i;
3473           break;
3474         }
3475       }
3476       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
3477     }
3478     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);
3479   }
3480   for (h = 0; h < height+1; ++h) {
3481     PetscInt dof;
3482 
3483     /* Copy in cone of first point */
3484     dof = offsets[h+1] - offsets[h];
3485     for (meetSize = 0; meetSize < dof; ++meetSize) {
3486       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
3487     }
3488     /* Check each successive cone */
3489     for (p = 1; p < numPoints && meetSize; ++p) {
3490       PetscInt newMeetSize = 0;
3491 
3492       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
3493       for (c = 0; c < dof; ++c) {
3494         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
3495 
3496         for (m = 0; m < meetSize; ++m) {
3497           if (point == meet[i][m]) {
3498             meet[1-i][newMeetSize++] = point;
3499             break;
3500           }
3501         }
3502       }
3503       meetSize = newMeetSize;
3504       i        = 1-i;
3505     }
3506     if (meetSize) break;
3507   }
3508   *numCoveredPoints = meetSize;
3509   *coveredPoints    = meet[i];
3510   for (p = 0; p < numPoints; ++p) {
3511     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
3512   }
3513   ierr = PetscFree(closures);CHKERRQ(ierr);
3514   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), MPIU_INT, &offsets);CHKERRQ(ierr);
3515   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, MPIU_INT, &meet[1-i]);CHKERRQ(ierr);
3516   PetscFunctionReturn(0);
3517 }
3518 
3519 /*@C
3520   DMPlexEqual - Determine if two DMs have the same topology
3521 
3522   Not Collective
3523 
3524   Input Parameters:
3525 + dmA - A DMPlex object
3526 - dmB - A DMPlex object
3527 
3528   Output Parameters:
3529 . equal - PETSC_TRUE if the topologies are identical
3530 
3531   Level: intermediate
3532 
3533   Notes:
3534   We are not solving graph isomorphism, so we do not permutation.
3535 
3536 .seealso: DMPlexGetCone()
3537 @*/
DMPlexEqual(DM dmA,DM dmB,PetscBool * equal)3538 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
3539 {
3540   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
3541   PetscErrorCode ierr;
3542 
3543   PetscFunctionBegin;
3544   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
3545   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
3546   PetscValidPointer(equal, 3);
3547 
3548   *equal = PETSC_FALSE;
3549   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
3550   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
3551   if (depth != depthB) PetscFunctionReturn(0);
3552   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
3553   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
3554   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
3555   for (p = pStart; p < pEnd; ++p) {
3556     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
3557     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
3558 
3559     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
3560     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
3561     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
3562     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
3563     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
3564     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
3565     if (coneSize != coneSizeB) PetscFunctionReturn(0);
3566     for (c = 0; c < coneSize; ++c) {
3567       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
3568       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
3569     }
3570     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
3571     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
3572     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
3573     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
3574     if (supportSize != supportSizeB) PetscFunctionReturn(0);
3575     for (s = 0; s < supportSize; ++s) {
3576       if (support[s] != supportB[s]) PetscFunctionReturn(0);
3577     }
3578   }
3579   *equal = PETSC_TRUE;
3580   PetscFunctionReturn(0);
3581 }
3582 
3583 /*@C
3584   DMPlexGetNumFaceVertices - Returns the number of vertices on a face
3585 
3586   Not Collective
3587 
3588   Input Parameters:
3589 + dm         - The DMPlex
3590 . cellDim    - The cell dimension
3591 - numCorners - The number of vertices on a cell
3592 
3593   Output Parameters:
3594 . numFaceVertices - The number of vertices on a face
3595 
3596   Level: developer
3597 
3598   Notes:
3599   Of course this can only work for a restricted set of symmetric shapes
3600 
3601 .seealso: DMPlexGetCone()
3602 @*/
DMPlexGetNumFaceVertices(DM dm,PetscInt cellDim,PetscInt numCorners,PetscInt * numFaceVertices)3603 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
3604 {
3605   MPI_Comm       comm;
3606   PetscErrorCode ierr;
3607 
3608   PetscFunctionBegin;
3609   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3610   PetscValidPointer(numFaceVertices,3);
3611   switch (cellDim) {
3612   case 0:
3613     *numFaceVertices = 0;
3614     break;
3615   case 1:
3616     *numFaceVertices = 1;
3617     break;
3618   case 2:
3619     switch (numCorners) {
3620     case 3: /* triangle */
3621       *numFaceVertices = 2; /* Edge has 2 vertices */
3622       break;
3623     case 4: /* quadrilateral */
3624       *numFaceVertices = 2; /* Edge has 2 vertices */
3625       break;
3626     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
3627       *numFaceVertices = 3; /* Edge has 3 vertices */
3628       break;
3629     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
3630       *numFaceVertices = 3; /* Edge has 3 vertices */
3631       break;
3632     default:
3633       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
3634     }
3635     break;
3636   case 3:
3637     switch (numCorners) {
3638     case 4: /* tetradehdron */
3639       *numFaceVertices = 3; /* Face has 3 vertices */
3640       break;
3641     case 6: /* tet cohesive cells */
3642       *numFaceVertices = 4; /* Face has 4 vertices */
3643       break;
3644     case 8: /* hexahedron */
3645       *numFaceVertices = 4; /* Face has 4 vertices */
3646       break;
3647     case 9: /* tet cohesive Lagrange cells */
3648       *numFaceVertices = 6; /* Face has 6 vertices */
3649       break;
3650     case 10: /* quadratic tetrahedron */
3651       *numFaceVertices = 6; /* Face has 6 vertices */
3652       break;
3653     case 12: /* hex cohesive Lagrange cells */
3654       *numFaceVertices = 6; /* Face has 6 vertices */
3655       break;
3656     case 18: /* quadratic tet cohesive Lagrange cells */
3657       *numFaceVertices = 6; /* Face has 6 vertices */
3658       break;
3659     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
3660       *numFaceVertices = 9; /* Face has 9 vertices */
3661       break;
3662     default:
3663       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
3664     }
3665     break;
3666   default:
3667     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %D", cellDim);
3668   }
3669   PetscFunctionReturn(0);
3670 }
3671 
3672 /*@
3673   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
3674 
3675   Not Collective
3676 
3677   Input Parameter:
3678 . dm    - The DMPlex object
3679 
3680   Output Parameter:
3681 . depthLabel - The DMLabel recording point depth
3682 
3683   Level: developer
3684 
3685 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum(), DMPlexGetPointDepth(),
3686 @*/
DMPlexGetDepthLabel(DM dm,DMLabel * depthLabel)3687 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
3688 {
3689   PetscFunctionBegin;
3690   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3691   PetscValidPointer(depthLabel, 2);
3692   *depthLabel = dm->depthLabel;
3693   PetscFunctionReturn(0);
3694 }
3695 
3696 /*@
3697   DMPlexGetDepth - Get the depth of the DAG representing this mesh
3698 
3699   Not Collective
3700 
3701   Input Parameter:
3702 . dm    - The DMPlex object
3703 
3704   Output Parameter:
3705 . depth - The number of strata (breadth first levels) in the DAG
3706 
3707   Level: developer
3708 
3709   Notes:
3710   This returns maximum of point depths over all points, i.e. maximum value of the label returned by DMPlexGetDepthLabel().
3711   The point depth is described more in detail in DMPlexGetDepthStratum().
3712   An empty mesh gives -1.
3713 
3714 .seealso: DMPlexGetDepthLabel(), DMPlexGetDepthStratum(), DMPlexGetPointDepth(), DMPlexSymmetrize()
3715 @*/
DMPlexGetDepth(DM dm,PetscInt * depth)3716 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
3717 {
3718   DMLabel        label;
3719   PetscInt       d = 0;
3720   PetscErrorCode ierr;
3721 
3722   PetscFunctionBegin;
3723   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3724   PetscValidPointer(depth, 2);
3725   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3726   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
3727   *depth = d-1;
3728   PetscFunctionReturn(0);
3729 }
3730 
3731 /*@
3732   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
3733 
3734   Not Collective
3735 
3736   Input Parameters:
3737 + dm           - The DMPlex object
3738 - stratumValue - The requested depth
3739 
3740   Output Parameters:
3741 + start - The first point at this depth
3742 - end   - One beyond the last point at this depth
3743 
3744   Notes:
3745   Depth indexing is related to topological dimension.  Depth stratum 0 contains the lowest topological dimension points,
3746   often "vertices".  If the mesh is "interpolated" (see DMPlexInterpolate()), then depth stratum 1 contains the next
3747   higher dimension, e.g., "edges".
3748 
3749   Level: developer
3750 
3751 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth(), DMPlexGetDepthLabel(), DMPlexGetPointDepth(), DMPlexSymmetrize(), DMPlexInterpolate()
3752 @*/
DMPlexGetDepthStratum(DM dm,PetscInt stratumValue,PetscInt * start,PetscInt * end)3753 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3754 {
3755   DMLabel        label;
3756   PetscInt       pStart, pEnd;
3757   PetscErrorCode ierr;
3758 
3759   PetscFunctionBegin;
3760   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3761   if (start) {PetscValidPointer(start, 3); *start = 0;}
3762   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3763   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3764   if (pStart == pEnd) PetscFunctionReturn(0);
3765   if (stratumValue < 0) {
3766     if (start) *start = pStart;
3767     if (end)   *end   = pEnd;
3768     PetscFunctionReturn(0);
3769   }
3770   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3771   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3772   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
3773   PetscFunctionReturn(0);
3774 }
3775 
3776 /*@
3777   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
3778 
3779   Not Collective
3780 
3781   Input Parameters:
3782 + dm           - The DMPlex object
3783 - stratumValue - The requested height
3784 
3785   Output Parameters:
3786 + start - The first point at this height
3787 - end   - One beyond the last point at this height
3788 
3789   Notes:
3790   Height indexing is related to topological codimension.  Height stratum 0 contains the highest topological dimension
3791   points, often called "cells" or "elements".  If the mesh is "interpolated" (see DMPlexInterpolate()), then height
3792   stratum 1 contains the boundary of these "cells", often called "faces" or "facets".
3793 
3794   Level: developer
3795 
3796 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth(), DMPlexGetPointHeight()
3797 @*/
DMPlexGetHeightStratum(DM dm,PetscInt stratumValue,PetscInt * start,PetscInt * end)3798 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
3799 {
3800   DMLabel        label;
3801   PetscInt       depth, pStart, pEnd;
3802   PetscErrorCode ierr;
3803 
3804   PetscFunctionBegin;
3805   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3806   if (start) {PetscValidPointer(start, 3); *start = 0;}
3807   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
3808   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3809   if (pStart == pEnd) PetscFunctionReturn(0);
3810   if (stratumValue < 0) {
3811     if (start) *start = pStart;
3812     if (end)   *end   = pEnd;
3813     PetscFunctionReturn(0);
3814   }
3815   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
3816   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
3817   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
3818   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
3819   PetscFunctionReturn(0);
3820 }
3821 
3822 /*@
3823   DMPlexGetPointDepth - Get the depth of a given point
3824 
3825   Not Collective
3826 
3827   Input Parameter:
3828 + dm    - The DMPlex object
3829 - point - The point
3830 
3831   Output Parameter:
3832 . depth - The depth of the point
3833 
3834   Level: intermediate
3835 
3836 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexGetPointHeight()
3837 @*/
DMPlexGetPointDepth(DM dm,PetscInt point,PetscInt * depth)3838 PetscErrorCode DMPlexGetPointDepth(DM dm, PetscInt point, PetscInt *depth)
3839 {
3840   PetscErrorCode ierr;
3841 
3842   PetscFunctionBegin;
3843   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3844   PetscValidIntPointer(depth, 3);
3845   ierr = DMLabelGetValue(dm->depthLabel, point, depth);CHKERRQ(ierr);
3846   PetscFunctionReturn(0);
3847 }
3848 
3849 /*@
3850   DMPlexGetPointHeight - Get the height of a given point
3851 
3852   Not Collective
3853 
3854   Input Parameter:
3855 + dm    - The DMPlex object
3856 - point - The point
3857 
3858   Output Parameter:
3859 . height - The height of the point
3860 
3861   Level: intermediate
3862 
3863 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexGetPointDepth()
3864 @*/
DMPlexGetPointHeight(DM dm,PetscInt point,PetscInt * height)3865 PetscErrorCode DMPlexGetPointHeight(DM dm, PetscInt point, PetscInt *height)
3866 {
3867   PetscInt       n, pDepth;
3868   PetscErrorCode ierr;
3869 
3870   PetscFunctionBegin;
3871   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3872   PetscValidIntPointer(height, 3);
3873   ierr = DMLabelGetNumValues(dm->depthLabel, &n);CHKERRQ(ierr);
3874   ierr = DMLabelGetValue(dm->depthLabel, point, &pDepth);CHKERRQ(ierr);
3875   *height = n - 1 - pDepth;  /* DAG depth is n-1 */
3876   PetscFunctionReturn(0);
3877 }
3878 
3879 /*@
3880   DMPlexGetCellTypeLabel - Get the DMLabel recording the polytope type of each cell
3881 
3882   Not Collective
3883 
3884   Input Parameter:
3885 . dm - The DMPlex object
3886 
3887   Output Parameter:
3888 . celltypeLabel - The DMLabel recording cell polytope type
3889 
3890   Note: This function will trigger automatica computation of cell types. This can be disabled by calling
3891   DMCreateLabel(dm, "celltype") beforehand.
3892 
3893   Level: developer
3894 
3895 .seealso: DMPlexGetCellType(), DMPlexGetDepthLabel(), DMCreateLabel()
3896 @*/
DMPlexGetCellTypeLabel(DM dm,DMLabel * celltypeLabel)3897 PetscErrorCode DMPlexGetCellTypeLabel(DM dm, DMLabel *celltypeLabel)
3898 {
3899   PetscErrorCode ierr;
3900 
3901   PetscFunctionBegin;
3902   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3903   PetscValidPointer(celltypeLabel, 2);
3904   if (!dm->celltypeLabel) {ierr = DMPlexComputeCellTypes(dm);CHKERRQ(ierr);}
3905   *celltypeLabel = dm->celltypeLabel;
3906   PetscFunctionReturn(0);
3907 }
3908 
3909 /*@
3910   DMPlexGetCellType - Get the polytope type of a given cell
3911 
3912   Not Collective
3913 
3914   Input Parameter:
3915 + dm   - The DMPlex object
3916 - cell - The cell
3917 
3918   Output Parameter:
3919 . celltype - The polytope type of the cell
3920 
3921   Level: intermediate
3922 
3923 .seealso: DMPlexGetCellTypeLabel(), DMPlexGetDepthLabel(), DMPlexGetDepth()
3924 @*/
DMPlexGetCellType(DM dm,PetscInt cell,DMPolytopeType * celltype)3925 PetscErrorCode DMPlexGetCellType(DM dm, PetscInt cell, DMPolytopeType *celltype)
3926 {
3927   DMLabel        label;
3928   PetscInt       ct;
3929   PetscErrorCode ierr;
3930 
3931   PetscFunctionBegin;
3932   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3933   PetscValidPointer(celltype, 3);
3934   ierr = DMPlexGetCellTypeLabel(dm, &label);CHKERRQ(ierr);
3935   ierr = DMLabelGetValue(label, cell, &ct);CHKERRQ(ierr);
3936   *celltype = (DMPolytopeType) ct;
3937   PetscFunctionReturn(0);
3938 }
3939 
3940 /*@
3941   DMPlexSetCellType - Set the polytope type of a given cell
3942 
3943   Not Collective
3944 
3945   Input Parameters:
3946 + dm   - The DMPlex object
3947 . cell - The cell
3948 - celltype - The polytope type of the cell
3949 
3950   Note: By default, cell types will be automatically computed using DMPlexComputeCellTypes() before this function
3951   is executed. This function will override the computed type. However, if automatic classification will not succeed
3952   and a user wants to manually specify all types, the classification must be disabled by calling
3953   DMCreaateLabel(dm, "celltype") before getting or setting any cell types.
3954 
3955   Level: advanced
3956 
3957 .seealso: DMPlexGetCellTypeLabel(), DMPlexGetDepthLabel(), DMPlexGetDepth(), DMPlexComputeCellTypes(), DMCreateLabel()
3958 @*/
DMPlexSetCellType(DM dm,PetscInt cell,DMPolytopeType celltype)3959 PetscErrorCode DMPlexSetCellType(DM dm, PetscInt cell, DMPolytopeType celltype)
3960 {
3961   DMLabel        label;
3962   PetscErrorCode ierr;
3963 
3964   PetscFunctionBegin;
3965   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3966   ierr = DMPlexGetCellTypeLabel(dm, &label);CHKERRQ(ierr);
3967   ierr = DMLabelSetValue(label, cell, celltype);CHKERRQ(ierr);
3968   PetscFunctionReturn(0);
3969 }
3970 
DMCreateCoordinateDM_Plex(DM dm,DM * cdm)3971 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3972 {
3973   PetscSection   section, s;
3974   Mat            m;
3975   PetscInt       maxHeight;
3976   PetscErrorCode ierr;
3977 
3978   PetscFunctionBegin;
3979   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
3980   ierr = DMPlexGetMaxProjectionHeight(dm, &maxHeight);CHKERRQ(ierr);
3981   ierr = DMPlexSetMaxProjectionHeight(*cdm, maxHeight);CHKERRQ(ierr);
3982   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
3983   ierr = DMSetLocalSection(*cdm, section);CHKERRQ(ierr);
3984   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
3985   ierr = PetscSectionCreate(PETSC_COMM_SELF, &s);CHKERRQ(ierr);
3986   ierr = MatCreate(PETSC_COMM_SELF, &m);CHKERRQ(ierr);
3987   ierr = DMSetDefaultConstraints(*cdm, s, m);CHKERRQ(ierr);
3988   ierr = PetscSectionDestroy(&s);CHKERRQ(ierr);
3989   ierr = MatDestroy(&m);CHKERRQ(ierr);
3990 
3991   ierr = DMSetNumFields(*cdm, 1);CHKERRQ(ierr);
3992   ierr = DMCreateDS(*cdm);CHKERRQ(ierr);
3993   PetscFunctionReturn(0);
3994 }
3995 
DMCreateCoordinateField_Plex(DM dm,DMField * field)3996 PetscErrorCode DMCreateCoordinateField_Plex(DM dm, DMField *field)
3997 {
3998   Vec            coordsLocal;
3999   DM             coordsDM;
4000   PetscErrorCode ierr;
4001 
4002   PetscFunctionBegin;
4003   *field = NULL;
4004   ierr = DMGetCoordinatesLocal(dm,&coordsLocal);CHKERRQ(ierr);
4005   ierr = DMGetCoordinateDM(dm,&coordsDM);CHKERRQ(ierr);
4006   if (coordsLocal && coordsDM) {
4007     ierr = DMFieldCreateDS(coordsDM, 0, coordsLocal, field);CHKERRQ(ierr);
4008   }
4009   PetscFunctionReturn(0);
4010 }
4011 
4012 /*@C
4013   DMPlexGetConeSection - Return a section which describes the layout of cone data
4014 
4015   Not Collective
4016 
4017   Input Parameters:
4018 . dm        - The DMPlex object
4019 
4020   Output Parameter:
4021 . section - The PetscSection object
4022 
4023   Level: developer
4024 
4025 .seealso: DMPlexGetSupportSection(), DMPlexGetCones(), DMPlexGetConeOrientations()
4026 @*/
DMPlexGetConeSection(DM dm,PetscSection * section)4027 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
4028 {
4029   DM_Plex *mesh = (DM_Plex*) dm->data;
4030 
4031   PetscFunctionBegin;
4032   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4033   if (section) *section = mesh->coneSection;
4034   PetscFunctionReturn(0);
4035 }
4036 
4037 /*@C
4038   DMPlexGetSupportSection - Return a section which describes the layout of support data
4039 
4040   Not Collective
4041 
4042   Input Parameters:
4043 . dm        - The DMPlex object
4044 
4045   Output Parameter:
4046 . section - The PetscSection object
4047 
4048   Level: developer
4049 
4050 .seealso: DMPlexGetConeSection()
4051 @*/
DMPlexGetSupportSection(DM dm,PetscSection * section)4052 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
4053 {
4054   DM_Plex *mesh = (DM_Plex*) dm->data;
4055 
4056   PetscFunctionBegin;
4057   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4058   if (section) *section = mesh->supportSection;
4059   PetscFunctionReturn(0);
4060 }
4061 
4062 /*@C
4063   DMPlexGetCones - Return cone data
4064 
4065   Not Collective
4066 
4067   Input Parameters:
4068 . dm        - The DMPlex object
4069 
4070   Output Parameter:
4071 . cones - The cone for each point
4072 
4073   Level: developer
4074 
4075 .seealso: DMPlexGetConeSection()
4076 @*/
DMPlexGetCones(DM dm,PetscInt * cones[])4077 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
4078 {
4079   DM_Plex *mesh = (DM_Plex*) dm->data;
4080 
4081   PetscFunctionBegin;
4082   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4083   if (cones) *cones = mesh->cones;
4084   PetscFunctionReturn(0);
4085 }
4086 
4087 /*@C
4088   DMPlexGetConeOrientations - Return cone orientation data
4089 
4090   Not Collective
4091 
4092   Input Parameters:
4093 . dm        - The DMPlex object
4094 
4095   Output Parameter:
4096 . coneOrientations - The cone orientation for each point
4097 
4098   Level: developer
4099 
4100 .seealso: DMPlexGetConeSection()
4101 @*/
DMPlexGetConeOrientations(DM dm,PetscInt * coneOrientations[])4102 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
4103 {
4104   DM_Plex *mesh = (DM_Plex*) dm->data;
4105 
4106   PetscFunctionBegin;
4107   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4108   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
4109   PetscFunctionReturn(0);
4110 }
4111 
4112 /******************************** FEM Support **********************************/
4113 
4114 /*
4115  Returns number of components and tensor degree for the field.  For interpolated meshes, line should be a point
4116  representing a line in the section.
4117 */
PetscSectionFieldGetTensorDegree_Private(PetscSection section,PetscInt field,PetscInt line,PetscBool vertexchart,PetscInt * Nc,PetscInt * k)4118 static PetscErrorCode PetscSectionFieldGetTensorDegree_Private(PetscSection section,PetscInt field,PetscInt line,PetscBool vertexchart,PetscInt *Nc,PetscInt *k)
4119 {
4120   PetscErrorCode ierr;
4121 
4122   PetscFunctionBeginHot;
4123   ierr = PetscSectionGetFieldComponents(section, field, Nc);CHKERRQ(ierr);
4124   if (line < 0) {
4125     *k = 0;
4126     *Nc = 0;
4127   } else if (vertexchart) {            /* If we only have a vertex chart, we must have degree k=1 */
4128     *k = 1;
4129   } else {                      /* Assume the full interpolated mesh is in the chart; lines in particular */
4130     /* An order k SEM disc has k-1 dofs on an edge */
4131     ierr = PetscSectionGetFieldDof(section, line, field, k);CHKERRQ(ierr);
4132     *k = *k / *Nc + 1;
4133   }
4134   PetscFunctionReturn(0);
4135 }
4136 
4137 /*@
4138 
4139   DMPlexSetClosurePermutationTensor - Create a permutation from the default (BFS) point ordering in the closure, to a
4140   lexicographic ordering over the tensor product cell (i.e., line, quad, hex, etc.), and set this permutation in the
4141   section provided (or the section of the DM).
4142 
4143   Input Parameters:
4144 + dm      - The DM
4145 . point   - Either a cell (highest dim point) or an edge (dim 1 point), or PETSC_DETERMINE
4146 - section - The PetscSection to reorder, or NULL for the default section
4147 
4148   Note: The point is used to determine the number of dofs/field on an edge. For SEM, this is related to the polynomial
4149   degree of the basis.
4150 
4151   Example:
4152   A typical interpolated single-quad mesh might order points as
4153 .vb
4154   [c0, v1, v2, v3, v4, e5, e6, e7, e8]
4155 
4156   v4 -- e6 -- v3
4157   |           |
4158   e7    c0    e8
4159   |           |
4160   v1 -- e5 -- v2
4161 .ve
4162 
4163   (There is no significance to the ordering described here.)  The default section for a Q3 quad might typically assign
4164   dofs in the order of points, e.g.,
4165 .vb
4166     c0 -> [0,1,2,3]
4167     v1 -> [4]
4168     ...
4169     e5 -> [8, 9]
4170 .ve
4171 
4172   which corresponds to the dofs
4173 .vb
4174     6   10  11  7
4175     13  2   3   15
4176     12  0   1   14
4177     4   8   9   5
4178 .ve
4179 
4180   The closure in BFS ordering works through height strata (cells, edges, vertices) to produce the ordering
4181 .vb
4182   0 1 2 3 8 9 14 15 11 10 13 12 4 5 7 6
4183 .ve
4184 
4185   After calling DMPlexSetClosurePermutationTensor(), the closure will be ordered lexicographically,
4186 .vb
4187    4 8 9 5 12 0 1 14 13 2 3 15 6 10 11 7
4188 .ve
4189 
4190   Level: developer
4191 
4192 .seealso: DMGetLocalSection(), PetscSectionSetClosurePermutation(), DMSetGlobalSection()
4193 @*/
DMPlexSetClosurePermutationTensor(DM dm,PetscInt point,PetscSection section)4194 PetscErrorCode DMPlexSetClosurePermutationTensor(DM dm, PetscInt point, PetscSection section)
4195 {
4196   DMLabel        label;
4197   PetscInt       dim, depth = -1, eStart = -1, Nf;
4198   PetscBool      vertexchart;
4199   PetscErrorCode ierr;
4200 
4201   PetscFunctionBegin;
4202   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4203   if (dim < 1) PetscFunctionReturn(0);
4204   if (point < 0) {
4205     PetscInt sStart,sEnd;
4206 
4207     ierr = DMPlexGetDepthStratum(dm, 1, &sStart, &sEnd);CHKERRQ(ierr);
4208     point = sEnd-sStart ? sStart : point;
4209   }
4210   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
4211   if (point >= 0) { ierr = DMLabelGetValue(label, point, &depth);CHKERRQ(ierr); }
4212   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4213   if (depth == 1) {eStart = point;}
4214   else if  (depth == dim) {
4215     const PetscInt *cone;
4216 
4217     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4218     if (dim == 2) eStart = cone[0];
4219     else if (dim == 3) {
4220       const PetscInt *cone2;
4221       ierr = DMPlexGetCone(dm, cone[0], &cone2);CHKERRQ(ierr);
4222       eStart = cone2[0];
4223     } else SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %D of depth %D cannot be used to bootstrap spectral ordering for dim %D", point, depth, dim);
4224   } else if (depth >= 0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %D of depth %D cannot be used to bootstrap spectral ordering for dim %D", point, depth, dim);
4225   {                             /* Determine whether the chart covers all points or just vertices. */
4226     PetscInt pStart,pEnd,cStart,cEnd;
4227     ierr = DMPlexGetDepthStratum(dm,0,&pStart,&pEnd);CHKERRQ(ierr);
4228     ierr = PetscSectionGetChart(section,&cStart,&cEnd);CHKERRQ(ierr);
4229     if (pStart == cStart && pEnd == cEnd) vertexchart = PETSC_TRUE; /* Just vertices */
4230     else vertexchart = PETSC_FALSE;                                 /* Assume all interpolated points are in chart */
4231   }
4232   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
4233   for (PetscInt d=1; d<=dim; d++) {
4234     PetscInt k, f, Nc, c, i, j, size = 0, offset = 0, foffset = 0;
4235     PetscInt *perm;
4236 
4237     for (f = 0; f < Nf; ++f) {
4238       ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4239       size += PetscPowInt(k+1, d)*Nc;
4240     }
4241     ierr = PetscMalloc1(size, &perm);CHKERRQ(ierr);
4242     for (f = 0; f < Nf; ++f) {
4243       switch (d) {
4244       case 1:
4245         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4246         /*
4247          Original ordering is [ edge of length k-1; vtx0; vtx1 ]
4248          We want              [ vtx0; edge of length k-1; vtx1 ]
4249          */
4250         for (c=0; c<Nc; c++,offset++) perm[offset] = (k-1)*Nc + c + foffset;
4251         for (i=0; i<k-1; i++) for (c=0; c<Nc; c++,offset++) perm[offset] = i*Nc + c + foffset;
4252         for (c=0; c<Nc; c++,offset++) perm[offset] = k*Nc + c + foffset;
4253         foffset = offset;
4254         break;
4255       case 2:
4256         /* The original quad closure is oriented clockwise, {f, e_b, e_r, e_t, e_l, v_lb, v_rb, v_tr, v_tl} */
4257         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4258         /* The SEM order is
4259 
4260          v_lb, {e_b}, v_rb,
4261          e^{(k-1)-i}_l, {f^{i*(k-1)}}, e^i_r,
4262          v_lt, reverse {e_t}, v_rt
4263          */
4264         {
4265           const PetscInt of   = 0;
4266           const PetscInt oeb  = of   + PetscSqr(k-1);
4267           const PetscInt oer  = oeb  + (k-1);
4268           const PetscInt oet  = oer  + (k-1);
4269           const PetscInt oel  = oet  + (k-1);
4270           const PetscInt ovlb = oel  + (k-1);
4271           const PetscInt ovrb = ovlb + 1;
4272           const PetscInt ovrt = ovrb + 1;
4273           const PetscInt ovlt = ovrt + 1;
4274           PetscInt       o;
4275 
4276           /* bottom */
4277           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlb*Nc + c + foffset;
4278           for (o = oeb; o < oer; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4279           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrb*Nc + c + foffset;
4280           /* middle */
4281           for (i = 0; i < k-1; ++i) {
4282             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oel+(k-2)-i)*Nc + c + foffset;
4283             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;
4284             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oer+i)*Nc + c + foffset;
4285           }
4286           /* top */
4287           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlt*Nc + c + foffset;
4288           for (o = oel-1; o >= oet; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4289           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrt*Nc + c + foffset;
4290           foffset = offset;
4291         }
4292         break;
4293       case 3:
4294         /* The original hex closure is
4295 
4296          {c,
4297          f_b, f_t, f_f, f_b, f_r, f_l,
4298          e_bl, e_bb, e_br, e_bf,  e_tf, e_tr, e_tb, e_tl,  e_rf, e_lf, e_lb, e_rb,
4299          v_blf, v_blb, v_brb, v_brf, v_tlf, v_trf, v_trb, v_tlb}
4300          */
4301         ierr = PetscSectionFieldGetTensorDegree_Private(section,f,eStart,vertexchart,&Nc,&k);CHKERRQ(ierr);
4302         /* The SEM order is
4303          Bottom Slice
4304          v_blf, {e^{(k-1)-n}_bf}, v_brf,
4305          e^{i}_bl, f^{n*(k-1)+(k-1)-i}_b, e^{(k-1)-i}_br,
4306          v_blb, {e_bb}, v_brb,
4307 
4308          Middle Slice (j)
4309          {e^{(k-1)-j}_lf}, {f^{j*(k-1)+n}_f}, e^j_rf,
4310          f^{i*(k-1)+j}_l, {c^{(j*(k-1) + i)*(k-1)+n}_t}, f^{j*(k-1)+i}_r,
4311          e^j_lb, {f^{j*(k-1)+(k-1)-n}_b}, e^{(k-1)-j}_rb,
4312 
4313          Top Slice
4314          v_tlf, {e_tf}, v_trf,
4315          e^{(k-1)-i}_tl, {f^{i*(k-1)}_t}, e^{i}_tr,
4316          v_tlb, {e^{(k-1)-n}_tb}, v_trb,
4317          */
4318         {
4319           const PetscInt oc    = 0;
4320           const PetscInt ofb   = oc    + PetscSqr(k-1)*(k-1);
4321           const PetscInt oft   = ofb   + PetscSqr(k-1);
4322           const PetscInt off   = oft   + PetscSqr(k-1);
4323           const PetscInt ofk   = off   + PetscSqr(k-1);
4324           const PetscInt ofr   = ofk   + PetscSqr(k-1);
4325           const PetscInt ofl   = ofr   + PetscSqr(k-1);
4326           const PetscInt oebl  = ofl   + PetscSqr(k-1);
4327           const PetscInt oebb  = oebl  + (k-1);
4328           const PetscInt oebr  = oebb  + (k-1);
4329           const PetscInt oebf  = oebr  + (k-1);
4330           const PetscInt oetf  = oebf  + (k-1);
4331           const PetscInt oetr  = oetf  + (k-1);
4332           const PetscInt oetb  = oetr  + (k-1);
4333           const PetscInt oetl  = oetb  + (k-1);
4334           const PetscInt oerf  = oetl  + (k-1);
4335           const PetscInt oelf  = oerf  + (k-1);
4336           const PetscInt oelb  = oelf  + (k-1);
4337           const PetscInt oerb  = oelb  + (k-1);
4338           const PetscInt ovblf = oerb  + (k-1);
4339           const PetscInt ovblb = ovblf + 1;
4340           const PetscInt ovbrb = ovblb + 1;
4341           const PetscInt ovbrf = ovbrb + 1;
4342           const PetscInt ovtlf = ovbrf + 1;
4343           const PetscInt ovtrf = ovtlf + 1;
4344           const PetscInt ovtrb = ovtrf + 1;
4345           const PetscInt ovtlb = ovtrb + 1;
4346           PetscInt       o, n;
4347 
4348           /* Bottom Slice */
4349           /*   bottom */
4350           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblf*Nc + c + foffset;
4351           for (o = oetf-1; o >= oebf; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4352           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrf*Nc + c + foffset;
4353           /*   middle */
4354           for (i = 0; i < k-1; ++i) {
4355             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebl+i)*Nc + c + foffset;
4356             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;}
4357             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebr+(k-2)-i)*Nc + c + foffset;
4358           }
4359           /*   top */
4360           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblb*Nc + c + foffset;
4361           for (o = oebb; o < oebr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4362           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrb*Nc + c + foffset;
4363 
4364           /* Middle Slice */
4365           for (j = 0; j < k-1; ++j) {
4366             /*   bottom */
4367             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelf+(k-2)-j)*Nc + c + foffset;
4368             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;
4369             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerf+j)*Nc + c + foffset;
4370             /*   middle */
4371             for (i = 0; i < k-1; ++i) {
4372               for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofl+i*(k-1)+j)*Nc + c + foffset;
4373               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;
4374               for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofr+j*(k-1)+i)*Nc + c + foffset;
4375             }
4376             /*   top */
4377             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelb+j)*Nc + c + foffset;
4378             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;
4379             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerb+(k-2)-j)*Nc + c + foffset;
4380           }
4381 
4382           /* Top Slice */
4383           /*   bottom */
4384           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlf*Nc + c + foffset;
4385           for (o = oetf; o < oetr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4386           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrf*Nc + c + foffset;
4387           /*   middle */
4388           for (i = 0; i < k-1; ++i) {
4389             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetl+(k-2)-i)*Nc + c + foffset;
4390             for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oft+i*(k-1)+n)*Nc + c + foffset;
4391             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetr+i)*Nc + c + foffset;
4392           }
4393           /*   top */
4394           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlb*Nc + c + foffset;
4395           for (o = oetl-1; o >= oetb; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
4396           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrb*Nc + c + foffset;
4397 
4398           foffset = offset;
4399         }
4400         break;
4401       default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No spectral ordering for dimension %D", d);
4402       }
4403     }
4404     if (offset != size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Number of permutation entries %D != %D", offset, size);
4405     /* Check permutation */
4406     {
4407       PetscInt *check;
4408 
4409       ierr = PetscMalloc1(size, &check);CHKERRQ(ierr);
4410       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]);}
4411       for (i = 0; i < size; ++i) check[perm[i]] = i;
4412       for (i = 0; i < size; ++i) {if (check[i] < 0) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Missing permutation index %D", i);}
4413       ierr = PetscFree(check);CHKERRQ(ierr);
4414     }
4415     ierr = PetscSectionSetClosurePermutation_Internal(section, (PetscObject) dm, d, size, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
4416   }
4417   PetscFunctionReturn(0);
4418 }
4419 
DMPlexGetPointDualSpaceFEM(DM dm,PetscInt point,PetscInt field,PetscDualSpace * dspace)4420 PetscErrorCode DMPlexGetPointDualSpaceFEM(DM dm, PetscInt point, PetscInt field, PetscDualSpace *dspace)
4421 {
4422   PetscDS        prob;
4423   PetscInt       depth, Nf, h;
4424   DMLabel        label;
4425   PetscErrorCode ierr;
4426 
4427   PetscFunctionBeginHot;
4428   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4429   Nf      = prob->Nf;
4430   label   = dm->depthLabel;
4431   *dspace = NULL;
4432   if (field < Nf) {
4433     PetscObject disc = prob->disc[field];
4434 
4435     if (disc->classid == PETSCFE_CLASSID) {
4436       PetscDualSpace dsp;
4437 
4438       ierr = PetscFEGetDualSpace((PetscFE)disc,&dsp);CHKERRQ(ierr);
4439       ierr = DMLabelGetNumValues(label,&depth);CHKERRQ(ierr);
4440       ierr = DMLabelGetValue(label,point,&h);CHKERRQ(ierr);
4441       h    = depth - 1 - h;
4442       if (h) {
4443         ierr = PetscDualSpaceGetHeightSubspace(dsp,h,dspace);CHKERRQ(ierr);
4444       } else {
4445         *dspace = dsp;
4446       }
4447     }
4448   }
4449   PetscFunctionReturn(0);
4450 }
4451 
4452 
DMPlexVecGetClosure_Depth1_Static(DM dm,PetscSection section,Vec v,PetscInt point,PetscInt * csize,PetscScalar * values[])4453 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4454 {
4455   PetscScalar    *array, *vArray;
4456   const PetscInt *cone, *coneO;
4457   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
4458   PetscErrorCode  ierr;
4459 
4460   PetscFunctionBeginHot;
4461   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4462   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4463   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4464   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4465   if (!values || !*values) {
4466     if ((point >= pStart) && (point < pEnd)) {
4467       PetscInt dof;
4468 
4469       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4470       size += dof;
4471     }
4472     for (p = 0; p < numPoints; ++p) {
4473       const PetscInt cp = cone[p];
4474       PetscInt       dof;
4475 
4476       if ((cp < pStart) || (cp >= pEnd)) continue;
4477       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4478       size += dof;
4479     }
4480     if (!values) {
4481       if (csize) *csize = size;
4482       PetscFunctionReturn(0);
4483     }
4484     ierr = DMGetWorkArray(dm, size, MPIU_SCALAR, &array);CHKERRQ(ierr);
4485   } else {
4486     array = *values;
4487   }
4488   size = 0;
4489   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
4490   if ((point >= pStart) && (point < pEnd)) {
4491     PetscInt     dof, off, d;
4492     PetscScalar *varr;
4493 
4494     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4495     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4496     varr = &vArray[off];
4497     for (d = 0; d < dof; ++d, ++offset) {
4498       array[offset] = varr[d];
4499     }
4500     size += dof;
4501   }
4502   for (p = 0; p < numPoints; ++p) {
4503     const PetscInt cp = cone[p];
4504     PetscInt       o  = coneO[p];
4505     PetscInt       dof, off, d;
4506     PetscScalar   *varr;
4507 
4508     if ((cp < pStart) || (cp >= pEnd)) continue;
4509     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4510     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
4511     varr = &vArray[off];
4512     if (o >= 0) {
4513       for (d = 0; d < dof; ++d, ++offset) {
4514         array[offset] = varr[d];
4515       }
4516     } else {
4517       for (d = dof-1; d >= 0; --d, ++offset) {
4518         array[offset] = varr[d];
4519       }
4520     }
4521     size += dof;
4522   }
4523   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
4524   if (!*values) {
4525     if (csize) *csize = size;
4526     *values = array;
4527   } else {
4528     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4529     *csize = size;
4530   }
4531   PetscFunctionReturn(0);
4532 }
4533 
4534 /* Compress out points not in the section */
CompressPoints_Private(PetscSection section,PetscInt * numPoints,PetscInt points[])4535 PETSC_STATIC_INLINE PetscErrorCode CompressPoints_Private(PetscSection section, PetscInt *numPoints, PetscInt points[])
4536 {
4537   const PetscInt np = *numPoints;
4538   PetscInt       pStart, pEnd, p, q;
4539   PetscErrorCode ierr;
4540 
4541   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4542   for (p = 0, q = 0; p < np; ++p) {
4543     const PetscInt r = points[p*2];
4544     if ((r >= pStart) && (r < pEnd)) {
4545       points[q*2]   = r;
4546       points[q*2+1] = points[p*2+1];
4547       ++q;
4548     }
4549   }
4550   *numPoints = q;
4551   return 0;
4552 }
4553 
DMPlexTransitiveClosure_Hybrid_Internal(DM dm,PetscInt point,PetscInt np,PetscInt * numPoints,PetscInt ** points)4554 static PetscErrorCode DMPlexTransitiveClosure_Hybrid_Internal(DM dm, PetscInt point, PetscInt np, PetscInt *numPoints, PetscInt **points)
4555 {
4556   const PetscInt *cone, *ornt;
4557   PetscInt       *pts,  *closure = NULL;
4558   PetscInt        dim, coneSize, c, d, clSize, cl;
4559   PetscErrorCode  ierr;
4560 
4561   PetscFunctionBeginHot;
4562   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4563   ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
4564   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4565   ierr = DMPlexGetConeOrientation(dm, point, &ornt);CHKERRQ(ierr);
4566   ierr = DMPlexGetTransitiveClosure(dm, cone[0], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4567   ierr = DMGetWorkArray(dm, np*2, MPIU_INT, &pts);CHKERRQ(ierr);
4568   c    = 0;
4569   pts[c*2+0] = point;
4570   pts[c*2+1] = 0;
4571   ++c;
4572   for (cl = 0; cl < clSize*2; cl += 2, ++c) {pts[c*2+0] = closure[cl]; pts[c*2+1] = closure[cl+1];}
4573   ierr = DMPlexGetTransitiveClosure(dm, cone[1], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4574   for (cl = 0; cl < clSize*2; cl += 2, ++c) {pts[c*2+0] = closure[cl]; pts[c*2+1] = closure[cl+1];}
4575   ierr = DMPlexRestoreTransitiveClosure(dm, cone[0], PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
4576   if (dim >= 2) {
4577     for (d = 2; d < coneSize; ++d, ++c) {pts[c*2+0] = cone[d]; pts[c*2+1] = ornt[d];}
4578   }
4579   if (dim >= 3) {
4580     for (d = 2; d < coneSize; ++d) {
4581       const PetscInt  fpoint = cone[d];
4582       const PetscInt *fcone;
4583       PetscInt        fconeSize, fc, i;
4584 
4585       ierr = DMPlexGetConeSize(dm, fpoint, &fconeSize);CHKERRQ(ierr);
4586       ierr = DMPlexGetCone(dm, fpoint, &fcone);CHKERRQ(ierr);
4587       for (fc = 0; fc < fconeSize; ++fc) {
4588         for (i = 0; i < c; ++i) if (pts[i*2] == fcone[fc]) break;
4589         if (i == c) {pts[c*2+0] = fcone[fc]; pts[c*2+1] = 0; ++c;}
4590       }
4591     }
4592   }
4593   if (c != np) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid closure for hybrid point %D, size %D != %D", point, c, np);
4594   *numPoints = np;
4595   *points    = pts;
4596   PetscFunctionReturn(0);
4597 }
4598 
4599 /* Compressed closure does not apply closure permutation */
DMPlexGetCompressedClosure(DM dm,PetscSection section,PetscInt point,PetscInt * numPoints,PetscInt ** points,PetscSection * clSec,IS * clPoints,const PetscInt ** clp)4600 PetscErrorCode DMPlexGetCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
4601 {
4602   const PetscInt *cla = NULL;
4603   PetscInt       np, *pts = NULL;
4604   PetscErrorCode ierr;
4605 
4606   PetscFunctionBeginHot;
4607   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, clSec, clPoints);CHKERRQ(ierr);
4608   if (*clPoints) {
4609     PetscInt dof, off;
4610 
4611     ierr = PetscSectionGetDof(*clSec, point, &dof);CHKERRQ(ierr);
4612     ierr = PetscSectionGetOffset(*clSec, point, &off);CHKERRQ(ierr);
4613     ierr = ISGetIndices(*clPoints, &cla);CHKERRQ(ierr);
4614     np   = dof/2;
4615     pts  = (PetscInt *) &cla[off];
4616   } else {
4617     DMPolytopeType ct;
4618 
4619     /* Do not make the label if it does not exist */
4620     if (!dm->celltypeLabel) {ct = DM_POLYTOPE_POINT;}
4621     else                    {ierr = DMPlexGetCellType(dm, point, &ct);CHKERRQ(ierr);}
4622     switch (ct) {
4623       case DM_POLYTOPE_SEG_PRISM_TENSOR:
4624         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 9, &np, &pts);CHKERRQ(ierr);
4625         break;
4626       case DM_POLYTOPE_TRI_PRISM_TENSOR:
4627         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 21, &np, &pts);CHKERRQ(ierr);
4628         break;
4629       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
4630         ierr = DMPlexTransitiveClosure_Hybrid_Internal(dm, point, 27, &np, &pts);CHKERRQ(ierr);
4631         break;
4632       default:
4633         ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &np, &pts);CHKERRQ(ierr);
4634     }
4635     ierr = CompressPoints_Private(section, &np, pts);CHKERRQ(ierr);
4636   }
4637   *numPoints = np;
4638   *points    = pts;
4639   *clp       = cla;
4640   PetscFunctionReturn(0);
4641 }
4642 
DMPlexRestoreCompressedClosure(DM dm,PetscSection section,PetscInt point,PetscInt * numPoints,PetscInt ** points,PetscSection * clSec,IS * clPoints,const PetscInt ** clp)4643 PetscErrorCode DMPlexRestoreCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
4644 {
4645   PetscErrorCode ierr;
4646 
4647   PetscFunctionBeginHot;
4648   if (!*clPoints) {
4649     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, numPoints, points);CHKERRQ(ierr);
4650   } else {
4651     ierr = ISRestoreIndices(*clPoints, clp);CHKERRQ(ierr);
4652   }
4653   *numPoints = 0;
4654   *points    = NULL;
4655   *clSec     = NULL;
4656   *clPoints  = NULL;
4657   *clp       = NULL;
4658   PetscFunctionReturn(0);
4659 }
4660 
DMPlexVecGetClosure_Static(DM dm,PetscSection section,PetscInt numPoints,const PetscInt points[],const PetscInt clperm[],const PetscScalar vArray[],PetscInt * size,PetscScalar array[])4661 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[])
4662 {
4663   PetscInt          offset = 0, p;
4664   const PetscInt    **perms = NULL;
4665   const PetscScalar **flips = NULL;
4666   PetscErrorCode    ierr;
4667 
4668   PetscFunctionBeginHot;
4669   *size = 0;
4670   ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4671   for (p = 0; p < numPoints; p++) {
4672     const PetscInt    point = points[2*p];
4673     const PetscInt    *perm = perms ? perms[p] : NULL;
4674     const PetscScalar *flip = flips ? flips[p] : NULL;
4675     PetscInt          dof, off, d;
4676     const PetscScalar *varr;
4677 
4678     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4679     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4680     varr = &vArray[off];
4681     if (clperm) {
4682       if (perm) {
4683         for (d = 0; d < dof; d++) array[clperm[offset + perm[d]]]  = varr[d];
4684       } else {
4685         for (d = 0; d < dof; d++) array[clperm[offset +      d ]]  = varr[d];
4686       }
4687       if (flip) {
4688         for (d = 0; d < dof; d++) array[clperm[offset +      d ]] *= flip[d];
4689       }
4690     } else {
4691       if (perm) {
4692         for (d = 0; d < dof; d++) array[offset + perm[d]]  = varr[d];
4693       } else {
4694         for (d = 0; d < dof; d++) array[offset +      d ]  = varr[d];
4695       }
4696       if (flip) {
4697         for (d = 0; d < dof; d++) array[offset +      d ] *= flip[d];
4698       }
4699     }
4700     offset += dof;
4701   }
4702   ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4703   *size = offset;
4704   PetscFunctionReturn(0);
4705 }
4706 
DMPlexVecGetClosure_Fields_Static(DM dm,PetscSection section,PetscInt numPoints,const PetscInt points[],PetscInt numFields,const PetscInt clperm[],const PetscScalar vArray[],PetscInt * size,PetscScalar array[])4707 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[])
4708 {
4709   PetscInt          offset = 0, f;
4710   PetscErrorCode    ierr;
4711 
4712   PetscFunctionBeginHot;
4713   *size = 0;
4714   for (f = 0; f < numFields; ++f) {
4715     PetscInt          p;
4716     const PetscInt    **perms = NULL;
4717     const PetscScalar **flips = NULL;
4718 
4719     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4720     for (p = 0; p < numPoints; p++) {
4721       const PetscInt    point = points[2*p];
4722       PetscInt          fdof, foff, b;
4723       const PetscScalar *varr;
4724       const PetscInt    *perm = perms ? perms[p] : NULL;
4725       const PetscScalar *flip = flips ? flips[p] : NULL;
4726 
4727       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4728       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4729       varr = &vArray[foff];
4730       if (clperm) {
4731         if (perm) {for (b = 0; b < fdof; b++) {array[clperm[offset + perm[b]]]  = varr[b];}}
4732         else      {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]]  = varr[b];}}
4733         if (flip) {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]] *= flip[b];}}
4734       } else {
4735         if (perm) {for (b = 0; b < fdof; b++) {array[offset + perm[b]]  = varr[b];}}
4736         else      {for (b = 0; b < fdof; b++) {array[offset +      b ]  = varr[b];}}
4737         if (flip) {for (b = 0; b < fdof; b++) {array[offset +      b ] *= flip[b];}}
4738       }
4739       offset += fdof;
4740     }
4741     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4742   }
4743   *size = offset;
4744   PetscFunctionReturn(0);
4745 }
4746 
4747 /*@C
4748   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
4749 
4750   Not collective
4751 
4752   Input Parameters:
4753 + dm - The DM
4754 . section - The section describing the layout in v, or NULL to use the default section
4755 . v - The local vector
4756 . point - The point in the DM
4757 . csize - The size of the input values array, or NULL
4758 - values - An array to use for the values, or NULL to have it allocated automatically
4759 
4760   Output Parameters:
4761 + csize - The number of values in the closure
4762 - values - The array of values. If the user provided NULL, it is a borrowed array and should not be freed
4763 
4764 $ Note that DMPlexVecGetClosure/DMPlexVecRestoreClosure only allocates the values array if it set to NULL in the
4765 $ calling function. This is because DMPlexVecGetClosure() is typically called in the inner loop of a Vec or Mat
4766 $ assembly function, and a user may already have allocated storage for this operation.
4767 $
4768 $ A typical use could be
4769 $
4770 $  values = NULL;
4771 $  ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4772 $  for (cl = 0; cl < clSize; ++cl) {
4773 $    <Compute on closure>
4774 $  }
4775 $  ierr = DMPlexVecRestoreClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4776 $
4777 $ or
4778 $
4779 $  PetscMalloc1(clMaxSize, &values);
4780 $  for (p = pStart; p < pEnd; ++p) {
4781 $    clSize = clMaxSize;
4782 $    ierr = DMPlexVecGetClosure(dm, NULL, v, p, &clSize, &values);CHKERRQ(ierr);
4783 $    for (cl = 0; cl < clSize; ++cl) {
4784 $      <Compute on closure>
4785 $    }
4786 $  }
4787 $  PetscFree(values);
4788 
4789   Fortran Notes:
4790   Since it returns an array, this routine is only available in Fortran 90, and you must
4791   include petsc.h90 in your code.
4792 
4793   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4794 
4795   Level: intermediate
4796 
4797 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4798 @*/
DMPlexVecGetClosure(DM dm,PetscSection section,Vec v,PetscInt point,PetscInt * csize,PetscScalar * values[])4799 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4800 {
4801   PetscSection       clSection;
4802   IS                 clPoints;
4803   PetscInt          *points = NULL;
4804   const PetscInt    *clp, *perm;
4805   PetscInt           depth, numFields, numPoints, asize;
4806   PetscErrorCode     ierr;
4807 
4808   PetscFunctionBeginHot;
4809   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4810   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4811   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4812   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4813   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4814   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4815   if (depth == 1 && numFields < 2) {
4816     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4817     PetscFunctionReturn(0);
4818   }
4819   /* Get points */
4820   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4821   /* Get sizes */
4822   asize = 0;
4823   for (PetscInt p = 0; p < numPoints*2; p += 2) {
4824     PetscInt dof;
4825     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4826     asize += dof;
4827   }
4828   if (values) {
4829     const PetscScalar *vArray;
4830     PetscInt          size;
4831 
4832     if (*values) {
4833       if (PetscUnlikely(*csize < asize)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Provided array size %D not sufficient to hold closure size %D", *csize, asize);
4834     } else {ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, values);CHKERRQ(ierr);}
4835     ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, asize, &perm);CHKERRQ(ierr);
4836     ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4837     /* Get values */
4838     if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, numPoints, points, numFields, perm, vArray, &size, *values);CHKERRQ(ierr);}
4839     else               {ierr = DMPlexVecGetClosure_Static(dm, section, numPoints, points, perm, vArray, &size, *values);CHKERRQ(ierr);}
4840     if (PetscUnlikely(asize != size)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Section size %D does not match Vec closure size %D", asize, size);
4841     /* Cleanup array */
4842     ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4843   }
4844   if (csize) *csize = asize;
4845   /* Cleanup points */
4846   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4847   PetscFunctionReturn(0);
4848 }
4849 
DMPlexVecGetClosureAtDepth_Internal(DM dm,PetscSection section,Vec v,PetscInt point,PetscInt depth,PetscInt * csize,PetscScalar * values[])4850 PetscErrorCode DMPlexVecGetClosureAtDepth_Internal(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt depth, PetscInt *csize, PetscScalar *values[])
4851 {
4852   DMLabel            depthLabel;
4853   PetscSection       clSection;
4854   IS                 clPoints;
4855   PetscScalar       *array;
4856   const PetscScalar *vArray;
4857   PetscInt          *points = NULL;
4858   const PetscInt    *clp, *perm = NULL;
4859   PetscInt           mdepth, numFields, numPoints, Np = 0, p, clsize, size;
4860   PetscErrorCode     ierr;
4861 
4862   PetscFunctionBeginHot;
4863   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4864   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
4865   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4866   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4867   ierr = DMPlexGetDepth(dm, &mdepth);CHKERRQ(ierr);
4868   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4869   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4870   if (mdepth == 1 && numFields < 2) {
4871     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
4872     PetscFunctionReturn(0);
4873   }
4874   /* Get points */
4875   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4876   for (clsize=0,p=0; p<Np; p++) {
4877     PetscInt dof;
4878     ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
4879     clsize += dof;
4880   }
4881   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &perm);CHKERRQ(ierr);
4882   /* Filter points */
4883   for (p = 0; p < numPoints*2; p += 2) {
4884     PetscInt dep;
4885 
4886     ierr = DMLabelGetValue(depthLabel, points[p], &dep);CHKERRQ(ierr);
4887     if (dep != depth) continue;
4888     points[Np*2+0] = points[p];
4889     points[Np*2+1] = points[p+1];
4890     ++Np;
4891   }
4892   /* Get array */
4893   if (!values || !*values) {
4894     PetscInt asize = 0, dof;
4895 
4896     for (p = 0; p < Np*2; p += 2) {
4897       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
4898       asize += dof;
4899     }
4900     if (!values) {
4901       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4902       if (csize) *csize = asize;
4903       PetscFunctionReturn(0);
4904     }
4905     ierr = DMGetWorkArray(dm, asize, MPIU_SCALAR, &array);CHKERRQ(ierr);
4906   } else {
4907     array = *values;
4908   }
4909   ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
4910   /* Get values */
4911   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, Np, points, numFields, perm, vArray, &size, array);CHKERRQ(ierr);}
4912   else               {ierr = DMPlexVecGetClosure_Static(dm, section, Np, points, perm, vArray, &size, array);CHKERRQ(ierr);}
4913   /* Cleanup points */
4914   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4915   /* Cleanup array */
4916   ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
4917   if (!*values) {
4918     if (csize) *csize = size;
4919     *values = array;
4920   } else {
4921     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
4922     *csize = size;
4923   }
4924   PetscFunctionReturn(0);
4925 }
4926 
4927 /*@C
4928   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
4929 
4930   Not collective
4931 
4932   Input Parameters:
4933 + dm - The DM
4934 . section - The section describing the layout in v, or NULL to use the default section
4935 . v - The local vector
4936 . point - The point in the DM
4937 . csize - The number of values in the closure, or NULL
4938 - values - The array of values, which is a borrowed array and should not be freed
4939 
4940   Note that the array values are discarded and not copied back into v. In order to copy values back to v, use DMPlexVecSetClosure()
4941 
4942   Fortran Notes:
4943   Since it returns an array, this routine is only available in Fortran 90, and you must
4944   include petsc.h90 in your code.
4945 
4946   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
4947 
4948   Level: intermediate
4949 
4950 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
4951 @*/
DMPlexVecRestoreClosure(DM dm,PetscSection section,Vec v,PetscInt point,PetscInt * csize,PetscScalar * values[])4952 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
4953 {
4954   PetscInt       size = 0;
4955   PetscErrorCode ierr;
4956 
4957   PetscFunctionBegin;
4958   /* Should work without recalculating size */
4959   ierr = DMRestoreWorkArray(dm, size, MPIU_SCALAR, (void*) values);CHKERRQ(ierr);
4960   *values = NULL;
4961   PetscFunctionReturn(0);
4962 }
4963 
add(PetscScalar * x,PetscScalar y)4964 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
insert(PetscScalar * x,PetscScalar y)4965 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
4966 
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[])4967 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[])
4968 {
4969   PetscInt        cdof;   /* The number of constraints on this point */
4970   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4971   PetscScalar    *a;
4972   PetscInt        off, cind = 0, k;
4973   PetscErrorCode  ierr;
4974 
4975   PetscFunctionBegin;
4976   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4977   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
4978   a    = &array[off];
4979   if (!cdof || setBC) {
4980     if (clperm) {
4981       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
4982       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
4983     } else {
4984       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
4985       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
4986     }
4987   } else {
4988     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4989     if (clperm) {
4990       if (perm) {for (k = 0; k < dof; ++k) {
4991           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4992           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
4993         }
4994       } else {
4995         for (k = 0; k < dof; ++k) {
4996           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4997           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
4998         }
4999       }
5000     } else {
5001       if (perm) {
5002         for (k = 0; k < dof; ++k) {
5003           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5004           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
5005         }
5006       } else {
5007         for (k = 0; k < dof; ++k) {
5008           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5009           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
5010         }
5011       }
5012     }
5013   }
5014   PetscFunctionReturn(0);
5015 }
5016 
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[])5017 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[])
5018 {
5019   PetscInt        cdof;   /* The number of constraints on this point */
5020   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5021   PetscScalar    *a;
5022   PetscInt        off, cind = 0, k;
5023   PetscErrorCode  ierr;
5024 
5025   PetscFunctionBegin;
5026   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5027   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
5028   a    = &array[off];
5029   if (cdof) {
5030     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5031     if (clperm) {
5032       if (perm) {
5033         for (k = 0; k < dof; ++k) {
5034           if ((cind < cdof) && (k == cdofs[cind])) {
5035             fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
5036             cind++;
5037           }
5038         }
5039       } else {
5040         for (k = 0; k < dof; ++k) {
5041           if ((cind < cdof) && (k == cdofs[cind])) {
5042             fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
5043             cind++;
5044           }
5045         }
5046       }
5047     } else {
5048       if (perm) {
5049         for (k = 0; k < dof; ++k) {
5050           if ((cind < cdof) && (k == cdofs[cind])) {
5051             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
5052             cind++;
5053           }
5054         }
5055       } else {
5056         for (k = 0; k < dof; ++k) {
5057           if ((cind < cdof) && (k == cdofs[cind])) {
5058             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
5059             cind++;
5060           }
5061         }
5062       }
5063     }
5064   }
5065   PetscFunctionReturn(0);
5066 }
5067 
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[])5068 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[])
5069 {
5070   PetscScalar    *a;
5071   PetscInt        fdof, foff, fcdof, foffset = *offset;
5072   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5073   PetscInt        cind = 0, b;
5074   PetscErrorCode  ierr;
5075 
5076   PetscFunctionBegin;
5077   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5078   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5079   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5080   a    = &array[foff];
5081   if (!fcdof || setBC) {
5082     if (clperm) {
5083       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
5084       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
5085     } else {
5086       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
5087       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
5088     }
5089   } else {
5090     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5091     if (clperm) {
5092       if (perm) {
5093         for (b = 0; b < fdof; b++) {
5094           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5095           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
5096         }
5097       } else {
5098         for (b = 0; b < fdof; b++) {
5099           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5100           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
5101         }
5102       }
5103     } else {
5104       if (perm) {
5105         for (b = 0; b < fdof; b++) {
5106           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5107           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
5108         }
5109       } else {
5110         for (b = 0; b < fdof; b++) {
5111           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
5112           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
5113         }
5114       }
5115     }
5116   }
5117   *offset += fdof;
5118   PetscFunctionReturn(0);
5119 }
5120 
updatePointFieldsBC_private(PetscSection section,PetscInt point,const PetscInt perm[],const PetscScalar flip[],PetscInt f,PetscInt Ncc,const PetscInt comps[],void (* fuse)(PetscScalar *,PetscScalar),const PetscInt clperm[],const PetscScalar values[],PetscInt * offset,PetscScalar array[])5121 PETSC_STATIC_INLINE PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, const PetscInt perm[], const PetscScalar flip[], PetscInt f, PetscInt Ncc, const PetscInt comps[], void (*fuse)(PetscScalar*, PetscScalar), const PetscInt clperm[], const PetscScalar values[], PetscInt *offset, PetscScalar array[])
5122 {
5123   PetscScalar    *a;
5124   PetscInt        fdof, foff, fcdof, foffset = *offset;
5125   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5126   PetscInt        Nc, cind = 0, ncind = 0, b;
5127   PetscBool       ncSet, fcSet;
5128   PetscErrorCode  ierr;
5129 
5130   PetscFunctionBegin;
5131   ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
5132   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5133   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
5134   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
5135   a    = &array[foff];
5136   if (fcdof) {
5137     /* We just override fcdof and fcdofs with Ncc and comps */
5138     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5139     if (clperm) {
5140       if (perm) {
5141         if (comps) {
5142           for (b = 0; b < fdof; b++) {
5143             ncSet = fcSet = PETSC_FALSE;
5144             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5145             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5146             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}
5147           }
5148         } else {
5149           for (b = 0; b < fdof; b++) {
5150             if ((cind < fcdof) && (b == fcdofs[cind])) {
5151               fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
5152               ++cind;
5153             }
5154           }
5155         }
5156       } else {
5157         if (comps) {
5158           for (b = 0; b < fdof; b++) {
5159             ncSet = fcSet = PETSC_FALSE;
5160             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5161             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5162             if (ncSet && fcSet) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}
5163           }
5164         } else {
5165           for (b = 0; b < fdof; b++) {
5166             if ((cind < fcdof) && (b == fcdofs[cind])) {
5167               fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
5168               ++cind;
5169             }
5170           }
5171         }
5172       }
5173     } else {
5174       if (perm) {
5175         if (comps) {
5176           for (b = 0; b < fdof; b++) {
5177             ncSet = fcSet = PETSC_FALSE;
5178             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5179             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5180             if (ncSet && fcSet) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}
5181           }
5182         } else {
5183           for (b = 0; b < fdof; b++) {
5184             if ((cind < fcdof) && (b == fcdofs[cind])) {
5185               fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
5186               ++cind;
5187             }
5188           }
5189         }
5190       } else {
5191         if (comps) {
5192           for (b = 0; b < fdof; b++) {
5193             ncSet = fcSet = PETSC_FALSE;
5194             if (b%Nc == comps[ncind]) {ncind = (ncind+1)%Ncc; ncSet = PETSC_TRUE;}
5195             if ((cind < fcdof) && (b == fcdofs[cind])) {++cind;  fcSet = PETSC_TRUE;}
5196             if (ncSet && fcSet) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}
5197           }
5198         } else {
5199           for (b = 0; b < fdof; b++) {
5200             if ((cind < fcdof) && (b == fcdofs[cind])) {
5201               fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
5202               ++cind;
5203             }
5204           }
5205         }
5206       }
5207     }
5208   }
5209   *offset += fdof;
5210   PetscFunctionReturn(0);
5211 }
5212 
DMPlexVecSetClosure_Depth1_Static(DM dm,PetscSection section,Vec v,PetscInt point,const PetscScalar values[],InsertMode mode)5213 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5214 {
5215   PetscScalar    *array;
5216   const PetscInt *cone, *coneO;
5217   PetscInt        pStart, pEnd, p, numPoints, off, dof;
5218   PetscErrorCode  ierr;
5219 
5220   PetscFunctionBeginHot;
5221   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
5222   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
5223   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
5224   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
5225   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5226   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
5227     const PetscInt cp = !p ? point : cone[p-1];
5228     const PetscInt o  = !p ? 0     : coneO[p-1];
5229 
5230     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
5231     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
5232     /* ADD_VALUES */
5233     {
5234       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5235       PetscScalar    *a;
5236       PetscInt        cdof, coff, cind = 0, k;
5237 
5238       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
5239       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
5240       a    = &array[coff];
5241       if (!cdof) {
5242         if (o >= 0) {
5243           for (k = 0; k < dof; ++k) {
5244             a[k] += values[off+k];
5245           }
5246         } else {
5247           for (k = 0; k < dof; ++k) {
5248             a[k] += values[off+dof-k-1];
5249           }
5250         }
5251       } else {
5252         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
5253         if (o >= 0) {
5254           for (k = 0; k < dof; ++k) {
5255             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5256             a[k] += values[off+k];
5257           }
5258         } else {
5259           for (k = 0; k < dof; ++k) {
5260             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
5261             a[k] += values[off+dof-k-1];
5262           }
5263         }
5264       }
5265     }
5266   }
5267   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5268   PetscFunctionReturn(0);
5269 }
5270 
5271 /*@C
5272   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
5273 
5274   Not collective
5275 
5276   Input Parameters:
5277 + dm - The DM
5278 . section - The section describing the layout in v, or NULL to use the default section
5279 . v - The local vector
5280 . point - The point in the DM
5281 . values - The array of values
5282 - mode - The insert mode. One of INSERT_ALL_VALUES, ADD_ALL_VALUES, INSERT_VALUES, ADD_VALUES, INSERT_BC_VALUES, and ADD_BC_VALUES,
5283          where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions.
5284 
5285   Fortran Notes:
5286   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5287 
5288   Level: intermediate
5289 
5290 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
5291 @*/
DMPlexVecSetClosure(DM dm,PetscSection section,Vec v,PetscInt point,const PetscScalar values[],InsertMode mode)5292 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
5293 {
5294   PetscSection    clSection;
5295   IS              clPoints;
5296   PetscScalar    *array;
5297   PetscInt       *points = NULL;
5298   const PetscInt *clp, *clperm = NULL;
5299   PetscInt        depth, numFields, numPoints, p, clsize;
5300   PetscErrorCode  ierr;
5301 
5302   PetscFunctionBeginHot;
5303   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5304   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
5305   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5306   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5307   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5308   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5309   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
5310     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
5311     PetscFunctionReturn(0);
5312   }
5313   /* Get points */
5314   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5315   for (clsize=0,p=0; p<numPoints; p++) {
5316     PetscInt dof;
5317     ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
5318     clsize += dof;
5319   }
5320   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &clperm);CHKERRQ(ierr);
5321   /* Get array */
5322   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5323   /* Get values */
5324   if (numFields > 0) {
5325     PetscInt offset = 0, f;
5326     for (f = 0; f < numFields; ++f) {
5327       const PetscInt    **perms = NULL;
5328       const PetscScalar **flips = NULL;
5329 
5330       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5331       switch (mode) {
5332       case INSERT_VALUES:
5333         for (p = 0; p < numPoints; p++) {
5334           const PetscInt    point = points[2*p];
5335           const PetscInt    *perm = perms ? perms[p] : NULL;
5336           const PetscScalar *flip = flips ? flips[p] : NULL;
5337           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
5338         } break;
5339       case INSERT_ALL_VALUES:
5340         for (p = 0; p < numPoints; p++) {
5341           const PetscInt    point = points[2*p];
5342           const PetscInt    *perm = perms ? perms[p] : NULL;
5343           const PetscScalar *flip = flips ? flips[p] : NULL;
5344           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
5345         } break;
5346       case INSERT_BC_VALUES:
5347         for (p = 0; p < numPoints; p++) {
5348           const PetscInt    point = points[2*p];
5349           const PetscInt    *perm = perms ? perms[p] : NULL;
5350           const PetscScalar *flip = flips ? flips[p] : NULL;
5351           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, insert, clperm, values, &offset, array);
5352         } break;
5353       case ADD_VALUES:
5354         for (p = 0; p < numPoints; p++) {
5355           const PetscInt    point = points[2*p];
5356           const PetscInt    *perm = perms ? perms[p] : NULL;
5357           const PetscScalar *flip = flips ? flips[p] : NULL;
5358           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
5359         } break;
5360       case ADD_ALL_VALUES:
5361         for (p = 0; p < numPoints; p++) {
5362           const PetscInt    point = points[2*p];
5363           const PetscInt    *perm = perms ? perms[p] : NULL;
5364           const PetscScalar *flip = flips ? flips[p] : NULL;
5365           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
5366         } break;
5367       case ADD_BC_VALUES:
5368         for (p = 0; p < numPoints; p++) {
5369           const PetscInt    point = points[2*p];
5370           const PetscInt    *perm = perms ? perms[p] : NULL;
5371           const PetscScalar *flip = flips ? flips[p] : NULL;
5372           updatePointFieldsBC_private(section, point, perm, flip, f, -1, NULL, add, clperm, values, &offset, array);
5373         } break;
5374       default:
5375         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5376       }
5377       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5378     }
5379   } else {
5380     PetscInt dof, off;
5381     const PetscInt    **perms = NULL;
5382     const PetscScalar **flips = NULL;
5383 
5384     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5385     switch (mode) {
5386     case INSERT_VALUES:
5387       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5388         const PetscInt    point = points[2*p];
5389         const PetscInt    *perm = perms ? perms[p] : NULL;
5390         const PetscScalar *flip = flips ? flips[p] : NULL;
5391         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5392         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
5393       } break;
5394     case INSERT_ALL_VALUES:
5395       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5396         const PetscInt    point = points[2*p];
5397         const PetscInt    *perm = perms ? perms[p] : NULL;
5398         const PetscScalar *flip = flips ? flips[p] : NULL;
5399         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5400         updatePoint_private(section, point, dof, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
5401       } break;
5402     case INSERT_BC_VALUES:
5403       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5404         const PetscInt    point = points[2*p];
5405         const PetscInt    *perm = perms ? perms[p] : NULL;
5406         const PetscScalar *flip = flips ? flips[p] : NULL;
5407         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5408         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
5409       } break;
5410     case ADD_VALUES:
5411       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5412         const PetscInt    point = points[2*p];
5413         const PetscInt    *perm = perms ? perms[p] : NULL;
5414         const PetscScalar *flip = flips ? flips[p] : NULL;
5415         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5416         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
5417       } break;
5418     case ADD_ALL_VALUES:
5419       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5420         const PetscInt    point = points[2*p];
5421         const PetscInt    *perm = perms ? perms[p] : NULL;
5422         const PetscScalar *flip = flips ? flips[p] : NULL;
5423         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5424         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
5425       } break;
5426     case ADD_BC_VALUES:
5427       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
5428         const PetscInt    point = points[2*p];
5429         const PetscInt    *perm = perms ? perms[p] : NULL;
5430         const PetscScalar *flip = flips ? flips[p] : NULL;
5431         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5432         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
5433       } break;
5434     default:
5435       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5436     }
5437     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5438   }
5439   /* Cleanup points */
5440   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5441   /* Cleanup array */
5442   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5443   PetscFunctionReturn(0);
5444 }
5445 
5446 /* Check whether the given point is in the label. If not, update the offset to skip this point */
CheckPoint_Private(DMLabel label,PetscInt labelId,PetscSection section,PetscInt point,PetscInt f,PetscInt * offset)5447 PETSC_STATIC_INLINE PetscErrorCode CheckPoint_Private(DMLabel label, PetscInt labelId, PetscSection section, PetscInt point, PetscInt f, PetscInt *offset)
5448 {
5449   PetscFunctionBegin;
5450   if (label) {
5451     PetscInt       val, fdof;
5452     PetscErrorCode ierr;
5453 
5454     /* There is a problem with this:
5455          Suppose we have two label values, defining surfaces, interecting along a line in 3D. When we add cells to the label, the cells that
5456        touch both surfaces must pick a label value. Thus we miss setting values for the surface with that other value intersecting that cell.
5457        Thus I am only going to check val != -1, not val != labelId
5458     */
5459     ierr = DMLabelGetValue(label, point, &val);CHKERRQ(ierr);
5460     if (val < 0) {
5461       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5462       *offset += fdof;
5463       PetscFunctionReturn(1);
5464     }
5465   }
5466   PetscFunctionReturn(0);
5467 }
5468 
5469 /* Unlike DMPlexVecSetClosure(), this uses plex-native closure permutation, not a user-specified permutation such as DMPlexSetClosurePermutationTensor(). */
DMPlexVecSetFieldClosure_Internal(DM dm,PetscSection section,Vec v,PetscBool fieldActive[],PetscInt point,PetscInt Ncc,const PetscInt comps[],DMLabel label,PetscInt labelId,const PetscScalar values[],InsertMode mode)5470 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, PetscInt Ncc, const PetscInt comps[], DMLabel label, PetscInt labelId, const PetscScalar values[], InsertMode mode)
5471 {
5472   PetscSection      clSection;
5473   IS                clPoints;
5474   PetscScalar       *array;
5475   PetscInt          *points = NULL;
5476   const PetscInt    *clp;
5477   PetscInt          numFields, numPoints, p;
5478   PetscInt          offset = 0, f;
5479   PetscErrorCode    ierr;
5480 
5481   PetscFunctionBeginHot;
5482   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5483   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
5484   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5485   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
5486   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5487   /* Get points */
5488   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5489   /* Get array */
5490   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
5491   /* Get values */
5492   for (f = 0; f < numFields; ++f) {
5493     const PetscInt    **perms = NULL;
5494     const PetscScalar **flips = NULL;
5495 
5496     if (!fieldActive[f]) {
5497       for (p = 0; p < numPoints*2; p += 2) {
5498         PetscInt fdof;
5499         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5500         offset += fdof;
5501       }
5502       continue;
5503     }
5504     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5505     switch (mode) {
5506     case INSERT_VALUES:
5507       for (p = 0; p < numPoints; p++) {
5508         const PetscInt    point = points[2*p];
5509         const PetscInt    *perm = perms ? perms[p] : NULL;
5510         const PetscScalar *flip = flips ? flips[p] : NULL;
5511         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5512         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, NULL, values, &offset, array);
5513       } break;
5514     case INSERT_ALL_VALUES:
5515       for (p = 0; p < numPoints; p++) {
5516         const PetscInt    point = points[2*p];
5517         const PetscInt    *perm = perms ? perms[p] : NULL;
5518         const PetscScalar *flip = flips ? flips[p] : NULL;
5519         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5520         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, NULL, values, &offset, array);
5521       } break;
5522     case INSERT_BC_VALUES:
5523       for (p = 0; p < numPoints; p++) {
5524         const PetscInt    point = points[2*p];
5525         const PetscInt    *perm = perms ? perms[p] : NULL;
5526         const PetscScalar *flip = flips ? flips[p] : NULL;
5527         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5528         updatePointFieldsBC_private(section, point, perm, flip, f, Ncc, comps, insert, NULL, values, &offset, array);
5529       } break;
5530     case ADD_VALUES:
5531       for (p = 0; p < numPoints; p++) {
5532         const PetscInt    point = points[2*p];
5533         const PetscInt    *perm = perms ? perms[p] : NULL;
5534         const PetscScalar *flip = flips ? flips[p] : NULL;
5535         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5536         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, NULL, values, &offset, array);
5537       } break;
5538     case ADD_ALL_VALUES:
5539       for (p = 0; p < numPoints; p++) {
5540         const PetscInt    point = points[2*p];
5541         const PetscInt    *perm = perms ? perms[p] : NULL;
5542         const PetscScalar *flip = flips ? flips[p] : NULL;
5543         ierr = CheckPoint_Private(label, labelId, section, point, f, &offset); if (ierr) continue;
5544         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, NULL, values, &offset, array);
5545       } break;
5546     default:
5547       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
5548     }
5549     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
5550   }
5551   /* Cleanup points */
5552   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5553   /* Cleanup array */
5554   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
5555   PetscFunctionReturn(0);
5556 }
5557 
DMPlexPrintMatSetValues(PetscViewer viewer,Mat A,PetscInt point,PetscInt numRIndices,const PetscInt rindices[],PetscInt numCIndices,const PetscInt cindices[],const PetscScalar values[])5558 static PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
5559 {
5560   PetscMPIInt    rank;
5561   PetscInt       i, j;
5562   PetscErrorCode ierr;
5563 
5564   PetscFunctionBegin;
5565   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
5566   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for point %D\n", rank, point);CHKERRQ(ierr);
5567   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
5568   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
5569   numCIndices = numCIndices ? numCIndices : numRIndices;
5570   if (!values) PetscFunctionReturn(0);
5571   for (i = 0; i < numRIndices; i++) {
5572     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
5573     for (j = 0; j < numCIndices; j++) {
5574 #if defined(PETSC_USE_COMPLEX)
5575       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
5576 #else
5577       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
5578 #endif
5579     }
5580     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
5581   }
5582   PetscFunctionReturn(0);
5583 }
5584 
5585 /*
5586   DMPlexGetIndicesPoint_Internal - Add the indices for dofs on a point to an index array
5587 
5588   Input Parameters:
5589 + section - The section for this data layout
5590 . islocal - Is the section (and thus indices being requested) local or global?
5591 . point   - The point contributing dofs with these indices
5592 . off     - The global offset of this point
5593 . loff    - The local offset of each field
5594 . setBC   - The flag determining whether to include indices of bounsary values
5595 . perm    - A permutation of the dofs on this point, or NULL
5596 - indperm - A permutation of the entire indices array, or NULL
5597 
5598   Output Parameter:
5599 . indices - Indices for dofs on this point
5600 
5601   Level: developer
5602 
5603   Note: The indices could be local or global, depending on the value of 'off'.
5604 */
DMPlexGetIndicesPoint_Internal(PetscSection section,PetscBool islocal,PetscInt point,PetscInt off,PetscInt * loff,PetscBool setBC,const PetscInt perm[],const PetscInt indperm[],PetscInt indices[])5605 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscBool islocal,PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], const PetscInt indperm[], PetscInt indices[])
5606 {
5607   PetscInt        dof;   /* The number of unknowns on this point */
5608   PetscInt        cdof;  /* The number of constraints on this point */
5609   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
5610   PetscInt        cind = 0, k;
5611   PetscErrorCode  ierr;
5612 
5613   PetscFunctionBegin;
5614   if (!islocal && setBC) SETERRQ(PetscObjectComm((PetscObject)section),PETSC_ERR_ARG_INCOMP,"setBC incompatible with global indices; use a local section or disable setBC");
5615   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
5616   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
5617   if (!cdof || setBC) {
5618     for (k = 0; k < dof; ++k) {
5619       const PetscInt preind = perm ? *loff+perm[k] : *loff+k;
5620       const PetscInt ind    = indperm ? indperm[preind] : preind;
5621 
5622       indices[ind] = off + k;
5623     }
5624   } else {
5625     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
5626     for (k = 0; k < dof; ++k) {
5627       const PetscInt preind = perm ? *loff+perm[k] : *loff+k;
5628       const PetscInt ind    = indperm ? indperm[preind] : preind;
5629 
5630       if ((cind < cdof) && (k == cdofs[cind])) {
5631         /* Insert check for returning constrained indices */
5632         indices[ind] = -(off+k+1);
5633         ++cind;
5634       } else {
5635         indices[ind] = off + k - (islocal ? 0 : cind);
5636       }
5637     }
5638   }
5639   *loff += dof;
5640   PetscFunctionReturn(0);
5641 }
5642 
5643 /*
5644  DMPlexGetIndicesPointFields_Internal - gets section indices for a point in its canonical ordering.
5645 
5646  Input Parameters:
5647 + section - a section (global or local)
5648 - islocal - PETSC_TRUE if requesting local indices (i.e., section is local); PETSC_FALSE for global
5649 . point - point within section
5650 . off - The offset of this point in the (local or global) indexed space - should match islocal and (usually) the section
5651 . foffs - array of length numFields containing the offset in canonical point ordering (the location in indices) of each field
5652 . setBC - identify constrained (boundary condition) points via involution.
5653 . perms - perms[f][permsoff][:] is a permutation of dofs within each field
5654 . permsoff - offset
5655 - indperm - index permutation
5656 
5657  Output Parameter:
5658 . foffs - each entry is incremented by the number of (unconstrained if setBC=FALSE) dofs in that field
5659 . indices - array to hold indices (as defined by section) of each dof associated with point
5660 
5661  Notes:
5662  If section is local and setBC=true, there is no distinction between constrained and unconstrained dofs.
5663  If section is local and setBC=false, the indices for constrained points are the involution -(i+1) of their position
5664  in the local vector.
5665 
5666  If section is global and setBC=false, the indices for constrained points are negative (and their value is not
5667  significant).  It is invalid to call with a global section and setBC=true.
5668 
5669  Developer Note:
5670  The section is only used for field layout, so islocal is technically a statement about the offset (off).  At some point
5671  in the future, global sections may have fields set, in which case we could pass the global section and obtain the
5672  offset could be obtained from the section instead of passing it explicitly as we do now.
5673 
5674  Example:
5675  Suppose a point contains one field with three components, and for which the unconstrained indices are {10, 11, 12}.
5676  When the middle component is constrained, we get the array {10, -12, 12} for (islocal=TRUE, setBC=FALSE).
5677  Note that -12 is the involution of 11, so the user can involute negative indices to recover local indices.
5678  The global vector does not store constrained dofs, so when this function returns global indices, say {110, -112, 111}, the value of -112 is an arbitrary flag that should not be interpreted beyond its sign.
5679 
5680  Level: developer
5681 */
DMPlexGetIndicesPointFields_Internal(PetscSection section,PetscBool islocal,PetscInt point,PetscInt off,PetscInt foffs[],PetscBool setBC,const PetscInt *** perms,PetscInt permsoff,const PetscInt indperm[],PetscInt indices[])5682 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscBool islocal, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, const PetscInt indperm[], PetscInt indices[])
5683 {
5684   PetscInt       numFields, foff, f;
5685   PetscErrorCode ierr;
5686 
5687   PetscFunctionBegin;
5688   if (!islocal && setBC) SETERRQ(PetscObjectComm((PetscObject)section),PETSC_ERR_ARG_INCOMP,"setBC incompatible with global indices; use a local section or disable setBC");
5689   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5690   for (f = 0, foff = 0; f < numFields; ++f) {
5691     PetscInt        fdof, cfdof;
5692     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5693     PetscInt        cind = 0, b;
5694     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
5695 
5696     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5697     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5698     if (!cfdof || setBC) {
5699       for (b = 0; b < fdof; ++b) {
5700         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5701         const PetscInt ind    = indperm ? indperm[preind] : preind;
5702 
5703         indices[ind] = off+foff+b;
5704       }
5705     } else {
5706       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5707       for (b = 0; b < fdof; ++b) {
5708         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5709         const PetscInt ind    = indperm ? indperm[preind] : preind;
5710 
5711         if ((cind < cfdof) && (b == fcdofs[cind])) {
5712           indices[ind] = -(off+foff+b+1);
5713           ++cind;
5714         } else {
5715           indices[ind] = off + foff + b - (islocal ? 0 : cind);
5716         }
5717       }
5718     }
5719     foff     += (setBC || islocal ? fdof : (fdof - cfdof));
5720     foffs[f] += fdof;
5721   }
5722   PetscFunctionReturn(0);
5723 }
5724 
5725 /*
5726   This version believes the globalSection offsets for each field, rather than just the point offset
5727 
5728  . foffs - The offset into 'indices' for each field, since it is segregated by field
5729 
5730  Notes:
5731  The semantics of this function relate to that of setBC=FALSE in DMPlexGetIndicesPointFields_Internal.
5732  Since this function uses global indices, setBC=TRUE would be invalid, so no such argument exists.
5733 */
DMPlexGetIndicesPointFieldsSplit_Internal(PetscSection section,PetscSection globalSection,PetscInt point,PetscInt foffs[],const PetscInt *** perms,PetscInt permsoff,const PetscInt indperm[],PetscInt indices[])5734 static PetscErrorCode DMPlexGetIndicesPointFieldsSplit_Internal(PetscSection section, PetscSection globalSection, PetscInt point, PetscInt foffs[], const PetscInt ***perms, PetscInt permsoff, const PetscInt indperm[], PetscInt indices[])
5735 {
5736   PetscInt       numFields, foff, f;
5737   PetscErrorCode ierr;
5738 
5739   PetscFunctionBegin;
5740   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5741   for (f = 0; f < numFields; ++f) {
5742     PetscInt        fdof, cfdof;
5743     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
5744     PetscInt        cind = 0, b;
5745     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
5746 
5747     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
5748     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
5749     ierr = PetscSectionGetFieldOffset(globalSection, point, f, &foff);CHKERRQ(ierr);
5750     if (!cfdof) {
5751       for (b = 0; b < fdof; ++b) {
5752         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5753         const PetscInt ind    = indperm ? indperm[preind] : preind;
5754 
5755         indices[ind] = foff+b;
5756       }
5757     } else {
5758       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
5759       for (b = 0; b < fdof; ++b) {
5760         const PetscInt preind = perm ? foffs[f]+perm[b] : foffs[f]+b;
5761         const PetscInt ind    = indperm ? indperm[preind] : preind;
5762 
5763         if ((cind < cfdof) && (b == fcdofs[cind])) {
5764           indices[ind] = -(foff+b+1);
5765           ++cind;
5766         } else {
5767           indices[ind] = foff+b-cind;
5768         }
5769       }
5770     }
5771     foffs[f] += fdof;
5772   }
5773   PetscFunctionReturn(0);
5774 }
5775 
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)5776 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)
5777 {
5778   Mat             cMat;
5779   PetscSection    aSec, cSec;
5780   IS              aIS;
5781   PetscInt        aStart = -1, aEnd = -1;
5782   const PetscInt  *anchors;
5783   PetscInt        numFields, f, p, q, newP = 0;
5784   PetscInt        newNumPoints = 0, newNumIndices = 0;
5785   PetscInt        *newPoints, *indices, *newIndices;
5786   PetscInt        maxAnchor, maxDof;
5787   PetscInt        newOffsets[32];
5788   PetscInt        *pointMatOffsets[32];
5789   PetscInt        *newPointOffsets[32];
5790   PetscScalar     *pointMat[32];
5791   PetscScalar     *newValues=NULL,*tmpValues;
5792   PetscBool       anyConstrained = PETSC_FALSE;
5793   PetscErrorCode  ierr;
5794 
5795   PetscFunctionBegin;
5796   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5797   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5798   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5799 
5800   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
5801   /* if there are point-to-point constraints */
5802   if (aSec) {
5803     ierr = PetscArrayzero(newOffsets, 32);CHKERRQ(ierr);
5804     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
5805     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
5806     /* figure out how many points are going to be in the new element matrix
5807      * (we allow double counting, because it's all just going to be summed
5808      * into the global matrix anyway) */
5809     for (p = 0; p < 2*numPoints; p+=2) {
5810       PetscInt b    = points[p];
5811       PetscInt bDof = 0, bSecDof;
5812 
5813       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5814       if (!bSecDof) {
5815         continue;
5816       }
5817       if (b >= aStart && b < aEnd) {
5818         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
5819       }
5820       if (bDof) {
5821         /* this point is constrained */
5822         /* it is going to be replaced by its anchors */
5823         PetscInt bOff, q;
5824 
5825         anyConstrained = PETSC_TRUE;
5826         newNumPoints  += bDof;
5827         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
5828         for (q = 0; q < bDof; q++) {
5829           PetscInt a = anchors[bOff + q];
5830           PetscInt aDof;
5831 
5832           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
5833           newNumIndices += aDof;
5834           for (f = 0; f < numFields; ++f) {
5835             PetscInt fDof;
5836 
5837             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
5838             newOffsets[f+1] += fDof;
5839           }
5840         }
5841       }
5842       else {
5843         /* this point is not constrained */
5844         newNumPoints++;
5845         newNumIndices += bSecDof;
5846         for (f = 0; f < numFields; ++f) {
5847           PetscInt fDof;
5848 
5849           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5850           newOffsets[f+1] += fDof;
5851         }
5852       }
5853     }
5854   }
5855   if (!anyConstrained) {
5856     if (outNumPoints)  *outNumPoints  = 0;
5857     if (outNumIndices) *outNumIndices = 0;
5858     if (outPoints)     *outPoints     = NULL;
5859     if (outValues)     *outValues     = NULL;
5860     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
5861     PetscFunctionReturn(0);
5862   }
5863 
5864   if (outNumPoints)  *outNumPoints  = newNumPoints;
5865   if (outNumIndices) *outNumIndices = newNumIndices;
5866 
5867   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
5868 
5869   if (!outPoints && !outValues) {
5870     if (offsets) {
5871       for (f = 0; f <= numFields; f++) {
5872         offsets[f] = newOffsets[f];
5873       }
5874     }
5875     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
5876     PetscFunctionReturn(0);
5877   }
5878 
5879   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
5880 
5881   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
5882 
5883   /* workspaces */
5884   if (numFields) {
5885     for (f = 0; f < numFields; f++) {
5886       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5887       ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5888     }
5889   }
5890   else {
5891     ierr = DMGetWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5892     ierr = DMGetWorkArray(dm,numPoints,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5893   }
5894 
5895   /* get workspaces for the point-to-point matrices */
5896   if (numFields) {
5897     PetscInt totalOffset, totalMatOffset;
5898 
5899     for (p = 0; p < numPoints; p++) {
5900       PetscInt b    = points[2*p];
5901       PetscInt bDof = 0, bSecDof;
5902 
5903       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5904       if (!bSecDof) {
5905         for (f = 0; f < numFields; f++) {
5906           newPointOffsets[f][p + 1] = 0;
5907           pointMatOffsets[f][p + 1] = 0;
5908         }
5909         continue;
5910       }
5911       if (b >= aStart && b < aEnd) {
5912         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5913       }
5914       if (bDof) {
5915         for (f = 0; f < numFields; f++) {
5916           PetscInt fDof, q, bOff, allFDof = 0;
5917 
5918           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5919           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5920           for (q = 0; q < bDof; q++) {
5921             PetscInt a = anchors[bOff + q];
5922             PetscInt aFDof;
5923 
5924             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
5925             allFDof += aFDof;
5926           }
5927           newPointOffsets[f][p+1] = allFDof;
5928           pointMatOffsets[f][p+1] = fDof * allFDof;
5929         }
5930       }
5931       else {
5932         for (f = 0; f < numFields; f++) {
5933           PetscInt fDof;
5934 
5935           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
5936           newPointOffsets[f][p+1] = fDof;
5937           pointMatOffsets[f][p+1] = 0;
5938         }
5939       }
5940     }
5941     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
5942       newPointOffsets[f][0] = totalOffset;
5943       pointMatOffsets[f][0] = totalMatOffset;
5944       for (p = 0; p < numPoints; p++) {
5945         newPointOffsets[f][p+1] += newPointOffsets[f][p];
5946         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
5947       }
5948       totalOffset    = newPointOffsets[f][numPoints];
5949       totalMatOffset = pointMatOffsets[f][numPoints];
5950       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5951     }
5952   }
5953   else {
5954     for (p = 0; p < numPoints; p++) {
5955       PetscInt b    = points[2*p];
5956       PetscInt bDof = 0, bSecDof;
5957 
5958       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
5959       if (!bSecDof) {
5960         newPointOffsets[0][p + 1] = 0;
5961         pointMatOffsets[0][p + 1] = 0;
5962         continue;
5963       }
5964       if (b >= aStart && b < aEnd) {
5965         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
5966       }
5967       if (bDof) {
5968         PetscInt bOff, q, allDof = 0;
5969 
5970         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
5971         for (q = 0; q < bDof; q++) {
5972           PetscInt a = anchors[bOff + q], aDof;
5973 
5974           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
5975           allDof += aDof;
5976         }
5977         newPointOffsets[0][p+1] = allDof;
5978         pointMatOffsets[0][p+1] = bSecDof * allDof;
5979       }
5980       else {
5981         newPointOffsets[0][p+1] = bSecDof;
5982         pointMatOffsets[0][p+1] = 0;
5983       }
5984     }
5985     newPointOffsets[0][0] = 0;
5986     pointMatOffsets[0][0] = 0;
5987     for (p = 0; p < numPoints; p++) {
5988       newPointOffsets[0][p+1] += newPointOffsets[0][p];
5989       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
5990     }
5991     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5992   }
5993 
5994   /* output arrays */
5995   ierr = DMGetWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
5996 
5997   /* get the point-to-point matrices; construct newPoints */
5998   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
5999   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
6000   ierr = DMGetWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
6001   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
6002   if (numFields) {
6003     for (p = 0, newP = 0; p < numPoints; p++) {
6004       PetscInt b    = points[2*p];
6005       PetscInt o    = points[2*p+1];
6006       PetscInt bDof = 0, bSecDof;
6007 
6008       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
6009       if (!bSecDof) {
6010         continue;
6011       }
6012       if (b >= aStart && b < aEnd) {
6013         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
6014       }
6015       if (bDof) {
6016         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
6017 
6018         fStart[0] = 0;
6019         fEnd[0]   = 0;
6020         for (f = 0; f < numFields; f++) {
6021           PetscInt fDof;
6022 
6023           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
6024           fStart[f+1] = fStart[f] + fDof;
6025           fEnd[f+1]   = fStart[f+1];
6026         }
6027         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
6028         ierr = DMPlexGetIndicesPointFields_Internal(cSec, PETSC_TRUE, b, bOff, fEnd, PETSC_TRUE, perms, p, NULL, indices);CHKERRQ(ierr);
6029 
6030         fAnchorStart[0] = 0;
6031         fAnchorEnd[0]   = 0;
6032         for (f = 0; f < numFields; f++) {
6033           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
6034 
6035           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
6036           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
6037         }
6038         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
6039         for (q = 0; q < bDof; q++) {
6040           PetscInt a = anchors[bOff + q], aOff;
6041 
6042           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
6043           newPoints[2*(newP + q)]     = a;
6044           newPoints[2*(newP + q) + 1] = 0;
6045           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
6046           ierr = DMPlexGetIndicesPointFields_Internal(section, PETSC_TRUE, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, NULL, newIndices);CHKERRQ(ierr);
6047         }
6048         newP += bDof;
6049 
6050         if (outValues) {
6051           /* get the point-to-point submatrix */
6052           for (f = 0; f < numFields; f++) {
6053             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
6054           }
6055         }
6056       }
6057       else {
6058         newPoints[2 * newP]     = b;
6059         newPoints[2 * newP + 1] = o;
6060         newP++;
6061       }
6062     }
6063   } else {
6064     for (p = 0; p < numPoints; p++) {
6065       PetscInt b    = points[2*p];
6066       PetscInt o    = points[2*p+1];
6067       PetscInt bDof = 0, bSecDof;
6068 
6069       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
6070       if (!bSecDof) {
6071         continue;
6072       }
6073       if (b >= aStart && b < aEnd) {
6074         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
6075       }
6076       if (bDof) {
6077         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
6078 
6079         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
6080         ierr = DMPlexGetIndicesPoint_Internal(cSec, PETSC_TRUE, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, NULL, indices);CHKERRQ(ierr);
6081 
6082         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
6083         for (q = 0; q < bDof; q++) {
6084           PetscInt a = anchors[bOff + q], aOff;
6085 
6086           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
6087 
6088           newPoints[2*(newP + q)]     = a;
6089           newPoints[2*(newP + q) + 1] = 0;
6090           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
6091           ierr = DMPlexGetIndicesPoint_Internal(section, PETSC_TRUE, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, NULL, newIndices);CHKERRQ(ierr);
6092         }
6093         newP += bDof;
6094 
6095         /* get the point-to-point submatrix */
6096         if (outValues) {
6097           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
6098         }
6099       }
6100       else {
6101         newPoints[2 * newP]     = b;
6102         newPoints[2 * newP + 1] = o;
6103         newP++;
6104       }
6105     }
6106   }
6107 
6108   if (outValues) {
6109     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
6110     ierr = PetscArrayzero(tmpValues,newNumIndices*numIndices);CHKERRQ(ierr);
6111     /* multiply constraints on the right */
6112     if (numFields) {
6113       for (f = 0; f < numFields; f++) {
6114         PetscInt oldOff = offsets[f];
6115 
6116         for (p = 0; p < numPoints; p++) {
6117           PetscInt cStart = newPointOffsets[f][p];
6118           PetscInt b      = points[2 * p];
6119           PetscInt c, r, k;
6120           PetscInt dof;
6121 
6122           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
6123           if (!dof) {
6124             continue;
6125           }
6126           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
6127             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
6128             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
6129 
6130             for (r = 0; r < numIndices; r++) {
6131               for (c = 0; c < nCols; c++) {
6132                 for (k = 0; k < dof; k++) {
6133                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
6134                 }
6135               }
6136             }
6137           }
6138           else {
6139             /* copy this column as is */
6140             for (r = 0; r < numIndices; r++) {
6141               for (c = 0; c < dof; c++) {
6142                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
6143               }
6144             }
6145           }
6146           oldOff += dof;
6147         }
6148       }
6149     }
6150     else {
6151       PetscInt oldOff = 0;
6152       for (p = 0; p < numPoints; p++) {
6153         PetscInt cStart = newPointOffsets[0][p];
6154         PetscInt b      = points[2 * p];
6155         PetscInt c, r, k;
6156         PetscInt dof;
6157 
6158         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
6159         if (!dof) {
6160           continue;
6161         }
6162         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
6163           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
6164           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
6165 
6166           for (r = 0; r < numIndices; r++) {
6167             for (c = 0; c < nCols; c++) {
6168               for (k = 0; k < dof; k++) {
6169                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
6170               }
6171             }
6172           }
6173         }
6174         else {
6175           /* copy this column as is */
6176           for (r = 0; r < numIndices; r++) {
6177             for (c = 0; c < dof; c++) {
6178               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
6179             }
6180           }
6181         }
6182         oldOff += dof;
6183       }
6184     }
6185 
6186     if (multiplyLeft) {
6187       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,MPIU_SCALAR,&newValues);CHKERRQ(ierr);
6188       ierr = PetscArrayzero(newValues,newNumIndices*newNumIndices);CHKERRQ(ierr);
6189       /* multiply constraints transpose on the left */
6190       if (numFields) {
6191         for (f = 0; f < numFields; f++) {
6192           PetscInt oldOff = offsets[f];
6193 
6194           for (p = 0; p < numPoints; p++) {
6195             PetscInt rStart = newPointOffsets[f][p];
6196             PetscInt b      = points[2 * p];
6197             PetscInt c, r, k;
6198             PetscInt dof;
6199 
6200             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
6201             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
6202               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
6203               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
6204 
6205               for (r = 0; r < nRows; r++) {
6206                 for (c = 0; c < newNumIndices; c++) {
6207                   for (k = 0; k < dof; k++) {
6208                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
6209                   }
6210                 }
6211               }
6212             }
6213             else {
6214               /* copy this row as is */
6215               for (r = 0; r < dof; r++) {
6216                 for (c = 0; c < newNumIndices; c++) {
6217                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
6218                 }
6219               }
6220             }
6221             oldOff += dof;
6222           }
6223         }
6224       }
6225       else {
6226         PetscInt oldOff = 0;
6227 
6228         for (p = 0; p < numPoints; p++) {
6229           PetscInt rStart = newPointOffsets[0][p];
6230           PetscInt b      = points[2 * p];
6231           PetscInt c, r, k;
6232           PetscInt dof;
6233 
6234           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
6235           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
6236             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
6237             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
6238 
6239             for (r = 0; r < nRows; r++) {
6240               for (c = 0; c < newNumIndices; c++) {
6241                 for (k = 0; k < dof; k++) {
6242                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
6243                 }
6244               }
6245             }
6246           }
6247           else {
6248             /* copy this row as is */
6249             for (r = 0; r < dof; r++) {
6250               for (c = 0; c < newNumIndices; c++) {
6251                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
6252               }
6253             }
6254           }
6255           oldOff += dof;
6256         }
6257       }
6258 
6259       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,MPIU_SCALAR,&tmpValues);CHKERRQ(ierr);
6260     }
6261     else {
6262       newValues = tmpValues;
6263     }
6264   }
6265 
6266   /* clean up */
6267   ierr = DMRestoreWorkArray(dm,maxDof,MPIU_INT,&indices);CHKERRQ(ierr);
6268   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,MPIU_INT,&newIndices);CHKERRQ(ierr);
6269 
6270   if (numFields) {
6271     for (f = 0; f < numFields; f++) {
6272       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],MPIU_SCALAR,&pointMat[f]);CHKERRQ(ierr);
6273       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
6274       ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[f]);CHKERRQ(ierr);
6275     }
6276   }
6277   else {
6278     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],MPIU_SCALAR,&pointMat[0]);CHKERRQ(ierr);
6279     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
6280     ierr = DMRestoreWorkArray(dm,numPoints+1,MPIU_INT,&newPointOffsets[0]);CHKERRQ(ierr);
6281   }
6282   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
6283 
6284   /* output */
6285   if (outPoints) {
6286     *outPoints = newPoints;
6287   }
6288   else {
6289     ierr = DMRestoreWorkArray(dm,2*newNumPoints,MPIU_INT,&newPoints);CHKERRQ(ierr);
6290   }
6291   if (outValues) {
6292     *outValues = newValues;
6293   }
6294   for (f = 0; f <= numFields; f++) {
6295     offsets[f] = newOffsets[f];
6296   }
6297   PetscFunctionReturn(0);
6298 }
6299 
6300 /*@C
6301   DMPlexGetClosureIndices - Gets the global dof indices associated with the closure of the given point within the provided sections.
6302 
6303   Not collective
6304 
6305   Input Parameters:
6306 + dm         - The DM
6307 . section    - The PetscSection describing the points (a local section)
6308 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6309 . point      - The point defining the closure
6310 - useClPerm  - Use the closure point permutation if available
6311 
6312   Output Parameters:
6313 + numIndices - The number of dof indices in the closure of point with the input sections
6314 . indices    - The dof indices
6315 . outOffsets - Array to write the field offsets into, or NULL
6316 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6317 
6318   Notes:
6319   Must call DMPlexRestoreClosureIndices() to free allocated memory
6320 
6321   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6322   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6323   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6324   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6325   indices (with the above semantics) are implied.
6326 
6327   Level: advanced
6328 
6329 .seealso DMPlexRestoreClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6330 @*/
DMPlexGetClosureIndices(DM dm,PetscSection section,PetscSection idxSection,PetscInt point,PetscBool useClPerm,PetscInt * numIndices,PetscInt * indices[],PetscInt outOffsets[],PetscScalar * values[])6331 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6332                                        PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6333 {
6334   /* Closure ordering */
6335   PetscSection        clSection;
6336   IS                  clPoints;
6337   const PetscInt     *clp;
6338   PetscInt           *points;
6339   const PetscInt     *clperm = NULL;
6340   /* Dof permutation and sign flips */
6341   const PetscInt    **perms[32] = {NULL};
6342   const PetscScalar **flips[32] = {NULL};
6343   PetscScalar        *valCopy   = NULL;
6344   /* Hanging node constraints */
6345   PetscInt           *pointsC = NULL;
6346   PetscScalar        *valuesC = NULL;
6347   PetscInt            NclC, NiC;
6348 
6349   PetscInt           *idx;
6350   PetscInt            Nf, Ncl, Ni = 0, offsets[32], p, f;
6351   PetscBool           isLocal = (section == idxSection) ? PETSC_TRUE : PETSC_FALSE;
6352   PetscErrorCode      ierr;
6353 
6354   PetscFunctionBeginHot;
6355   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6356   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6357   PetscValidHeaderSpecific(idxSection, PETSC_SECTION_CLASSID, 3);
6358   if (numIndices) PetscValidPointer(numIndices, 6);
6359   if (indices)    PetscValidPointer(indices, 7);
6360   if (outOffsets) PetscValidPointer(outOffsets, 8);
6361   if (values)     PetscValidPointer(values, 9);
6362   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
6363   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
6364   ierr = PetscArrayzero(offsets, 32);CHKERRQ(ierr);
6365   /* 1) Get points in closure */
6366   ierr = DMPlexGetCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6367   if (useClPerm) {
6368     PetscInt depth, clsize;
6369     ierr = DMPlexGetPointDepth(dm, point, &depth);CHKERRQ(ierr);
6370     for (clsize=0,p=0; p<Ncl; p++) {
6371       PetscInt dof;
6372       ierr = PetscSectionGetDof(section, points[2*p], &dof);CHKERRQ(ierr);
6373       clsize += dof;
6374     }
6375     ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, depth, clsize, &clperm);CHKERRQ(ierr);
6376   }
6377   /* 2) Get number of indices on these points and field offsets from section */
6378   for (p = 0; p < Ncl*2; p += 2) {
6379     PetscInt dof, fdof;
6380 
6381     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
6382     for (f = 0; f < Nf; ++f) {
6383       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
6384       offsets[f+1] += fdof;
6385     }
6386     Ni += dof;
6387   }
6388   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
6389   if (Nf && offsets[Nf] != Ni) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Ni);
6390   /* 3) Get symmetries and sign flips. Apply sign flips to values if passed in (only works for square values matrix) */
6391   for (f = 0; f < PetscMax(1, Nf); ++f) {
6392     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6393     else    {ierr = PetscSectionGetPointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6394     /* may need to apply sign changes to the element matrix */
6395     if (values && flips[f]) {
6396       PetscInt foffset = offsets[f];
6397 
6398       for (p = 0; p < Ncl; ++p) {
6399         PetscInt           pnt  = points[2*p], fdof;
6400         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
6401 
6402         if (!Nf) {ierr = PetscSectionGetDof(section, pnt, &fdof);CHKERRQ(ierr);}
6403         else     {ierr = PetscSectionGetFieldDof(section, pnt, f, &fdof);CHKERRQ(ierr);}
6404         if (flip) {
6405           PetscInt i, j, k;
6406 
6407           if (!valCopy) {
6408             ierr = DMGetWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);
6409             for (j = 0; j < Ni * Ni; ++j) valCopy[j] = (*values)[j];
6410             *values = valCopy;
6411           }
6412           for (i = 0; i < fdof; ++i) {
6413             PetscScalar fval = flip[i];
6414 
6415             for (k = 0; k < Ni; ++k) {
6416               valCopy[Ni * (foffset + i) + k] *= fval;
6417               valCopy[Ni * k + (foffset + i)] *= fval;
6418             }
6419           }
6420         }
6421         foffset += fdof;
6422       }
6423     }
6424   }
6425   /* 4) Apply hanging node constraints. Get new symmetries and replace all storage with constrained storage */
6426   ierr = DMPlexAnchorsModifyMat(dm, section, Ncl, Ni, points, perms, values ? *values : NULL, &NclC, &NiC, &pointsC, values ? &valuesC : NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
6427   if (NclC) {
6428     if (valCopy) {ierr = DMRestoreWorkArray(dm, Ni*Ni, MPIU_SCALAR, &valCopy);CHKERRQ(ierr);}
6429     for (f = 0; f < PetscMax(1, Nf); ++f) {
6430       if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6431       else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6432     }
6433     for (f = 0; f < PetscMax(1, Nf); ++f) {
6434       if (Nf) {ierr = PetscSectionGetFieldPointSyms(section, f, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6435       else    {ierr = PetscSectionGetPointSyms(section, NclC, pointsC, &perms[f], &flips[f]);CHKERRQ(ierr);}
6436     }
6437     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6438     Ncl     = NclC;
6439     Ni      = NiC;
6440     points  = pointsC;
6441     if (values) *values = valuesC;
6442   }
6443   /* 5) Calculate indices */
6444   ierr = DMGetWorkArray(dm, Ni, MPIU_INT, &idx);CHKERRQ(ierr);
6445   if (Nf) {
6446     PetscInt  idxOff;
6447     PetscBool useFieldOffsets;
6448 
6449     if (outOffsets) {for (f = 0; f <= Nf; f++) outOffsets[f] = offsets[f];}
6450     ierr = PetscSectionGetUseFieldOffsets(idxSection, &useFieldOffsets);CHKERRQ(ierr);
6451     if (useFieldOffsets) {
6452       for (p = 0; p < Ncl; ++p) {
6453         const PetscInt pnt = points[p*2];
6454 
6455         ierr = DMPlexGetIndicesPointFieldsSplit_Internal(section, idxSection, pnt, offsets, perms, p, clperm, idx);CHKERRQ(ierr);
6456       }
6457     } else {
6458       for (p = 0; p < Ncl; ++p) {
6459         const PetscInt pnt = points[p*2];
6460 
6461         ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6462         /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6463          * not (at the time of this writing) have fields set. They probably should, in which case we would pass the
6464          * global section. */
6465         ierr = DMPlexGetIndicesPointFields_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, offsets, PETSC_FALSE, perms, p, clperm, idx);CHKERRQ(ierr);
6466       }
6467     }
6468   } else {
6469     PetscInt off = 0, idxOff;
6470 
6471     for (p = 0; p < Ncl; ++p) {
6472       const PetscInt  pnt  = points[p*2];
6473       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
6474 
6475       ierr = PetscSectionGetOffset(idxSection, pnt, &idxOff);CHKERRQ(ierr);
6476       /* Note that we pass a local section even though we're using global offsets.  This is because global sections do
6477        * not (at the time of this writing) have fields set. They probably should, in which case we would pass the global section. */
6478       ierr = DMPlexGetIndicesPoint_Internal(section, isLocal, pnt, idxOff < 0 ? -(idxOff+1) : idxOff, &off, PETSC_FALSE, perm, clperm, idx);CHKERRQ(ierr);
6479     }
6480   }
6481   /* 6) Cleanup */
6482   for (f = 0; f < PetscMax(1, Nf); ++f) {
6483     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section, f, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6484     else    {ierr = PetscSectionRestorePointSyms(section, Ncl, points, &perms[f], &flips[f]);CHKERRQ(ierr);}
6485   }
6486   if (NclC) {
6487     ierr = DMRestoreWorkArray(dm, NclC*2, MPIU_INT, &pointsC);CHKERRQ(ierr);
6488   } else {
6489     ierr = DMPlexRestoreCompressedClosure(dm, section, point, &Ncl, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
6490   }
6491 
6492   if (numIndices) *numIndices = Ni;
6493   if (indices)    *indices    = idx;
6494   PetscFunctionReturn(0);
6495 }
6496 
6497 /*@C
6498   DMPlexRestoreClosureIndices - Restores the global dof indices associated with the closure of the given point within the provided sections.
6499 
6500   Not collective
6501 
6502   Input Parameters:
6503 + dm         - The DM
6504 . section    - The PetscSection describing the points (a local section)
6505 . idxSection - The PetscSection from which to obtain indices (may be local or global)
6506 . point      - The point defining the closure
6507 - useClPerm  - Use the closure point permutation if available
6508 
6509   Output Parameters:
6510 + numIndices - The number of dof indices in the closure of point with the input sections
6511 . indices    - The dof indices
6512 . outOffsets - Array to write the field offsets into, or NULL
6513 - values     - The input values, which may be modified if sign flips are induced by the point symmetries, or NULL
6514 
6515   Notes:
6516   If values were modified, the user is responsible for calling DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values).
6517 
6518   If idxSection is global, any constrained dofs (see DMAddBoundary(), for example) will get negative indices.  The value
6519   of those indices is not significant.  If idxSection is local, the constrained dofs will yield the involution -(idx+1)
6520   of their index in a local vector.  A caller who does not wish to distinguish those points may recover the nonnegative
6521   indices via involution, -(-(idx+1)+1)==idx.  Local indices are provided when idxSection == section, otherwise global
6522   indices (with the above semantics) are implied.
6523 
6524   Level: advanced
6525 
6526 .seealso DMPlexGetClosureIndices(), DMPlexVecGetClosure(), DMPlexMatSetClosure(), DMGetLocalSection(), DMGetGlobalSection()
6527 @*/
DMPlexRestoreClosureIndices(DM dm,PetscSection section,PetscSection idxSection,PetscInt point,PetscBool useClPerm,PetscInt * numIndices,PetscInt * indices[],PetscInt outOffsets[],PetscScalar * values[])6528 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection idxSection, PetscInt point, PetscBool useClPerm,
6529                                            PetscInt *numIndices, PetscInt *indices[], PetscInt outOffsets[], PetscScalar *values[])
6530 {
6531   PetscErrorCode ierr;
6532 
6533   PetscFunctionBegin;
6534   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6535   PetscValidPointer(indices, 5);
6536   ierr = DMRestoreWorkArray(dm, 0, MPIU_INT, indices);CHKERRQ(ierr);
6537   PetscFunctionReturn(0);
6538 }
6539 
6540 /*@C
6541   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
6542 
6543   Not collective
6544 
6545   Input Parameters:
6546 + dm - The DM
6547 . section - The section describing the layout in v, or NULL to use the default section
6548 . globalSection - The section describing the layout in v, or NULL to use the default global section
6549 . A - The matrix
6550 . point - The point in the DM
6551 . values - The array of values
6552 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6553 
6554   Fortran Notes:
6555   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
6556 
6557   Level: intermediate
6558 
6559 .seealso DMPlexMatSetClosureGeneral(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6560 @*/
DMPlexMatSetClosure(DM dm,PetscSection section,PetscSection globalSection,Mat A,PetscInt point,const PetscScalar values[],InsertMode mode)6561 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6562 {
6563   DM_Plex           *mesh = (DM_Plex*) dm->data;
6564   PetscInt          *indices;
6565   PetscInt           numIndices;
6566   const PetscScalar *valuesOrig = values;
6567   PetscErrorCode     ierr;
6568 
6569   PetscFunctionBegin;
6570   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6571   if (!section) {ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);}
6572   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
6573   if (!globalSection) {ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
6574   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
6575   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
6576 
6577   ierr = DMPlexGetClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6578 
6579   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
6580   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
6581   if (ierr) {
6582     PetscMPIInt    rank;
6583     PetscErrorCode ierr2;
6584 
6585     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6586     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6587     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
6588     ierr2 = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6589     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6590     CHKERRQ(ierr);
6591   }
6592   if (mesh->printFEM > 1) {
6593     PetscInt i;
6594     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
6595     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
6596     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
6597   }
6598 
6599   ierr = DMPlexRestoreClosureIndices(dm, section, globalSection, point, PETSC_TRUE, &numIndices, &indices, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6600   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6601   PetscFunctionReturn(0);
6602 }
6603 
6604 /*@C
6605   DMPlexMatSetClosure - Set an array of the values on the closure of 'point' using a different row and column section
6606 
6607   Not collective
6608 
6609   Input Parameters:
6610 + dmRow - The DM for the row fields
6611 . sectionRow - The section describing the layout, or NULL to use the default section in dmRow
6612 . globalSectionRow - The section describing the layout, or NULL to use the default global section in dmRow
6613 . dmCol - The DM for the column fields
6614 . sectionCol - The section describing the layout, or NULL to use the default section in dmCol
6615 . globalSectionCol - The section describing the layout, or NULL to use the default global section in dmCol
6616 . A - The matrix
6617 . point - The point in the DMs
6618 . values - The array of values
6619 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
6620 
6621   Level: intermediate
6622 
6623 .seealso DMPlexMatSetClosure(), DMPlexVecGetClosure(), DMPlexVecSetClosure()
6624 @*/
DMPlexMatSetClosureGeneral(DM dmRow,PetscSection sectionRow,PetscSection globalSectionRow,DM dmCol,PetscSection sectionCol,PetscSection globalSectionCol,Mat A,PetscInt point,const PetscScalar values[],InsertMode mode)6625 PetscErrorCode DMPlexMatSetClosureGeneral(DM dmRow, PetscSection sectionRow, PetscSection globalSectionRow, DM dmCol, PetscSection sectionCol, PetscSection globalSectionCol, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6626 {
6627   DM_Plex           *mesh = (DM_Plex*) dmRow->data;
6628   PetscInt          *indicesRow, *indicesCol;
6629   PetscInt           numIndicesRow, numIndicesCol;
6630   const PetscScalar *valuesOrig = values;
6631   PetscErrorCode     ierr;
6632 
6633   PetscFunctionBegin;
6634   PetscValidHeaderSpecific(dmRow, DM_CLASSID, 1);
6635   if (!sectionRow) {ierr = DMGetLocalSection(dmRow, &sectionRow);CHKERRQ(ierr);}
6636   PetscValidHeaderSpecific(sectionRow, PETSC_SECTION_CLASSID, 2);
6637   if (!globalSectionRow) {ierr = DMGetGlobalSection(dmRow, &globalSectionRow);CHKERRQ(ierr);}
6638   PetscValidHeaderSpecific(globalSectionRow, PETSC_SECTION_CLASSID, 3);
6639   PetscValidHeaderSpecific(dmCol, DM_CLASSID, 4);
6640   if (!sectionCol) {ierr = DMGetLocalSection(dmCol, &sectionCol);CHKERRQ(ierr);}
6641   PetscValidHeaderSpecific(sectionCol, PETSC_SECTION_CLASSID, 5);
6642   if (!globalSectionCol) {ierr = DMGetGlobalSection(dmCol, &globalSectionCol);CHKERRQ(ierr);}
6643   PetscValidHeaderSpecific(globalSectionCol, PETSC_SECTION_CLASSID, 6);
6644   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6645 
6646   ierr = DMPlexGetClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6647   ierr = DMPlexGetClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6648 
6649   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr);}
6650   ierr = MatSetValues(A, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values, mode);
6651   if (ierr) {
6652     PetscMPIInt    rank;
6653     PetscErrorCode ierr2;
6654 
6655     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6656     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6657     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndicesRow, indicesRow, numIndicesCol, indicesCol, values);CHKERRQ(ierr2);
6658     ierr2 = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6659     ierr2 = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr2);
6660     if (values != valuesOrig) {ierr2 = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr2);}
6661     CHKERRQ(ierr);
6662   }
6663 
6664   ierr = DMPlexRestoreClosureIndices(dmRow, sectionRow, globalSectionRow, point, PETSC_TRUE, &numIndicesRow, &indicesRow, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6665   ierr = DMPlexRestoreClosureIndices(dmCol, sectionCol, globalSectionCol, point, PETSC_TRUE, &numIndicesCol, &indicesCol, NULL, (PetscScalar **) &values);CHKERRQ(ierr);
6666   if (values != valuesOrig) {ierr = DMRestoreWorkArray(dmRow, 0, MPIU_SCALAR, &values);CHKERRQ(ierr);}
6667   PetscFunctionReturn(0);
6668 }
6669 
DMPlexMatSetClosureRefined(DM dmf,PetscSection fsection,PetscSection globalFSection,DM dmc,PetscSection csection,PetscSection globalCSection,Mat A,PetscInt point,const PetscScalar values[],InsertMode mode)6670 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
6671 {
6672   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
6673   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
6674   PetscInt       *cpoints = NULL;
6675   PetscInt       *findices, *cindices;
6676   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6677   PetscInt        foffsets[32], coffsets[32];
6678   DMPolytopeType  ct;
6679   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6680   PetscErrorCode  ierr;
6681 
6682   PetscFunctionBegin;
6683   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6684   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6685   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6686   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6687   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6688   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6689   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6690   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6691   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6692   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6693   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
6694   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6695   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6696   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6697   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6698   /* Column indices */
6699   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6700   maxFPoints = numCPoints;
6701   /* Compress out points not in the section */
6702   /*   TODO: Squeeze out points with 0 dof as well */
6703   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6704   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6705     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6706       cpoints[q*2]   = cpoints[p];
6707       cpoints[q*2+1] = cpoints[p+1];
6708       ++q;
6709     }
6710   }
6711   numCPoints = q;
6712   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6713     PetscInt fdof;
6714 
6715     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6716     if (!dof) continue;
6717     for (f = 0; f < numFields; ++f) {
6718       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6719       coffsets[f+1] += fdof;
6720     }
6721     numCIndices += dof;
6722   }
6723   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6724   /* Row indices */
6725   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6726   {
6727     DMPlexCellRefiner cr;
6728     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6729     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6730     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6731   }
6732   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6733   for (r = 0, q = 0; r < numSubcells; ++r) {
6734     /* TODO Map from coarse to fine cells */
6735     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6736     /* Compress out points not in the section */
6737     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6738     for (p = 0; p < numFPoints*2; p += 2) {
6739       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6740         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6741         if (!dof) continue;
6742         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6743         if (s < q) continue;
6744         ftotpoints[q*2]   = fpoints[p];
6745         ftotpoints[q*2+1] = fpoints[p+1];
6746         ++q;
6747       }
6748     }
6749     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6750   }
6751   numFPoints = q;
6752   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6753     PetscInt fdof;
6754 
6755     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6756     if (!dof) continue;
6757     for (f = 0; f < numFields; ++f) {
6758       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6759       foffsets[f+1] += fdof;
6760     }
6761     numFIndices += dof;
6762   }
6763   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6764 
6765   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6766   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6767   ierr = DMGetWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6768   ierr = DMGetWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6769   if (numFields) {
6770     const PetscInt **permsF[32] = {NULL};
6771     const PetscInt **permsC[32] = {NULL};
6772 
6773     for (f = 0; f < numFields; f++) {
6774       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6775       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6776     }
6777     for (p = 0; p < numFPoints; p++) {
6778       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6779       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6780     }
6781     for (p = 0; p < numCPoints; p++) {
6782       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6783       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6784     }
6785     for (f = 0; f < numFields; f++) {
6786       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6787       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6788     }
6789   } else {
6790     const PetscInt **permsF = NULL;
6791     const PetscInt **permsC = NULL;
6792 
6793     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6794     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6795     for (p = 0, off = 0; p < numFPoints; p++) {
6796       const PetscInt *perm = permsF ? permsF[p] : NULL;
6797 
6798       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6799       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6800     }
6801     for (p = 0, off = 0; p < numCPoints; p++) {
6802       const PetscInt *perm = permsC ? permsC[p] : NULL;
6803 
6804       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6805       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6806     }
6807     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6808     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6809   }
6810   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
6811   /* TODO: flips */
6812   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
6813   if (ierr) {
6814     PetscMPIInt    rank;
6815     PetscErrorCode ierr2;
6816 
6817     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
6818     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
6819     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
6820     ierr2 = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr2);
6821     ierr2 = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr2);
6822     CHKERRQ(ierr);
6823   }
6824   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6825   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6826   ierr = DMRestoreWorkArray(dmf, numFIndices, MPIU_INT, &findices);CHKERRQ(ierr);
6827   ierr = DMRestoreWorkArray(dmc, numCIndices, MPIU_INT, &cindices);CHKERRQ(ierr);
6828   PetscFunctionReturn(0);
6829 }
6830 
DMPlexMatGetClosureIndicesRefined(DM dmf,PetscSection fsection,PetscSection globalFSection,DM dmc,PetscSection csection,PetscSection globalCSection,PetscInt point,PetscInt cindices[],PetscInt findices[])6831 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
6832 {
6833   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
6834   PetscInt      *cpoints = NULL;
6835   PetscInt       foffsets[32], coffsets[32];
6836   const PetscInt *fclperm = NULL, *cclperm = NULL; /* Closure permutations cannot work here */
6837   DMPolytopeType ct;
6838   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
6839   PetscErrorCode ierr;
6840 
6841   PetscFunctionBegin;
6842   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
6843   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
6844   if (!fsection) {ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);}
6845   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
6846   if (!csection) {ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);}
6847   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
6848   if (!globalFSection) {ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
6849   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
6850   if (!globalCSection) {ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
6851   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
6852   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
6853   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
6854   ierr = PetscArrayzero(foffsets, 32);CHKERRQ(ierr);
6855   ierr = PetscArrayzero(coffsets, 32);CHKERRQ(ierr);
6856   /* Column indices */
6857   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6858   maxFPoints = numCPoints;
6859   /* Compress out points not in the section */
6860   /*   TODO: Squeeze out points with 0 dof as well */
6861   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
6862   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
6863     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
6864       cpoints[q*2]   = cpoints[p];
6865       cpoints[q*2+1] = cpoints[p+1];
6866       ++q;
6867     }
6868   }
6869   numCPoints = q;
6870   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
6871     PetscInt fdof;
6872 
6873     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
6874     if (!dof) continue;
6875     for (f = 0; f < numFields; ++f) {
6876       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
6877       coffsets[f+1] += fdof;
6878     }
6879     numCIndices += dof;
6880   }
6881   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
6882   /* Row indices */
6883   ierr = DMPlexGetCellType(dmc, point, &ct);CHKERRQ(ierr);
6884   {
6885     DMPlexCellRefiner cr;
6886     ierr = DMPlexCellRefinerCreate(dmc, &cr);CHKERRQ(ierr);
6887     ierr = DMPlexCellRefinerGetAffineTransforms(cr, ct, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
6888     ierr = DMPlexCellRefinerDestroy(&cr);CHKERRQ(ierr);
6889   }
6890   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6891   for (r = 0, q = 0; r < numSubcells; ++r) {
6892     /* TODO Map from coarse to fine cells */
6893     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6894     /* Compress out points not in the section */
6895     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
6896     for (p = 0; p < numFPoints*2; p += 2) {
6897       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
6898         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
6899         if (!dof) continue;
6900         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
6901         if (s < q) continue;
6902         ftotpoints[q*2]   = fpoints[p];
6903         ftotpoints[q*2+1] = fpoints[p+1];
6904         ++q;
6905       }
6906     }
6907     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
6908   }
6909   numFPoints = q;
6910   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
6911     PetscInt fdof;
6912 
6913     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
6914     if (!dof) continue;
6915     for (f = 0; f < numFields; ++f) {
6916       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
6917       foffsets[f+1] += fdof;
6918     }
6919     numFIndices += dof;
6920   }
6921   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
6922 
6923   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
6924   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
6925   if (numFields) {
6926     const PetscInt **permsF[32] = {NULL};
6927     const PetscInt **permsC[32] = {NULL};
6928 
6929     for (f = 0; f < numFields; f++) {
6930       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6931       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6932     }
6933     for (p = 0; p < numFPoints; p++) {
6934       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6935       ierr = DMPlexGetIndicesPointFields_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, fclperm, findices);CHKERRQ(ierr);
6936     }
6937     for (p = 0; p < numCPoints; p++) {
6938       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6939       ierr = DMPlexGetIndicesPointFields_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cclperm, cindices);CHKERRQ(ierr);
6940     }
6941     for (f = 0; f < numFields; f++) {
6942       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
6943       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
6944     }
6945   } else {
6946     const PetscInt **permsF = NULL;
6947     const PetscInt **permsC = NULL;
6948 
6949     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6950     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6951     for (p = 0, off = 0; p < numFPoints; p++) {
6952       const PetscInt *perm = permsF ? permsF[p] : NULL;
6953 
6954       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
6955       ierr = DMPlexGetIndicesPoint_Internal(fsection, PETSC_FALSE, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, fclperm, findices);CHKERRQ(ierr);
6956     }
6957     for (p = 0, off = 0; p < numCPoints; p++) {
6958       const PetscInt *perm = permsC ? permsC[p] : NULL;
6959 
6960       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
6961       ierr = DMPlexGetIndicesPoint_Internal(csection, PETSC_FALSE, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cclperm, cindices);CHKERRQ(ierr);
6962     }
6963     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
6964     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
6965   }
6966   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, MPIU_INT, &ftotpoints);CHKERRQ(ierr);
6967   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
6968   PetscFunctionReturn(0);
6969 }
6970 
6971 /*@C
6972   DMPlexGetVTKCellHeight - Returns the height in the DAG used to determine which points are cells (normally 0)
6973 
6974   Input Parameter:
6975 . dm   - The DMPlex object
6976 
6977   Output Parameter:
6978 . cellHeight - The height of a cell
6979 
6980   Level: developer
6981 
6982 .seealso DMPlexSetVTKCellHeight()
6983 @*/
DMPlexGetVTKCellHeight(DM dm,PetscInt * cellHeight)6984 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
6985 {
6986   DM_Plex *mesh = (DM_Plex*) dm->data;
6987 
6988   PetscFunctionBegin;
6989   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6990   PetscValidPointer(cellHeight, 2);
6991   *cellHeight = mesh->vtkCellHeight;
6992   PetscFunctionReturn(0);
6993 }
6994 
6995 /*@C
6996   DMPlexSetVTKCellHeight - Sets the height in the DAG used to determine which points are cells (normally 0)
6997 
6998   Input Parameters:
6999 + dm   - The DMPlex object
7000 - cellHeight - The height of a cell
7001 
7002   Level: developer
7003 
7004 .seealso DMPlexGetVTKCellHeight()
7005 @*/
DMPlexSetVTKCellHeight(DM dm,PetscInt cellHeight)7006 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
7007 {
7008   DM_Plex *mesh = (DM_Plex*) dm->data;
7009 
7010   PetscFunctionBegin;
7011   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7012   mesh->vtkCellHeight = cellHeight;
7013   PetscFunctionReturn(0);
7014 }
7015 
7016 /*@
7017   DMPlexGetGhostCellStratum - Get the range of cells which are used to enforce FV boundary conditions
7018 
7019   Input Parameter:
7020 . dm - The DMPlex object
7021 
7022   Output Parameters:
7023 + gcStart - The first ghost cell, or NULL
7024 - gcEnd   - The upper bound on ghost cells, or NULL
7025 
7026   Level: advanced
7027 
7028 .seealso DMPlexConstructGhostCells(), DMPlexSetGhostCellStratum()
7029 @*/
DMPlexGetGhostCellStratum(DM dm,PetscInt * gcStart,PetscInt * gcEnd)7030 PetscErrorCode DMPlexGetGhostCellStratum(DM dm, PetscInt *gcStart, PetscInt *gcEnd)
7031 {
7032   DMLabel        ctLabel;
7033   PetscErrorCode ierr;
7034 
7035   PetscFunctionBegin;
7036   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7037   ierr = DMPlexGetCellTypeLabel(dm, &ctLabel);CHKERRQ(ierr);
7038   ierr = DMLabelGetStratumBounds(ctLabel, DM_POLYTOPE_FV_GHOST, gcStart, gcEnd);CHKERRQ(ierr);
7039   PetscFunctionReturn(0);
7040 }
7041 
7042 /* We can easily have a form that takes an IS instead */
DMPlexCreateNumbering_Plex(DM dm,PetscInt pStart,PetscInt pEnd,PetscInt shift,PetscInt * globalSize,PetscSF sf,IS * numbering)7043 PetscErrorCode DMPlexCreateNumbering_Plex(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
7044 {
7045   PetscSection   section, globalSection;
7046   PetscInt      *numbers, p;
7047   PetscErrorCode ierr;
7048 
7049   PetscFunctionBegin;
7050   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
7051   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
7052   for (p = pStart; p < pEnd; ++p) {
7053     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
7054   }
7055   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
7056   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
7057   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
7058   for (p = pStart; p < pEnd; ++p) {
7059     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
7060     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
7061     else                       numbers[p-pStart] += shift;
7062   }
7063   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
7064   if (globalSize) {
7065     PetscLayout layout;
7066     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
7067     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
7068     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
7069   }
7070   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
7071   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
7072   PetscFunctionReturn(0);
7073 }
7074 
DMPlexCreateCellNumbering_Internal(DM dm,PetscBool includeHybrid,IS * globalCellNumbers)7075 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
7076 {
7077   PetscInt       cellHeight, cStart, cEnd;
7078   PetscErrorCode ierr;
7079 
7080   PetscFunctionBegin;
7081   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7082   if (includeHybrid) {ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
7083   else               {ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);}
7084   ierr = DMPlexCreateNumbering_Plex(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
7085   PetscFunctionReturn(0);
7086 }
7087 
7088 /*@
7089   DMPlexGetCellNumbering - Get a global cell numbering for all cells on this process
7090 
7091   Input Parameter:
7092 . dm   - The DMPlex object
7093 
7094   Output Parameter:
7095 . globalCellNumbers - Global cell numbers for all cells on this process
7096 
7097   Level: developer
7098 
7099 .seealso DMPlexGetVertexNumbering()
7100 @*/
DMPlexGetCellNumbering(DM dm,IS * globalCellNumbers)7101 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
7102 {
7103   DM_Plex       *mesh = (DM_Plex*) dm->data;
7104   PetscErrorCode ierr;
7105 
7106   PetscFunctionBegin;
7107   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7108   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
7109   *globalCellNumbers = mesh->globalCellNumbers;
7110   PetscFunctionReturn(0);
7111 }
7112 
DMPlexCreateVertexNumbering_Internal(DM dm,PetscBool includeHybrid,IS * globalVertexNumbers)7113 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
7114 {
7115   PetscInt       vStart, vEnd;
7116   PetscErrorCode ierr;
7117 
7118   PetscFunctionBegin;
7119   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7120   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7121   ierr = DMPlexCreateNumbering_Plex(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
7122   PetscFunctionReturn(0);
7123 }
7124 
7125 /*@
7126   DMPlexGetVertexNumbering - Get a global vertex numbering for all vertices on this process
7127 
7128   Input Parameter:
7129 . dm   - The DMPlex object
7130 
7131   Output Parameter:
7132 . globalVertexNumbers - Global vertex numbers for all vertices on this process
7133 
7134   Level: developer
7135 
7136 .seealso DMPlexGetCellNumbering()
7137 @*/
DMPlexGetVertexNumbering(DM dm,IS * globalVertexNumbers)7138 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
7139 {
7140   DM_Plex       *mesh = (DM_Plex*) dm->data;
7141   PetscErrorCode ierr;
7142 
7143   PetscFunctionBegin;
7144   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7145   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
7146   *globalVertexNumbers = mesh->globalVertexNumbers;
7147   PetscFunctionReturn(0);
7148 }
7149 
7150 /*@
7151   DMPlexCreatePointNumbering - Create a global numbering for all points on this process
7152 
7153   Input Parameter:
7154 . dm   - The DMPlex object
7155 
7156   Output Parameter:
7157 . globalPointNumbers - Global numbers for all points on this process
7158 
7159   Level: developer
7160 
7161 .seealso DMPlexGetCellNumbering()
7162 @*/
DMPlexCreatePointNumbering(DM dm,IS * globalPointNumbers)7163 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
7164 {
7165   IS             nums[4];
7166   PetscInt       depths[4], gdepths[4], starts[4];
7167   PetscInt       depth, d, shift = 0;
7168   PetscErrorCode ierr;
7169 
7170   PetscFunctionBegin;
7171   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7172   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7173   /* For unstratified meshes use dim instead of depth */
7174   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
7175   for (d = 0; d <= depth; ++d) {
7176     PetscInt end;
7177 
7178     depths[d] = depth-d;
7179     ierr = DMPlexGetDepthStratum(dm, depths[d], &starts[d], &end);CHKERRQ(ierr);
7180     if (!(starts[d]-end)) { starts[d] = depths[d] = -1; }
7181   }
7182   ierr = PetscSortIntWithArray(depth+1, starts, depths);CHKERRQ(ierr);
7183   ierr = MPIU_Allreduce(depths, gdepths, depth+1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
7184   for (d = 0; d <= depth; ++d) {
7185     if (starts[d] >= 0 && depths[d] != gdepths[d]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected depth %D, found %D",depths[d],gdepths[d]);
7186   }
7187   for (d = 0; d <= depth; ++d) {
7188     PetscInt pStart, pEnd, gsize;
7189 
7190     ierr = DMPlexGetDepthStratum(dm, gdepths[d], &pStart, &pEnd);CHKERRQ(ierr);
7191     ierr = DMPlexCreateNumbering_Plex(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
7192     shift += gsize;
7193   }
7194   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
7195   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
7196   PetscFunctionReturn(0);
7197 }
7198 
7199 
7200 /*@
7201   DMPlexCreateRankField - Create a cell field whose value is the rank of the owner
7202 
7203   Input Parameter:
7204 . dm - The DMPlex object
7205 
7206   Output Parameter:
7207 . ranks - The rank field
7208 
7209   Options Database Keys:
7210 . -dm_partition_view - Adds the rank field into the DM output from -dm_view using the same viewer
7211 
7212   Level: intermediate
7213 
7214 .seealso: DMView()
7215 @*/
DMPlexCreateRankField(DM dm,Vec * ranks)7216 PetscErrorCode DMPlexCreateRankField(DM dm, Vec *ranks)
7217 {
7218   DM             rdm;
7219   PetscFE        fe;
7220   PetscScalar   *r;
7221   PetscMPIInt    rank;
7222   PetscInt       dim, cStart, cEnd, c;
7223   PetscErrorCode ierr;
7224 
7225   PetscFunctionBeginUser;
7226   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7227   PetscValidPointer(ranks, 2);
7228   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
7229   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7230   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7231   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___rank_", -1, &fe);CHKERRQ(ierr);
7232   ierr = PetscObjectSetName((PetscObject) fe, "rank");CHKERRQ(ierr);
7233   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7234   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7235   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7236   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7237   ierr = DMCreateGlobalVector(rdm, ranks);CHKERRQ(ierr);
7238   ierr = PetscObjectSetName((PetscObject) *ranks, "partition");CHKERRQ(ierr);
7239   ierr = VecGetArray(*ranks, &r);CHKERRQ(ierr);
7240   for (c = cStart; c < cEnd; ++c) {
7241     PetscScalar *lr;
7242 
7243     ierr = DMPlexPointGlobalRef(rdm, c, r, &lr);CHKERRQ(ierr);
7244     if (lr) *lr = rank;
7245   }
7246   ierr = VecRestoreArray(*ranks, &r);CHKERRQ(ierr);
7247   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7248   PetscFunctionReturn(0);
7249 }
7250 
7251 /*@
7252   DMPlexCreateLabelField - Create a cell field whose value is the label value for that cell
7253 
7254   Input Parameters:
7255 + dm    - The DMPlex
7256 - label - The DMLabel
7257 
7258   Output Parameter:
7259 . val - The label value field
7260 
7261   Options Database Keys:
7262 . -dm_label_view - Adds the label value field into the DM output from -dm_view using the same viewer
7263 
7264   Level: intermediate
7265 
7266 .seealso: DMView()
7267 @*/
DMPlexCreateLabelField(DM dm,DMLabel label,Vec * val)7268 PetscErrorCode DMPlexCreateLabelField(DM dm, DMLabel label, Vec *val)
7269 {
7270   DM             rdm;
7271   PetscFE        fe;
7272   PetscScalar   *v;
7273   PetscInt       dim, cStart, cEnd, c;
7274   PetscErrorCode ierr;
7275 
7276   PetscFunctionBeginUser;
7277   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7278   PetscValidPointer(label, 2);
7279   PetscValidPointer(val, 3);
7280   ierr = DMClone(dm, &rdm);CHKERRQ(ierr);
7281   ierr = DMGetDimension(rdm, &dim);CHKERRQ(ierr);
7282   ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) rdm), dim, 1, PETSC_TRUE, "PETSc___label_value_", -1, &fe);CHKERRQ(ierr);
7283   ierr = PetscObjectSetName((PetscObject) fe, "label_value");CHKERRQ(ierr);
7284   ierr = DMSetField(rdm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
7285   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
7286   ierr = DMCreateDS(rdm);CHKERRQ(ierr);
7287   ierr = DMPlexGetHeightStratum(rdm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7288   ierr = DMCreateGlobalVector(rdm, val);CHKERRQ(ierr);
7289   ierr = PetscObjectSetName((PetscObject) *val, "label_value");CHKERRQ(ierr);
7290   ierr = VecGetArray(*val, &v);CHKERRQ(ierr);
7291   for (c = cStart; c < cEnd; ++c) {
7292     PetscScalar *lv;
7293     PetscInt     cval;
7294 
7295     ierr = DMPlexPointGlobalRef(rdm, c, v, &lv);CHKERRQ(ierr);
7296     ierr = DMLabelGetValue(label, c, &cval);CHKERRQ(ierr);
7297     *lv = cval;
7298   }
7299   ierr = VecRestoreArray(*val, &v);CHKERRQ(ierr);
7300   ierr = DMDestroy(&rdm);CHKERRQ(ierr);
7301   PetscFunctionReturn(0);
7302 }
7303 
7304 /*@
7305   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
7306 
7307   Input Parameter:
7308 . dm - The DMPlex object
7309 
7310   Notes:
7311   This is a useful diagnostic when creating meshes programmatically.
7312 
7313   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7314 
7315   Level: developer
7316 
7317 .seealso: DMCreate(), DMSetFromOptions()
7318 @*/
DMPlexCheckSymmetry(DM dm)7319 PetscErrorCode DMPlexCheckSymmetry(DM dm)
7320 {
7321   PetscSection    coneSection, supportSection;
7322   const PetscInt *cone, *support;
7323   PetscInt        coneSize, c, supportSize, s;
7324   PetscInt        pStart, pEnd, p, pp, csize, ssize;
7325   PetscBool       storagecheck = PETSC_TRUE;
7326   PetscErrorCode  ierr;
7327 
7328   PetscFunctionBegin;
7329   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7330   ierr = DMViewFromOptions(dm, NULL, "-sym_dm_view");CHKERRQ(ierr);
7331   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
7332   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
7333   /* Check that point p is found in the support of its cone points, and vice versa */
7334   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
7335   for (p = pStart; p < pEnd; ++p) {
7336     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
7337     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
7338     for (c = 0; c < coneSize; ++c) {
7339       PetscBool dup = PETSC_FALSE;
7340       PetscInt  d;
7341       for (d = c-1; d >= 0; --d) {
7342         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
7343       }
7344       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
7345       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
7346       for (s = 0; s < supportSize; ++s) {
7347         if (support[s] == p) break;
7348       }
7349       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
7350         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
7351         for (s = 0; s < coneSize; ++s) {
7352           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
7353         }
7354         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7355         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
7356         for (s = 0; s < supportSize; ++s) {
7357           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
7358         }
7359         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7360         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
7361         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
7362       }
7363     }
7364     ierr = DMPlexGetTreeParent(dm, p, &pp, NULL);CHKERRQ(ierr);
7365     if (p != pp) { storagecheck = PETSC_FALSE; continue; }
7366     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
7367     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
7368     for (s = 0; s < supportSize; ++s) {
7369       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
7370       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
7371       for (c = 0; c < coneSize; ++c) {
7372         ierr = DMPlexGetTreeParent(dm, cone[c], &pp, NULL);CHKERRQ(ierr);
7373         if (cone[c] != pp) { c = 0; break; }
7374         if (cone[c] == p) break;
7375       }
7376       if (c >= coneSize) {
7377         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
7378         for (c = 0; c < supportSize; ++c) {
7379           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
7380         }
7381         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7382         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
7383         for (c = 0; c < coneSize; ++c) {
7384           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
7385         }
7386         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
7387         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
7388       }
7389     }
7390   }
7391   if (storagecheck) {
7392     ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
7393     ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
7394     if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
7395   }
7396   PetscFunctionReturn(0);
7397 }
7398 
7399 /*
7400   For submeshes with cohesive cells (see DMPlexConstructCohesiveCells()), we allow a special case where some of the boundary of a face (edges and vertices) are not duplicated. We call these special boundary points "unsplit", since the same edge or vertex appears in both copies of the face. These unsplit points throw off our counting, so we have to explicitly account for them here.
7401 */
DMPlexCellUnsplitVertices_Private(DM dm,PetscInt c,DMPolytopeType ct,PetscInt * unsplit)7402 static PetscErrorCode DMPlexCellUnsplitVertices_Private(DM dm, PetscInt c, DMPolytopeType ct, PetscInt *unsplit)
7403 {
7404   DMPolytopeType  cct;
7405   PetscInt        ptpoints[4];
7406   const PetscInt *cone, *ccone, *ptcone;
7407   PetscInt        coneSize, cp, cconeSize, ccp, npt = 0, pt;
7408   PetscErrorCode  ierr;
7409 
7410   PetscFunctionBegin;
7411   *unsplit = 0;
7412   switch (ct) {
7413     case DM_POLYTOPE_SEG_PRISM_TENSOR:
7414       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7415       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7416       for (cp = 0; cp < coneSize; ++cp) {
7417         ierr = DMPlexGetCellType(dm, cone[cp], &cct);CHKERRQ(ierr);
7418         if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) ptpoints[npt++] = cone[cp];
7419       }
7420       break;
7421     case DM_POLYTOPE_TRI_PRISM_TENSOR:
7422     case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7423       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7424       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7425       for (cp = 0; cp < coneSize; ++cp) {
7426         ierr = DMPlexGetCone(dm, cone[cp], &ccone);CHKERRQ(ierr);
7427         ierr = DMPlexGetConeSize(dm, cone[cp], &cconeSize);CHKERRQ(ierr);
7428         for (ccp = 0; ccp < cconeSize; ++ccp) {
7429           ierr = DMPlexGetCellType(dm, ccone[ccp], &cct);CHKERRQ(ierr);
7430           if (cct == DM_POLYTOPE_POINT_PRISM_TENSOR) {
7431             PetscInt p;
7432             for (p = 0; p < npt; ++p) if (ptpoints[p] == ccone[ccp]) break;
7433             if (p == npt) ptpoints[npt++] = ccone[ccp];
7434           }
7435         }
7436       }
7437       break;
7438     default: break;
7439   }
7440   for (pt = 0; pt < npt; ++pt) {
7441     ierr = DMPlexGetCone(dm, ptpoints[pt], &ptcone);CHKERRQ(ierr);
7442     if (ptcone[0] == ptcone[1]) ++(*unsplit);
7443   }
7444   PetscFunctionReturn(0);
7445 }
7446 
7447 /*@
7448   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
7449 
7450   Input Parameters:
7451 + dm - The DMPlex object
7452 - cellHeight - Normally 0
7453 
7454   Notes:
7455   This is a useful diagnostic when creating meshes programmatically.
7456   Currently applicable only to homogeneous simplex or tensor meshes.
7457 
7458   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7459 
7460   Level: developer
7461 
7462 .seealso: DMCreate(), DMSetFromOptions()
7463 @*/
DMPlexCheckSkeleton(DM dm,PetscInt cellHeight)7464 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscInt cellHeight)
7465 {
7466   DMPlexInterpolatedFlag interp;
7467   DMPolytopeType         ct;
7468   PetscInt               vStart, vEnd, cStart, cEnd, c;
7469   PetscErrorCode         ierr;
7470 
7471   PetscFunctionBegin;
7472   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7473   ierr = DMPlexIsInterpolated(dm, &interp);CHKERRQ(ierr);
7474   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7475   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7476   for (c = cStart; c < cEnd; ++c) {
7477     PetscInt *closure = NULL;
7478     PetscInt  coneSize, closureSize, cl, Nv = 0;
7479 
7480     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7481     if ((PetscInt) ct < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has no cell type", c);
7482     if (ct == DM_POLYTOPE_UNKNOWN) continue;
7483     if (interp == DMPLEX_INTERPOLATED_FULL) {
7484       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7485       if (coneSize != DMPolytopeTypeGetConeSize(ct)) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has cone size %D != %D", c, DMPolytopeTypes[ct], coneSize, DMPolytopeTypeGetConeSize(ct));
7486     }
7487     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7488     for (cl = 0; cl < closureSize*2; cl += 2) {
7489       const PetscInt p = closure[cl];
7490       if ((p >= vStart) && (p < vEnd)) ++Nv;
7491     }
7492     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7493     /* Special Case: Tensor faces with identified vertices */
7494     if (Nv < DMPolytopeTypeGetNumVertices(ct)) {
7495       PetscInt unsplit;
7496 
7497       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7498       if (Nv + unsplit == DMPolytopeTypeGetNumVertices(ct)) continue;
7499     }
7500     if (Nv != DMPolytopeTypeGetNumVertices(ct)) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has %D vertices != %D", c, DMPolytopeTypes[ct], Nv, DMPolytopeTypeGetNumVertices(ct));
7501   }
7502   PetscFunctionReturn(0);
7503 }
7504 
7505 /*@
7506   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
7507 
7508   Not Collective
7509 
7510   Input Parameters:
7511 + dm - The DMPlex object
7512 - cellHeight - Normally 0
7513 
7514   Notes:
7515   This is a useful diagnostic when creating meshes programmatically.
7516   This routine is only relevant for meshes that are fully interpolated across all ranks.
7517   It will error out if a partially interpolated mesh is given on some rank.
7518   It will do nothing for locally uninterpolated mesh (as there is nothing to check).
7519 
7520   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7521 
7522   Level: developer
7523 
7524 .seealso: DMCreate(), DMPlexGetVTKCellHeight(), DMSetFromOptions()
7525 @*/
DMPlexCheckFaces(DM dm,PetscInt cellHeight)7526 PetscErrorCode DMPlexCheckFaces(DM dm, PetscInt cellHeight)
7527 {
7528   PetscInt       dim, depth, vStart, vEnd, cStart, cEnd, c, h;
7529   PetscErrorCode ierr;
7530   DMPlexInterpolatedFlag interpEnum;
7531 
7532   PetscFunctionBegin;
7533   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7534   ierr = DMPlexIsInterpolated(dm, &interpEnum);CHKERRQ(ierr);
7535   if (interpEnum == DMPLEX_INTERPOLATED_NONE) PetscFunctionReturn(0);
7536   if (interpEnum == DMPLEX_INTERPOLATED_PARTIAL) {
7537     PetscMPIInt rank;
7538     MPI_Comm    comm;
7539 
7540     ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
7541     ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
7542     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Mesh is only partially interpolated on rank %d, this is currently not supported", rank);
7543   }
7544 
7545   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7546   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7547   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
7548   for (h = cellHeight; h < PetscMin(depth, dim); ++h) {
7549     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
7550     for (c = cStart; c < cEnd; ++c) {
7551       const PetscInt      *cone, *ornt, *faceSizes, *faces;
7552       const DMPolytopeType *faceTypes;
7553       DMPolytopeType        ct;
7554       PetscInt              numFaces, coneSize, f;
7555       PetscInt             *closure = NULL, closureSize, cl, numCorners = 0, fOff = 0, unsplit;
7556 
7557       ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7558       ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7559       if (unsplit) continue;
7560       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
7561       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
7562       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
7563       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7564       for (cl = 0; cl < closureSize*2; cl += 2) {
7565         const PetscInt p = closure[cl];
7566         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
7567       }
7568       ierr = DMPlexGetRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7569       if (coneSize != numFaces) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D of type %s has %D faces but should have %D", c, DMPolytopeTypes[ct], coneSize, numFaces);
7570       for (f = 0; f < numFaces; ++f) {
7571         DMPolytopeType fct;
7572         PetscInt       *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
7573 
7574         ierr = DMPlexGetCellType(dm, cone[f], &fct);CHKERRQ(ierr);
7575         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7576         for (cl = 0; cl < fclosureSize*2; cl += 2) {
7577           const PetscInt p = fclosure[cl];
7578           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
7579         }
7580         if (fnumCorners != faceSizes[f]) SETERRQ7(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D of type %s (cone idx %D) of cell %D of type %s has %D vertices but should have %D", cone[f], DMPolytopeTypes[fct], f, c, DMPolytopeTypes[ct], fnumCorners, faceSizes[f]);
7581         for (v = 0; v < fnumCorners; ++v) {
7582           if (fclosure[v] != faces[fOff+v]) SETERRQ8(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D of type %s (cone idx %d) of cell %D of type %s vertex %D, %D != %D", cone[f], DMPolytopeTypes[fct], f, c, DMPolytopeTypes[ct], v, fclosure[v], faces[fOff+v]);
7583         }
7584         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
7585         fOff += faceSizes[f];
7586       }
7587       ierr = DMPlexRestoreRawFaces_Internal(dm, ct, closure, &numFaces, &faceTypes, &faceSizes, &faces);CHKERRQ(ierr);
7588       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
7589     }
7590   }
7591   PetscFunctionReturn(0);
7592 }
7593 
7594 /*@
7595   DMPlexCheckGeometry - Check the geometry of mesh cells
7596 
7597   Input Parameter:
7598 . dm - The DMPlex object
7599 
7600   Notes:
7601   This is a useful diagnostic when creating meshes programmatically.
7602 
7603   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7604 
7605   Level: developer
7606 
7607 .seealso: DMCreate(), DMSetFromOptions()
7608 @*/
DMPlexCheckGeometry(DM dm)7609 PetscErrorCode DMPlexCheckGeometry(DM dm)
7610 {
7611   PetscReal      detJ, J[9], refVol = 1.0;
7612   PetscReal      vol;
7613   PetscBool      periodic;
7614   PetscInt       dim, depth, dE, d, cStart, cEnd, c;
7615   PetscErrorCode ierr;
7616 
7617   PetscFunctionBegin;
7618   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
7619   ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
7620   if (dim != dE) PetscFunctionReturn(0);
7621   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
7622   ierr = DMGetPeriodicity(dm, &periodic, NULL, NULL, NULL);CHKERRQ(ierr);
7623   for (d = 0; d < dim; ++d) refVol *= 2.0;
7624   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
7625   for (c = cStart; c < cEnd; ++c) {
7626     DMPolytopeType ct;
7627     PetscInt       unsplit;
7628     PetscBool      ignoreZeroVol = PETSC_FALSE;
7629 
7630     ierr = DMPlexGetCellType(dm, c, &ct);CHKERRQ(ierr);
7631     switch (ct) {
7632       case DM_POLYTOPE_SEG_PRISM_TENSOR:
7633       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7634       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7635         ignoreZeroVol = PETSC_TRUE; break;
7636       default: break;
7637     }
7638     switch (ct) {
7639       case DM_POLYTOPE_TRI_PRISM:
7640       case DM_POLYTOPE_TRI_PRISM_TENSOR:
7641       case DM_POLYTOPE_QUAD_PRISM_TENSOR:
7642         continue;
7643       default: break;
7644     }
7645     ierr = DMPlexCellUnsplitVertices_Private(dm, c, ct, &unsplit);CHKERRQ(ierr);
7646     if (unsplit) continue;
7647     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, NULL, J, NULL, &detJ);CHKERRQ(ierr);
7648     if (detJ < -PETSC_SMALL || (detJ <= 0.0 && !ignoreZeroVol)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D of type %s is inverted, |J| = %g", c, DMPolytopeTypes[ct], (double) detJ);
7649     ierr = PetscInfo2(dm, "Cell %D FEM Volume %g\n", c, (double) detJ*refVol);CHKERRQ(ierr);
7650     if (depth > 1 && !periodic) {
7651       ierr = DMPlexComputeCellGeometryFVM(dm, c, &vol, NULL, NULL);CHKERRQ(ierr);
7652       if (vol < -PETSC_SMALL || (vol <= 0.0 && !ignoreZeroVol)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D of type %s is inverted, vol = %g", c, DMPolytopeTypes[ct], (double) vol);
7653       ierr = PetscInfo2(dm, "Cell %D FVM Volume %g\n", c, (double) vol);CHKERRQ(ierr);
7654     }
7655   }
7656   PetscFunctionReturn(0);
7657 }
7658 
7659 /*@
7660   DMPlexCheckPointSF - Check that several necessary conditions are met for the point SF of this plex.
7661 
7662   Input Parameters:
7663 . dm - The DMPlex object
7664 
7665   Notes:
7666   This is mainly intended for debugging/testing purposes.
7667   It currently checks only meshes with no partition overlapping.
7668 
7669   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7670 
7671   Level: developer
7672 
7673 .seealso: DMGetPointSF(), DMSetFromOptions()
7674 @*/
DMPlexCheckPointSF(DM dm)7675 PetscErrorCode DMPlexCheckPointSF(DM dm)
7676 {
7677   PetscSF         pointSF;
7678   PetscInt        cellHeight, cStart, cEnd, l, nleaves, nroots, overlap;
7679   const PetscInt *locals, *rootdegree;
7680   PetscBool       distributed;
7681   PetscErrorCode  ierr;
7682 
7683   PetscFunctionBegin;
7684   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7685   ierr = DMGetPointSF(dm, &pointSF);CHKERRQ(ierr);
7686   ierr = DMPlexIsDistributed(dm, &distributed);CHKERRQ(ierr);
7687   if (!distributed) PetscFunctionReturn(0);
7688   ierr = DMPlexGetOverlap(dm, &overlap);CHKERRQ(ierr);
7689   if (overlap) {
7690     ierr = PetscPrintf(PetscObjectComm((PetscObject)dm), "Warning: DMPlexCheckPointSF() is currently not implemented for meshes with partition overlapping");
7691     PetscFunctionReturn(0);
7692   }
7693   if (!pointSF) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but does not have PointSF attached");
7694   ierr = PetscSFGetGraph(pointSF, &nroots, &nleaves, &locals, NULL);CHKERRQ(ierr);
7695   if (nroots < 0) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "This DMPlex is distributed but its PointSF has no graph set");
7696   ierr = PetscSFComputeDegreeBegin(pointSF, &rootdegree);CHKERRQ(ierr);
7697   ierr = PetscSFComputeDegreeEnd(pointSF, &rootdegree);CHKERRQ(ierr);
7698 
7699   /* 1) check there are no faces in 2D, cells in 3D, in interface */
7700   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7701   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7702   for (l = 0; l < nleaves; ++l) {
7703     const PetscInt point = locals[l];
7704 
7705     if (point >= cStart && point < cEnd) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D which is a cell", point);
7706   }
7707 
7708   /* 2) if some point is in interface, then all its cone points must be also in interface (either as leaves or roots) */
7709   for (l = 0; l < nleaves; ++l) {
7710     const PetscInt  point = locals[l];
7711     const PetscInt *cone;
7712     PetscInt        coneSize, c, idx;
7713 
7714     ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
7715     ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
7716     for (c = 0; c < coneSize; ++c) {
7717       if (!rootdegree[cone[c]]) {
7718         ierr = PetscFindInt(cone[c], nleaves, locals, &idx);CHKERRQ(ierr);
7719         if (idx < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point SF contains %D but not %D from its cone", point, cone[c]);
7720       }
7721     }
7722   }
7723   PetscFunctionReturn(0);
7724 }
7725 
7726 typedef struct cell_stats
7727 {
7728   PetscReal min, max, sum, squaresum;
7729   PetscInt  count;
7730 } cell_stats_t;
7731 
cell_stats_reduce(void * a,void * b,int * len,MPI_Datatype * datatype)7732 static void MPIAPI cell_stats_reduce(void *a, void *b, int * len, MPI_Datatype *datatype)
7733 {
7734   PetscInt i, N = *len;
7735 
7736   for (i = 0; i < N; i++) {
7737     cell_stats_t *A = (cell_stats_t *) a;
7738     cell_stats_t *B = (cell_stats_t *) b;
7739 
7740     B->min = PetscMin(A->min,B->min);
7741     B->max = PetscMax(A->max,B->max);
7742     B->sum += A->sum;
7743     B->squaresum += A->squaresum;
7744     B->count += A->count;
7745   }
7746 }
7747 
7748 /*@
7749   DMPlexCheckCellShape - Checks the Jacobian of the mapping from reference to real cells and computes some minimal statistics.
7750 
7751   Collective on dm
7752 
7753   Input Parameters:
7754 + dm        - The DMPlex object
7755 . output    - If true, statistics will be displayed on stdout
7756 - condLimit - Display all cells above this condition number, or PETSC_DETERMINE for no cell output
7757 
7758   Notes:
7759   This is mainly intended for debugging/testing purposes.
7760 
7761   For the complete list of DMPlexCheck* functions, see DMSetFromOptions().
7762 
7763   Level: developer
7764 
7765 .seealso: DMSetFromOptions(), DMPlexComputeOrthogonalQuality()
7766 @*/
DMPlexCheckCellShape(DM dm,PetscBool output,PetscReal condLimit)7767 PetscErrorCode DMPlexCheckCellShape(DM dm, PetscBool output, PetscReal condLimit)
7768 {
7769   DM             dmCoarse;
7770   cell_stats_t   stats, globalStats;
7771   MPI_Comm       comm = PetscObjectComm((PetscObject)dm);
7772   PetscReal      *J, *invJ, min = 0, max = 0, mean = 0, stdev = 0;
7773   PetscReal      limit = condLimit > 0 ? condLimit : PETSC_MAX_REAL;
7774   PetscInt       cdim, cStart, cEnd, c, eStart, eEnd, count = 0;
7775   PetscMPIInt    rank,size;
7776   PetscErrorCode ierr;
7777 
7778   PetscFunctionBegin;
7779   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7780   stats.min   = PETSC_MAX_REAL;
7781   stats.max   = PETSC_MIN_REAL;
7782   stats.sum   = stats.squaresum = 0.;
7783   stats.count = 0;
7784 
7785   ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
7786   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
7787   ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
7788   ierr = PetscMalloc2(PetscSqr(cdim), &J, PetscSqr(cdim), &invJ);CHKERRQ(ierr);
7789   ierr = DMPlexGetSimplexOrBoxCells(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
7790   ierr = DMPlexGetDepthStratum(dm,1,&eStart,&eEnd);CHKERRQ(ierr);
7791   for (c = cStart; c < cEnd; c++) {
7792     PetscInt  i;
7793     PetscReal frobJ = 0., frobInvJ = 0., cond2, cond, detJ;
7794 
7795     ierr = DMPlexComputeCellGeometryAffineFEM(dm,c,NULL,J,invJ,&detJ);CHKERRQ(ierr);
7796     if (detJ < 0.0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh cell %D is inverted", c);
7797     for (i = 0; i < PetscSqr(cdim); ++i) {
7798       frobJ    += J[i] * J[i];
7799       frobInvJ += invJ[i] * invJ[i];
7800     }
7801     cond2 = frobJ * frobInvJ;
7802     cond  = PetscSqrtReal(cond2);
7803 
7804     stats.min        = PetscMin(stats.min,cond);
7805     stats.max        = PetscMax(stats.max,cond);
7806     stats.sum       += cond;
7807     stats.squaresum += cond2;
7808     stats.count++;
7809     if (output && cond > limit) {
7810       PetscSection coordSection;
7811       Vec          coordsLocal;
7812       PetscScalar *coords = NULL;
7813       PetscInt     Nv, d, clSize, cl, *closure = NULL;
7814 
7815       ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
7816       ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
7817       ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7818       ierr = PetscSynchronizedPrintf(comm, "[%d] Cell %D cond %g\n", rank, c, (double) cond);CHKERRQ(ierr);
7819       for (i = 0; i < Nv/cdim; ++i) {
7820         ierr = PetscSynchronizedPrintf(comm, "  Vertex %D: (", i);CHKERRQ(ierr);
7821         for (d = 0; d < cdim; ++d) {
7822           if (d > 0) {ierr = PetscSynchronizedPrintf(comm, ", ");CHKERRQ(ierr);}
7823           ierr = PetscSynchronizedPrintf(comm, "%g", (double) PetscRealPart(coords[i*cdim+d]));CHKERRQ(ierr);
7824         }
7825         ierr = PetscSynchronizedPrintf(comm, ")\n");CHKERRQ(ierr);
7826       }
7827       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7828       for (cl = 0; cl < clSize*2; cl += 2) {
7829         const PetscInt edge = closure[cl];
7830 
7831         if ((edge >= eStart) && (edge < eEnd)) {
7832           PetscReal len;
7833 
7834           ierr = DMPlexComputeCellGeometryFVM(dm, edge, &len, NULL, NULL);CHKERRQ(ierr);
7835           ierr = PetscSynchronizedPrintf(comm, "  Edge %D: length %g\n", edge, (double) len);CHKERRQ(ierr);
7836         }
7837       }
7838       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &clSize, &closure);CHKERRQ(ierr);
7839       ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, &Nv, &coords);CHKERRQ(ierr);
7840     }
7841   }
7842   if (output) {ierr = PetscSynchronizedFlush(comm, NULL);CHKERRQ(ierr);}
7843 
7844   if (size > 1) {
7845     PetscMPIInt   blockLengths[2] = {4,1};
7846     MPI_Aint      blockOffsets[2] = {offsetof(cell_stats_t,min),offsetof(cell_stats_t,count)};
7847     MPI_Datatype  blockTypes[2]   = {MPIU_REAL,MPIU_INT}, statType;
7848     MPI_Op        statReduce;
7849 
7850     ierr = MPI_Type_create_struct(2,blockLengths,blockOffsets,blockTypes,&statType);CHKERRQ(ierr);
7851     ierr = MPI_Type_commit(&statType);CHKERRQ(ierr);
7852     ierr = MPI_Op_create(cell_stats_reduce, PETSC_TRUE, &statReduce);CHKERRQ(ierr);
7853     ierr = MPI_Reduce(&stats,&globalStats,1,statType,statReduce,0,comm);CHKERRQ(ierr);
7854     ierr = MPI_Op_free(&statReduce);CHKERRQ(ierr);
7855     ierr = MPI_Type_free(&statType);CHKERRQ(ierr);
7856   } else {
7857     ierr = PetscArraycpy(&globalStats,&stats,1);CHKERRQ(ierr);
7858   }
7859   if (!rank) {
7860     count = globalStats.count;
7861     min   = globalStats.min;
7862     max   = globalStats.max;
7863     mean  = globalStats.sum / globalStats.count;
7864     stdev = globalStats.count > 1 ? PetscSqrtReal(PetscMax((globalStats.squaresum - globalStats.count * mean * mean) / (globalStats.count - 1),0)) : 0.0;
7865   }
7866 
7867   if (output) {
7868     ierr = PetscPrintf(comm,"Mesh with %D cells, shape condition numbers: min = %g, max = %g, mean = %g, stddev = %g\n", count, (double) min, (double) max, (double) mean, (double) stdev);CHKERRQ(ierr);
7869   }
7870   ierr = PetscFree2(J,invJ);CHKERRQ(ierr);
7871 
7872   ierr = DMGetCoarseDM(dm,&dmCoarse);CHKERRQ(ierr);
7873   if (dmCoarse) {
7874     PetscBool isplex;
7875 
7876     ierr = PetscObjectTypeCompare((PetscObject)dmCoarse,DMPLEX,&isplex);CHKERRQ(ierr);
7877     if (isplex) {
7878       ierr = DMPlexCheckCellShape(dmCoarse,output,condLimit);CHKERRQ(ierr);
7879     }
7880   }
7881   PetscFunctionReturn(0);
7882 }
7883 
7884 /*@
7885   DMPlexComputeOrthogonalQuality - Compute cell-wise orthogonal quality mesh statistic. Optionally tags all cells with
7886   orthogonal quality below given tolerance.
7887 
7888   Collective
7889 
7890   Input Parameters:
7891 + dm   - The DMPlex object
7892 . fv   - Optional PetscFV object for pre-computed cell/face centroid information
7893 - atol - [0, 1] Absolute tolerance for tagging cells.
7894 
7895   Output Parameters:
7896 + OrthQual      - Vec containing orthogonal quality per cell
7897 - OrthQualLabel - DMLabel tagging cells below atol with DM_ADAPT_REFINE
7898 
7899   Options Database Keys:
7900 + -dm_plex_orthogonal_quality_label_view - view OrthQualLabel if label is requested. Currently only PETSCVIEWERASCII is
7901 supported.
7902 - -dm_plex_orthogonal_quality_vec_view - view OrthQual vector.
7903 
7904   Notes:
7905   Orthogonal quality is given by the following formula:
7906 
7907   \min \left[ \frac{A_i \cdot f_i}{\|A_i\| \|f_i\|} , \frac{A_i \cdot c_i}{\|A_i\| \|c_i\|} \right]
7908 
7909   Where A_i is the i'th face-normal vector, f_i is the vector from the cell centroid to the i'th face centroid, and c_i
7910   is the vector from the current cells centroid to the centroid of its i'th neighbor (which shares a face with the
7911   current cell). This computes the vector similarity between each cell face and its corresponding neighbor centroid by
7912   calculating the cosine of the angle between these vectors.
7913 
7914   Orthogonal quality ranges from 1 (best) to 0 (worst).
7915 
7916   This routine is mainly useful for FVM, however is not restricted to only FVM. The PetscFV object is optionally used to check for
7917   pre-computed FVM cell data, but if it is not passed in then this data will be computed.
7918 
7919   Cells are tagged if they have an orthogonal quality less than or equal to the absolute tolerance.
7920 
7921   Level: intermediate
7922 
7923 .seealso: DMPlexCheckCellShape(), DMCreateLabel()
7924 @*/
DMPlexComputeOrthogonalQuality(DM dm,PetscFV fv,PetscReal atol,Vec * OrthQual,DMLabel * OrthQualLabel)7925 PetscErrorCode DMPlexComputeOrthogonalQuality(DM dm, PetscFV fv, PetscReal atol, Vec *OrthQual, DMLabel *OrthQualLabel)
7926 {
7927   PetscInt                nc, cellHeight, cStart, cEnd, cell;
7928   const PetscScalar       *cellGeomArr, *faceGeomArr;
7929   MPI_Comm                comm;
7930   Vec                     cellgeom, facegeom;
7931   DM                      dmFace, dmCell;
7932   IS                      glob;
7933   DMPlexInterpolatedFlag  interpFlag;
7934   ISLocalToGlobalMapping  ltog;
7935   PetscViewer             vwr;
7936   PetscErrorCode          ierr;
7937 
7938   PetscFunctionBegin;
7939   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
7940   PetscValidPointer(OrthQual, 4);
7941   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
7942   ierr = DMGetDimension(dm, &nc);CHKERRQ(ierr);
7943   if (nc < 2) {
7944     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "DM must have dimension >= 2 (current %D)", nc);
7945   }
7946   ierr = DMPlexIsInterpolated(dm, &interpFlag);CHKERRQ(ierr);
7947   if (interpFlag != DMPLEX_INTERPOLATED_FULL) {
7948     PetscMPIInt  rank;
7949 
7950     ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
7951     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "DM must be fully interpolated, DM on rank %d is not fully interpolated", rank);
7952   }
7953   if (OrthQualLabel) {
7954     PetscValidPointer(OrthQualLabel, 5);
7955     ierr = DMCreateLabel(dm, "Orthogonal_Quality");CHKERRQ(ierr);
7956     ierr = DMGetLabel(dm, "Orthogonal_Quality", OrthQualLabel);CHKERRQ(ierr);
7957   } else {
7958     *OrthQualLabel = NULL;
7959   }
7960 
7961   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
7962   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
7963   ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &glob);CHKERRQ(ierr);
7964   ierr = ISLocalToGlobalMappingCreateIS(glob, &ltog);CHKERRQ(ierr);
7965   ierr = ISLocalToGlobalMappingSetType(ltog, ISLOCALTOGLOBALMAPPINGHASH);CHKERRQ(ierr);
7966   ierr = VecCreate(comm, OrthQual);CHKERRQ(ierr);
7967   ierr = VecSetType(*OrthQual, VECSTANDARD);CHKERRQ(ierr);
7968   ierr = VecSetSizes(*OrthQual, cEnd-cStart, PETSC_DETERMINE);CHKERRQ(ierr);
7969   ierr = VecSetLocalToGlobalMapping(*OrthQual, ltog);CHKERRQ(ierr);
7970   ierr = VecSetUp(*OrthQual);CHKERRQ(ierr);
7971   ierr = ISDestroy(&glob);CHKERRQ(ierr);
7972   ierr = ISLocalToGlobalMappingDestroy(&ltog);CHKERRQ(ierr);
7973   ierr = DMPlexGetDataFVM(dm, fv, &cellgeom, &facegeom, NULL);CHKERRQ(ierr);
7974   ierr = VecGetArrayRead(cellgeom, &cellGeomArr);CHKERRQ(ierr);
7975   ierr = VecGetArrayRead(facegeom, &faceGeomArr);CHKERRQ(ierr);
7976   ierr = VecGetDM(cellgeom, &dmCell);CHKERRQ(ierr);
7977   ierr = VecGetDM(facegeom, &dmFace);CHKERRQ(ierr);
7978   for (cell = cStart; cell < cEnd; cell++) {
7979     PetscInt           cellneigh, cellneighiter = 0, nf, adjSize = PETSC_DETERMINE, ix = cell-cStart;
7980     const PetscInt     *cone;
7981     PetscInt           cellarr[2], *adj = NULL;
7982     PetscScalar        *cArr, *fArr;
7983     PetscReal          minvalc = 1.0, minvalf = 1.0, OQ;
7984     PetscFVCellGeom    *cg;
7985 
7986     cellarr[0] = cell;
7987     /* Make indexing into cellGeom easier */
7988     ierr = DMPlexPointLocalRead(dmCell, cell, cellGeomArr, &cg);CHKERRQ(ierr);
7989     ierr = DMPlexGetAdjacency_Internal(dm, cell, PETSC_TRUE, PETSC_FALSE, PETSC_FALSE, &adjSize, &adj);CHKERRQ(ierr);
7990     ierr = DMPlexGetConeSize(dm, cell, &nf);CHKERRQ(ierr);
7991     ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
7992     /* Technically 1 too big, but easier than fiddling with empty adjacency array */
7993     ierr = PetscCalloc2(adjSize, &cArr, adjSize, &fArr);CHKERRQ(ierr);
7994     for (cellneigh = 0; cellneigh < adjSize; cellneigh++) {
7995       PetscInt         numcovpts, i, neigh = adj[cellneigh];
7996       const PetscInt   *covpts;
7997       PetscReal        normci = 0, normfi = 0, normai = 0;
7998       PetscReal        *ci, *fi, *Ai;
7999       PetscFVCellGeom  *cgneigh;
8000       PetscFVFaceGeom  *fg;
8001 
8002       /* Don't count ourselves in the neighbor list */
8003       if (neigh == cell) continue;
8004       ierr = PetscMalloc3(nc, &ci, nc, &fi, nc, &Ai);CHKERRQ(ierr);
8005       ierr = DMPlexPointLocalRead(dmCell, neigh, cellGeomArr, &cgneigh);CHKERRQ(ierr);
8006       cellarr[1] = neigh;
8007       ierr = DMPlexGetMeet(dm, 2, cellarr, &numcovpts, &covpts);CHKERRQ(ierr);
8008       ierr = DMPlexPointLocalRead(dmFace, covpts[0], faceGeomArr, &fg);CHKERRQ(ierr);
8009       ierr = DMPlexRestoreMeet(dm, 2, cellarr, &numcovpts, &covpts);CHKERRQ(ierr);
8010 
8011       /* Compute c_i, f_i and their norms */
8012       for (i = 0; i < nc; i++) {
8013         ci[i] = cgneigh->centroid[i] - cg->centroid[i];
8014         fi[i] = fg->centroid[i] - cg->centroid[i];
8015         Ai[i] = fg->normal[i];
8016         normci += PetscPowScalar(ci[i], 2);
8017         normfi += PetscPowScalar(fi[i], 2);
8018         normai += PetscPowScalar(Ai[i], 2);
8019       }
8020       normci = PetscSqrtScalar(normci);
8021       normfi = PetscSqrtScalar(normfi);
8022       normai = PetscSqrtScalar(normai);
8023 
8024       /* Normalize and compute for each face-cell-normal pair */
8025       for (i = 0; i < nc; i++) {
8026         ci[i] = ci[i]/normci;
8027         fi[i] = fi[i]/normfi;
8028         Ai[i] = Ai[i]/normai;
8029         /* PetscAbs because I don't know if normals are guaranteed to point out */
8030         cArr[cellneighiter] += PetscAbs(Ai[i]*ci[i]);
8031         fArr[cellneighiter] += PetscAbs(Ai[i]*fi[i]);
8032       }
8033       if (PetscRealPart(cArr[cellneighiter]) < minvalc) {
8034         minvalc = PetscRealPart(cArr[cellneighiter]);
8035       }
8036       if (PetscRealPart(fArr[cellneighiter]) < minvalf) {
8037         minvalf = PetscRealPart(fArr[cellneighiter]);
8038       }
8039       cellneighiter++;
8040       ierr = PetscFree3(ci, fi, Ai);CHKERRQ(ierr);
8041     }
8042     ierr = PetscFree(adj);CHKERRQ(ierr);
8043     ierr = PetscFree2(cArr, fArr);CHKERRQ(ierr);
8044     /* Defer to cell if they're equal */
8045     OQ = PetscMin(minvalf, minvalc);
8046     if (OrthQualLabel) {
8047       if (OQ <= atol) {
8048         ierr = DMLabelSetValue(*OrthQualLabel, cell, DM_ADAPT_REFINE);CHKERRQ(ierr);
8049       }
8050     }
8051     ierr = VecSetValuesLocal(*OrthQual, 1, (const PetscInt *) &ix, (const PetscScalar *) &OQ, INSERT_VALUES);CHKERRQ(ierr);
8052   }
8053   ierr = VecAssemblyBegin(*OrthQual);CHKERRQ(ierr);
8054   ierr = VecAssemblyEnd(*OrthQual);CHKERRQ(ierr);
8055   ierr = VecRestoreArrayRead(cellgeom, &cellGeomArr);CHKERRQ(ierr);
8056   ierr = VecRestoreArrayRead(facegeom, &faceGeomArr);CHKERRQ(ierr);
8057   ierr = PetscOptionsGetViewer(comm, NULL, NULL, "-dm_plex_orthogonal_quality_label_view", &vwr, NULL, NULL);CHKERRQ(ierr);
8058   if (OrthQualLabel) {
8059     if (vwr) {
8060       ierr = DMLabelView(*OrthQualLabel, vwr);CHKERRQ(ierr);
8061     }
8062   }
8063   ierr = PetscViewerDestroy(&vwr);CHKERRQ(ierr);
8064   ierr = VecViewFromOptions(*OrthQual, NULL, "-dm_plex_orthogonal_quality_vec_view");CHKERRQ(ierr);
8065   PetscFunctionReturn(0);
8066 }
8067 
8068 /* Pointwise interpolation
8069      Just code FEM for now
8070      u^f = I u^c
8071      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
8072      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
8073      I_{ij} = psi^f_i phi^c_j
8074 */
DMCreateInterpolation_Plex(DM dmCoarse,DM dmFine,Mat * interpolation,Vec * scaling)8075 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
8076 {
8077   PetscSection   gsc, gsf;
8078   PetscInt       m, n;
8079   void          *ctx;
8080   DM             cdm;
8081   PetscBool      regular, ismatis, isRefined = dmCoarse->data == dmFine->data ? PETSC_FALSE : PETSC_TRUE;
8082   PetscErrorCode ierr;
8083 
8084   PetscFunctionBegin;
8085   ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
8086   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
8087   ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
8088   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
8089 
8090   ierr = PetscStrcmp(dmCoarse->mattype, MATIS, &ismatis);CHKERRQ(ierr);
8091   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
8092   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
8093   ierr = MatSetType(*interpolation, ismatis ? MATAIJ : dmCoarse->mattype);CHKERRQ(ierr);
8094   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
8095 
8096   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
8097   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
8098   if (!isRefined || (regular && cdm == dmCoarse)) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, isRefined, *interpolation, ctx);CHKERRQ(ierr);}
8099   else                                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
8100   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
8101   if (scaling) {
8102     /* Use naive scaling */
8103     ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
8104   }
8105   PetscFunctionReturn(0);
8106 }
8107 
DMCreateInjection_Plex(DM dmCoarse,DM dmFine,Mat * mat)8108 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
8109 {
8110   PetscErrorCode ierr;
8111   VecScatter     ctx;
8112 
8113   PetscFunctionBegin;
8114   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
8115   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
8116   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
8117   PetscFunctionReturn(0);
8118 }
8119 
g0_identity_private(PetscInt dim,PetscInt Nf,PetscInt NfAux,const PetscInt uOff[],const PetscInt uOff_x[],const PetscScalar u[],const PetscScalar u_t[],const PetscScalar u_x[],const PetscInt aOff[],const PetscInt aOff_x[],const PetscScalar a[],const PetscScalar a_t[],const PetscScalar a_x[],PetscReal t,PetscReal u_tShift,const PetscReal x[],PetscInt numConstants,const PetscScalar constants[],PetscScalar g0[])8120 static void g0_identity_private(PetscInt dim, PetscInt Nf, PetscInt NfAux,
8121                                 const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
8122                                 const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
8123                                 PetscReal t, PetscReal u_tShift, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar g0[])
8124 {
8125   g0[0] = 1.0;
8126 }
8127 
DMCreateMassMatrix_Plex(DM dmCoarse,DM dmFine,Mat * mass)8128 PetscErrorCode DMCreateMassMatrix_Plex(DM dmCoarse, DM dmFine, Mat *mass)
8129 {
8130   PetscSection   gsc, gsf;
8131   PetscInt       m, n;
8132   void          *ctx;
8133   DM             cdm;
8134   PetscBool      regular;
8135   PetscErrorCode ierr;
8136 
8137   PetscFunctionBegin;
8138   if (dmFine == dmCoarse) {
8139     DM       dmc;
8140     PetscDS  ds;
8141     Vec      u;
8142     IS       cellIS;
8143     PetscInt depth;
8144 
8145     ierr = DMClone(dmFine, &dmc);CHKERRQ(ierr);
8146     ierr = DMCopyDisc(dmFine, dmc);CHKERRQ(ierr);
8147     ierr = DMGetDS(dmc, &ds);CHKERRQ(ierr);
8148     ierr = PetscDSSetJacobian(ds, 0, 0, g0_identity_private, NULL, NULL, NULL);CHKERRQ(ierr);
8149     ierr = DMCreateMatrix(dmc, mass);CHKERRQ(ierr);
8150     ierr = DMGetGlobalVector(dmc, &u);CHKERRQ(ierr);
8151     ierr = DMPlexGetDepth(dmc, &depth);CHKERRQ(ierr);
8152     ierr = DMGetStratumIS(dmc, "depth", depth, &cellIS);CHKERRQ(ierr);
8153     ierr = MatZeroEntries(*mass);CHKERRQ(ierr);
8154     ierr = DMPlexComputeJacobian_Internal(dmc, cellIS, 0.0, 0.0, u, NULL, *mass, *mass, NULL);CHKERRQ(ierr);
8155     ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
8156     ierr = DMRestoreGlobalVector(dmc, &u);CHKERRQ(ierr);
8157     ierr = DMDestroy(&dmc);CHKERRQ(ierr);
8158   } else {
8159     ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
8160     ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
8161     ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
8162     ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
8163 
8164     ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), mass);CHKERRQ(ierr);
8165     ierr = MatSetSizes(*mass, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
8166     ierr = MatSetType(*mass, dmCoarse->mattype);CHKERRQ(ierr);
8167     ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
8168 
8169     ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
8170     ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
8171     if (regular && cdm == dmCoarse) {ierr = DMPlexComputeMassMatrixNested(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
8172     else                            {ierr = DMPlexComputeMassMatrixGeneral(dmCoarse, dmFine, *mass, ctx);CHKERRQ(ierr);}
8173   }
8174   ierr = MatViewFromOptions(*mass, NULL, "-mass_mat_view");CHKERRQ(ierr);
8175   PetscFunctionReturn(0);
8176 }
8177 
8178 /*@
8179   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
8180 
8181   Input Parameter:
8182 . dm - The DMPlex object
8183 
8184   Output Parameter:
8185 . regular - The flag
8186 
8187   Level: intermediate
8188 
8189 .seealso: DMPlexSetRegularRefinement()
8190 @*/
DMPlexGetRegularRefinement(DM dm,PetscBool * regular)8191 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
8192 {
8193   PetscFunctionBegin;
8194   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8195   PetscValidPointer(regular, 2);
8196   *regular = ((DM_Plex *) dm->data)->regularRefinement;
8197   PetscFunctionReturn(0);
8198 }
8199 
8200 /*@
8201   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
8202 
8203   Input Parameters:
8204 + dm - The DMPlex object
8205 - regular - The flag
8206 
8207   Level: intermediate
8208 
8209 .seealso: DMPlexGetRegularRefinement()
8210 @*/
DMPlexSetRegularRefinement(DM dm,PetscBool regular)8211 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
8212 {
8213   PetscFunctionBegin;
8214   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8215   ((DM_Plex *) dm->data)->regularRefinement = regular;
8216   PetscFunctionReturn(0);
8217 }
8218 
8219 /*@
8220   DMPlexGetCellRefinerType - Get the strategy for refining a cell
8221 
8222   Input Parameter:
8223 . dm - The DMPlex object
8224 
8225   Output Parameter:
8226 . cr - The strategy number
8227 
8228   Level: intermediate
8229 
8230 .seealso: DMPlexSetCellRefinerType(), DMPlexSetRegularRefinement()
8231 @*/
DMPlexGetCellRefinerType(DM dm,DMPlexCellRefinerType * cr)8232 PetscErrorCode DMPlexGetCellRefinerType(DM dm, DMPlexCellRefinerType *cr)
8233 {
8234   PetscFunctionBegin;
8235   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8236   PetscValidPointer(cr, 2);
8237   *cr = ((DM_Plex *) dm->data)->cellRefiner;
8238   PetscFunctionReturn(0);
8239 }
8240 
8241 /*@
8242   DMPlexSetCellRefinerType - Set the strategy for refining a cell
8243 
8244   Input Parameters:
8245 + dm - The DMPlex object
8246 - cr - The strategy number
8247 
8248   Level: intermediate
8249 
8250 .seealso: DMPlexGetCellRefinerType(), DMPlexGetRegularRefinement()
8251 @*/
DMPlexSetCellRefinerType(DM dm,DMPlexCellRefinerType cr)8252 PetscErrorCode DMPlexSetCellRefinerType(DM dm, DMPlexCellRefinerType cr)
8253 {
8254   PetscFunctionBegin;
8255   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8256   ((DM_Plex *) dm->data)->cellRefiner = cr;
8257   PetscFunctionReturn(0);
8258 }
8259 
8260 /* anchors */
8261 /*@
8262   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
8263   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
8264 
8265   not collective
8266 
8267   Input Parameters:
8268 . dm - The DMPlex object
8269 
8270   Output Parameters:
8271 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
8272 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
8273 
8274 
8275   Level: intermediate
8276 
8277 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
8278 @*/
DMPlexGetAnchors(DM dm,PetscSection * anchorSection,IS * anchorIS)8279 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
8280 {
8281   DM_Plex *plex = (DM_Plex *)dm->data;
8282   PetscErrorCode ierr;
8283 
8284   PetscFunctionBegin;
8285   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8286   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
8287   if (anchorSection) *anchorSection = plex->anchorSection;
8288   if (anchorIS) *anchorIS = plex->anchorIS;
8289   PetscFunctionReturn(0);
8290 }
8291 
8292 /*@
8293   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
8294   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
8295   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
8296 
8297   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
8298   DMGetConstraints() and filling in the entries in the constraint matrix.
8299 
8300   collective on dm
8301 
8302   Input Parameters:
8303 + dm - The DMPlex object
8304 . 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).
8305 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
8306 
8307   The reference counts of anchorSection and anchorIS are incremented.
8308 
8309   Level: intermediate
8310 
8311 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
8312 @*/
DMPlexSetAnchors(DM dm,PetscSection anchorSection,IS anchorIS)8313 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
8314 {
8315   DM_Plex        *plex = (DM_Plex *)dm->data;
8316   PetscMPIInt    result;
8317   PetscErrorCode ierr;
8318 
8319   PetscFunctionBegin;
8320   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8321   if (anchorSection) {
8322     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
8323     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
8324     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
8325   }
8326   if (anchorIS) {
8327     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
8328     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
8329     if (result != MPI_CONGRUENT && result != MPI_IDENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
8330   }
8331 
8332   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
8333   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
8334   plex->anchorSection = anchorSection;
8335 
8336   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
8337   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
8338   plex->anchorIS = anchorIS;
8339 
8340   if (PetscUnlikelyDebug(anchorIS && anchorSection)) {
8341     PetscInt size, a, pStart, pEnd;
8342     const PetscInt *anchors;
8343 
8344     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8345     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
8346     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
8347     for (a = 0; a < size; a++) {
8348       PetscInt p;
8349 
8350       p = anchors[a];
8351       if (p >= pStart && p < pEnd) {
8352         PetscInt dof;
8353 
8354         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8355         if (dof) {
8356           PetscErrorCode ierr2;
8357 
8358           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
8359           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
8360         }
8361       }
8362     }
8363     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
8364   }
8365   /* reset the generic constraints */
8366   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
8367   PetscFunctionReturn(0);
8368 }
8369 
DMPlexCreateConstraintSection_Anchors(DM dm,PetscSection section,PetscSection * cSec)8370 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
8371 {
8372   PetscSection anchorSection;
8373   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
8374   PetscErrorCode ierr;
8375 
8376   PetscFunctionBegin;
8377   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8378   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8379   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
8380   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8381   if (numFields) {
8382     PetscInt f;
8383     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
8384 
8385     for (f = 0; f < numFields; f++) {
8386       PetscInt numComp;
8387 
8388       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
8389       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
8390     }
8391   }
8392   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
8393   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
8394   pStart = PetscMax(pStart,sStart);
8395   pEnd   = PetscMin(pEnd,sEnd);
8396   pEnd   = PetscMax(pStart,pEnd);
8397   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
8398   for (p = pStart; p < pEnd; p++) {
8399     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
8400     if (dof) {
8401       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
8402       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
8403       for (f = 0; f < numFields; f++) {
8404         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
8405         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
8406       }
8407     }
8408   }
8409   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
8410   PetscFunctionReturn(0);
8411 }
8412 
DMPlexCreateConstraintMatrix_Anchors(DM dm,PetscSection section,PetscSection cSec,Mat * cMat)8413 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
8414 {
8415   PetscSection aSec;
8416   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
8417   const PetscInt *anchors;
8418   PetscInt numFields, f;
8419   IS aIS;
8420   PetscErrorCode ierr;
8421 
8422   PetscFunctionBegin;
8423   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8424   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
8425   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
8426   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
8427   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
8428   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
8429   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
8430   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
8431   /* cSec will be a subset of aSec and section */
8432   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
8433   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
8434   i[0] = 0;
8435   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
8436   for (p = pStart; p < pEnd; p++) {
8437     PetscInt rDof, rOff, r;
8438 
8439     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8440     if (!rDof) continue;
8441     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8442     if (numFields) {
8443       for (f = 0; f < numFields; f++) {
8444         annz = 0;
8445         for (r = 0; r < rDof; r++) {
8446           a = anchors[rOff + r];
8447           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8448           annz += aDof;
8449         }
8450         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8451         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
8452         for (q = 0; q < dof; q++) {
8453           i[off + q + 1] = i[off + q] + annz;
8454         }
8455       }
8456     }
8457     else {
8458       annz = 0;
8459       for (q = 0; q < dof; q++) {
8460         a = anchors[off + q];
8461         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8462         annz += aDof;
8463       }
8464       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8465       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
8466       for (q = 0; q < dof; q++) {
8467         i[off + q + 1] = i[off + q] + annz;
8468       }
8469     }
8470   }
8471   nnz = i[m];
8472   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
8473   offset = 0;
8474   for (p = pStart; p < pEnd; p++) {
8475     if (numFields) {
8476       for (f = 0; f < numFields; f++) {
8477         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
8478         for (q = 0; q < dof; q++) {
8479           PetscInt rDof, rOff, r;
8480           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8481           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8482           for (r = 0; r < rDof; r++) {
8483             PetscInt s;
8484 
8485             a = anchors[rOff + r];
8486             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
8487             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
8488             for (s = 0; s < aDof; s++) {
8489               j[offset++] = aOff + s;
8490             }
8491           }
8492         }
8493       }
8494     }
8495     else {
8496       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
8497       for (q = 0; q < dof; q++) {
8498         PetscInt rDof, rOff, r;
8499         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
8500         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
8501         for (r = 0; r < rDof; r++) {
8502           PetscInt s;
8503 
8504           a = anchors[rOff + r];
8505           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
8506           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
8507           for (s = 0; s < aDof; s++) {
8508             j[offset++] = aOff + s;
8509           }
8510         }
8511       }
8512     }
8513   }
8514   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
8515   ierr = PetscFree(i);CHKERRQ(ierr);
8516   ierr = PetscFree(j);CHKERRQ(ierr);
8517   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
8518   PetscFunctionReturn(0);
8519 }
8520 
DMCreateDefaultConstraints_Plex(DM dm)8521 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
8522 {
8523   DM_Plex        *plex = (DM_Plex *)dm->data;
8524   PetscSection   anchorSection, section, cSec;
8525   Mat            cMat;
8526   PetscErrorCode ierr;
8527 
8528   PetscFunctionBegin;
8529   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8530   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
8531   if (anchorSection) {
8532     PetscInt Nf;
8533 
8534     ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
8535     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
8536     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
8537     ierr = DMGetNumFields(dm,&Nf);CHKERRQ(ierr);
8538     if (Nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
8539     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
8540     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
8541     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
8542   }
8543   PetscFunctionReturn(0);
8544 }
8545 
DMCreateSubDomainDM_Plex(DM dm,DMLabel label,PetscInt value,IS * is,DM * subdm)8546 PetscErrorCode DMCreateSubDomainDM_Plex(DM dm, DMLabel label, PetscInt value, IS *is, DM *subdm)
8547 {
8548   IS             subis;
8549   PetscSection   section, subsection;
8550   PetscErrorCode ierr;
8551 
8552   PetscFunctionBegin;
8553   ierr = DMGetLocalSection(dm, &section);CHKERRQ(ierr);
8554   if (!section) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set default section for DM before splitting subdomain");
8555   if (!subdm)   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Must set output subDM for splitting subdomain");
8556   /* Create subdomain */
8557   ierr = DMPlexFilter(dm, label, value, subdm);CHKERRQ(ierr);
8558   /* Create submodel */
8559   ierr = DMPlexGetSubpointIS(*subdm, &subis);CHKERRQ(ierr);
8560   ierr = PetscSectionCreateSubmeshSection(section, subis, &subsection);CHKERRQ(ierr);
8561   ierr = DMSetLocalSection(*subdm, subsection);CHKERRQ(ierr);
8562   ierr = PetscSectionDestroy(&subsection);CHKERRQ(ierr);
8563   ierr = DMCopyDisc(dm, *subdm);CHKERRQ(ierr);
8564   /* Create map from submodel to global model */
8565   if (is) {
8566     PetscSection    sectionGlobal, subsectionGlobal;
8567     IS              spIS;
8568     const PetscInt *spmap;
8569     PetscInt       *subIndices;
8570     PetscInt        subSize = 0, subOff = 0, pStart, pEnd, p;
8571     PetscInt        Nf, f, bs = -1, bsLocal[2], bsMinMax[2];
8572 
8573     ierr = DMPlexGetSubpointIS(*subdm, &spIS);CHKERRQ(ierr);
8574     ierr = ISGetIndices(spIS, &spmap);CHKERRQ(ierr);
8575     ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
8576     ierr = DMGetGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
8577     ierr = DMGetGlobalSection(*subdm, &subsectionGlobal);CHKERRQ(ierr);
8578     ierr = PetscSectionGetChart(subsection, &pStart, &pEnd);CHKERRQ(ierr);
8579     for (p = pStart; p < pEnd; ++p) {
8580       PetscInt gdof, pSubSize  = 0;
8581 
8582       ierr = PetscSectionGetDof(sectionGlobal, p, &gdof);CHKERRQ(ierr);
8583       if (gdof > 0) {
8584         for (f = 0; f < Nf; ++f) {
8585           PetscInt fdof, fcdof;
8586 
8587           ierr     = PetscSectionGetFieldDof(subsection, p, f, &fdof);CHKERRQ(ierr);
8588           ierr     = PetscSectionGetFieldConstraintDof(subsection, p, f, &fcdof);CHKERRQ(ierr);
8589           pSubSize += fdof-fcdof;
8590         }
8591         subSize += pSubSize;
8592         if (pSubSize) {
8593           if (bs < 0) {
8594             bs = pSubSize;
8595           } else if (bs != pSubSize) {
8596             /* Layout does not admit a pointwise block size */
8597             bs = 1;
8598           }
8599         }
8600       }
8601     }
8602     /* Must have same blocksize on all procs (some might have no points) */
8603     bsLocal[0] = bs < 0 ? PETSC_MAX_INT : bs; bsLocal[1] = bs;
8604     ierr = PetscGlobalMinMaxInt(PetscObjectComm((PetscObject) dm), bsLocal, bsMinMax);CHKERRQ(ierr);
8605     if (bsMinMax[0] != bsMinMax[1]) {bs = 1;}
8606     else                            {bs = bsMinMax[0];}
8607     ierr = PetscMalloc1(subSize, &subIndices);CHKERRQ(ierr);
8608     for (p = pStart; p < pEnd; ++p) {
8609       PetscInt gdof, goff;
8610 
8611       ierr = PetscSectionGetDof(subsectionGlobal, p, &gdof);CHKERRQ(ierr);
8612       if (gdof > 0) {
8613         const PetscInt point = spmap[p];
8614 
8615         ierr = PetscSectionGetOffset(sectionGlobal, point, &goff);CHKERRQ(ierr);
8616         for (f = 0; f < Nf; ++f) {
8617           PetscInt fdof, fcdof, fc, f2, poff = 0;
8618 
8619           /* Can get rid of this loop by storing field information in the global section */
8620           for (f2 = 0; f2 < f; ++f2) {
8621             ierr  = PetscSectionGetFieldDof(section, p, f2, &fdof);CHKERRQ(ierr);
8622             ierr  = PetscSectionGetFieldConstraintDof(section, p, f2, &fcdof);CHKERRQ(ierr);
8623             poff += fdof-fcdof;
8624           }
8625           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
8626           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
8627           for (fc = 0; fc < fdof-fcdof; ++fc, ++subOff) {
8628             subIndices[subOff] = goff+poff+fc;
8629           }
8630         }
8631       }
8632     }
8633     ierr = ISRestoreIndices(spIS, &spmap);CHKERRQ(ierr);
8634     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)dm), subSize, subIndices, PETSC_OWN_POINTER, is);CHKERRQ(ierr);
8635     if (bs > 1) {
8636       /* We need to check that the block size does not come from non-contiguous fields */
8637       PetscInt i, j, set = 1;
8638       for (i = 0; i < subSize; i += bs) {
8639         for (j = 0; j < bs; ++j) {
8640           if (subIndices[i+j] != subIndices[i]+j) {set = 0; break;}
8641         }
8642       }
8643       if (set) {ierr = ISSetBlockSize(*is, bs);CHKERRQ(ierr);}
8644     }
8645     /* Attach nullspace */
8646     for (f = 0; f < Nf; ++f) {
8647       (*subdm)->nullspaceConstructors[f] = dm->nullspaceConstructors[f];
8648       if ((*subdm)->nullspaceConstructors[f]) break;
8649     }
8650     if (f < Nf) {
8651       MatNullSpace nullSpace;
8652 
8653       ierr = (*(*subdm)->nullspaceConstructors[f])(*subdm, f, f, &nullSpace);CHKERRQ(ierr);
8654       ierr = PetscObjectCompose((PetscObject) *is, "nullspace", (PetscObject) nullSpace);CHKERRQ(ierr);
8655       ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
8656     }
8657   }
8658   PetscFunctionReturn(0);
8659 }
8660 
8661 /*@
8662   DMPlexMonitorThroughput - Report the cell throughput of FE integration
8663 
8664   Input Parameter:
8665 - dm - The DM
8666 
8667   Level: developer
8668 
8669   Options Database Keys:
8670 . -dm_plex_monitor_throughput - Activate the monitor
8671 
8672 .seealso: DMSetFromOptions(), DMPlexCreate()
8673 @*/
DMPlexMonitorThroughput(DM dm,void * dummy)8674 PetscErrorCode DMPlexMonitorThroughput(DM dm, void *dummy)
8675 {
8676 #if defined(PETSC_USE_LOG)
8677   PetscStageLog      stageLog;
8678   PetscLogEvent      event;
8679   PetscLogStage      stage;
8680   PetscEventPerfInfo eventInfo;
8681   PetscReal          cellRate, flopRate;
8682   PetscInt           cStart, cEnd, Nf, N;
8683   const char        *name;
8684   PetscErrorCode     ierr;
8685 #endif
8686 
8687   PetscFunctionBegin;
8688   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
8689 #if defined(PETSC_USE_LOG)
8690   ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
8691   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
8692   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
8693   ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
8694   ierr = PetscStageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
8695   ierr = PetscLogEventGetId("DMPlexResidualFE", &event);CHKERRQ(ierr);
8696   ierr = PetscLogEventGetPerfInfo(stage, event, &eventInfo);CHKERRQ(ierr);
8697   N        = (cEnd - cStart)*Nf*eventInfo.count;
8698   flopRate = eventInfo.flops/eventInfo.time;
8699   cellRate = N/eventInfo.time;
8700   ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "DM (%s) FE Residual Integration: %D integrals %D reps\n  Cell rate: %.2g/s flop rate: %.2g MF/s\n", name ? name : "unknown", N, eventInfo.count, (double) cellRate, (double) (flopRate/1.e6));CHKERRQ(ierr);
8701 #else
8702   SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Plex Throughput Monitor is not supported if logging is turned off. Reconfigure using --with-log.");
8703 #endif
8704   PetscFunctionReturn(0);
8705 }
8706