xref: /petsc/src/dm/impls/forest/p4est/pforest.h (revision 9c8ab049e9f857b4e2bc6195c3ef290195f657cd)
1 #pragma once
2 
3 #include <petscds.h>
4 #include <petsc/private/dmimpl.h>
5 #include <petsc/private/dmforestimpl.h>
6 #include <petsc/private/dmpleximpl.h>
7 #include <petsc/private/dmlabelimpl.h>
8 #include <petsc/private/viewerimpl.h>
9 #include <../src/sys/classes/viewer/impls/vtk/vtkvimpl.h>
10 #include "petsc_p4est_package.h"
11 
12 #if defined(PETSC_HAVE_P4EST)
13 
14   #if !defined(P4_TO_P8)
15     #include <p4est.h>
16     #include <p4est_extended.h>
17     #include <p4est_geometry.h>
18     #include <p4est_ghost.h>
19     #include <p4est_lnodes.h>
20     #include <p4est_vtk.h>
21     #include <p4est_plex.h>
22     #include <p4est_bits.h>
23     #include <p4est_algorithms.h>
24   #else
25     #include <p8est.h>
26     #include <p8est_extended.h>
27     #include <p8est_geometry.h>
28     #include <p8est_ghost.h>
29     #include <p8est_lnodes.h>
30     #include <p8est_vtk.h>
31     #include <p8est_plex.h>
32     #include <p8est_bits.h>
33     #include <p8est_algorithms.h>
34   #endif
35 
36 typedef enum {
37   PATTERN_HASH,
38   PATTERN_FRACTAL,
39   PATTERN_CORNER,
40   PATTERN_CENTER,
41   PATTERN_COUNT
42 } DMRefinePattern;
43 static const char *DMRefinePatternName[PATTERN_COUNT] = {"hash", "fractal", "corner", "center"};
44 
45 typedef struct _DMRefinePatternCtx {
46   PetscInt       corner;
47   PetscBool      fractal[P4EST_CHILDREN];
48   PetscReal      hashLikelihood;
49   PetscInt       maxLevel;
50   p4est_refine_t refine_fn;
51 } DMRefinePatternCtx;
52 
53 static int DMRefinePattern_Corner(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
54 {
55   p4est_quadrant_t    root, rootcorner;
56   DMRefinePatternCtx *ctx;
57 
58   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
59   if (quadrant->level >= ctx->maxLevel) return 0;
60 
61   root.x = root.y = 0;
62   #if defined(P4_TO_P8)
63   root.z = 0;
64   #endif
65   root.level = 0;
66   p4est_quadrant_corner_descendant(&root, &rootcorner, ctx->corner, quadrant->level);
67   if (p4est_quadrant_is_equal(quadrant, &rootcorner)) return 1;
68   return 0;
69 }
70 
71 static int DMRefinePattern_Center(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
72 {
73   int                 cid;
74   p4est_quadrant_t    ancestor, ancestorcorner;
75   DMRefinePatternCtx *ctx;
76 
77   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
78   if (quadrant->level >= ctx->maxLevel) return 0;
79   if (quadrant->level <= 1) return 1;
80 
81   p4est_quadrant_ancestor(quadrant, 1, &ancestor);
82   cid = p4est_quadrant_child_id(&ancestor);
83   p4est_quadrant_corner_descendant(&ancestor, &ancestorcorner, P4EST_CHILDREN - 1 - cid, quadrant->level);
84   if (p4est_quadrant_is_equal(quadrant, &ancestorcorner)) return 1;
85   return 0;
86 }
87 
88 static int DMRefinePattern_Fractal(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
89 {
90   int                 cid;
91   DMRefinePatternCtx *ctx;
92 
93   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
94   if (quadrant->level >= ctx->maxLevel) return 0;
95   if (!quadrant->level) return 1;
96   cid = p4est_quadrant_child_id(quadrant);
97   if (ctx->fractal[cid ^ ((int)(quadrant->level % P4EST_CHILDREN))]) return 1;
98   return 0;
99 }
100 
101   /* simplified from MurmurHash3 by Austin Appleby */
102   #define DMPROT32(x, y) ((x << y) | (x >> (32 - y)))
103 static uint32_t DMPforestHash(const uint32_t *blocks, uint32_t nblocks)
104 {
105   uint32_t c1   = 0xcc9e2d51;
106   uint32_t c2   = 0x1b873593;
107   uint32_t r1   = 15;
108   uint32_t r2   = 13;
109   uint32_t m    = 5;
110   uint32_t n    = 0xe6546b64;
111   uint32_t hash = 0;
112   int      len  = nblocks * 4;
113   uint32_t i;
114 
115   for (i = 0; i < nblocks; i++) {
116     uint32_t k;
117 
118     k = blocks[i];
119     k *= c1;
120     k = DMPROT32(k, r1);
121     k *= c2;
122 
123     hash ^= k;
124     hash = DMPROT32(hash, r2) * m + n;
125   }
126 
127   hash ^= len;
128   hash ^= (hash >> 16);
129   hash *= 0x85ebca6b;
130   hash ^= (hash >> 13);
131   hash *= 0xc2b2ae35;
132   hash ^= (hash >> 16);
133 
134   return hash;
135 }
136 
137   #if defined(UINT32_MAX)
138     #define DMP4EST_HASH_MAX UINT32_MAX
139   #else
140     #define DMP4EST_HASH_MAX ((uint32_t)0xffffffff)
141   #endif
142 
143 static int DMRefinePattern_Hash(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
144 {
145   uint32_t            data[5];
146   uint32_t            result;
147   DMRefinePatternCtx *ctx;
148 
149   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
150   if (quadrant->level >= ctx->maxLevel) return 0;
151   data[0] = ((uint32_t)quadrant->level) << 24;
152   data[1] = (uint32_t)which_tree;
153   data[2] = (uint32_t)quadrant->x;
154   data[3] = (uint32_t)quadrant->y;
155   #if defined(P4_TO_P8)
156   data[4] = (uint32_t)quadrant->z;
157   #endif
158 
159   result = DMPforestHash(data, 2 + P4EST_DIM);
160   if (((double)result / (double)DMP4EST_HASH_MAX) < ctx->hashLikelihood) return 1;
161   return 0;
162 }
163 
164   #define DMConvert_pforest_plex _infix_pforest(DMConvert, _plex)
165 static PetscErrorCode DMConvert_pforest_plex(DM, DMType, DM *);
166 
167   #define DMFTopology_pforest _append_pforest(DMFTopology)
168 typedef struct {
169   PetscInt              refct;
170   p4est_connectivity_t *conn;
171   p4est_geometry_t     *geom;
172   PetscInt             *tree_face_to_uniq; /* p4est does not explicitly enumerate facets, but we must to keep track of labels */
173 } DMFTopology_pforest;
174 
175   #define DM_Forest_pforest _append_pforest(DM_Forest)
176 typedef struct {
177   DMFTopology_pforest *topo;
178   p4est_t             *forest;
179   p4est_ghost_t       *ghost;
180   p4est_lnodes_t      *lnodes;
181   PetscBool            partition_for_coarsening;
182   PetscBool            coarsen_hierarchy;
183   PetscBool            labelsFinalized;
184   PetscBool            adaptivitySuccess;
185   PetscInt             cLocalStart;
186   PetscInt             cLocalEnd;
187   DM                   plex;
188   char                *ghostName;
189   PetscSF              pointAdaptToSelfSF;
190   PetscSF              pointSelfToAdaptSF;
191   PetscInt            *pointAdaptToSelfCids;
192   PetscInt            *pointSelfToAdaptCids;
193 } DM_Forest_pforest;
194 
195   #define DM_Forest_geometry_pforest _append_pforest(DM_Forest_geometry)
196 typedef struct {
197   DM base;
198   PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
199   void             *mapCtx;
200   PetscInt          coordDim;
201   p4est_geometry_t *inner;
202 } DM_Forest_geometry_pforest;
203 
204   #define GeometryMapping_pforest _append_pforest(GeometryMapping)
205 static void GeometryMapping_pforest(p4est_geometry_t *geom, p4est_topidx_t which_tree, const double abc[3], double xyz[3])
206 {
207   DM_Forest_geometry_pforest *geom_pforest = (DM_Forest_geometry_pforest *)geom->user;
208   PetscReal                   PetscABC[3]  = {0.};
209   PetscReal                   PetscXYZ[3]  = {0.};
210   PetscInt                    i, d = PetscMin(3, geom_pforest->coordDim);
211   double                      ABC[3];
212   PetscErrorCode              ierr;
213 
214   (geom_pforest->inner->X)(geom_pforest->inner, which_tree, abc, ABC);
215 
216   for (i = 0; i < d; i++) PetscABC[i] = ABC[i];
217   ierr = (geom_pforest->map)(geom_pforest->base, (PetscInt)which_tree, geom_pforest->coordDim, PetscABC, PetscXYZ, geom_pforest->mapCtx);
218   PETSC_P4EST_ASSERT(!ierr);
219   for (i = 0; i < d; i++) xyz[i] = PetscXYZ[i];
220 }
221 
222   #define GeometryDestroy_pforest _append_pforest(GeometryDestroy)
223 static void GeometryDestroy_pforest(p4est_geometry_t *geom)
224 {
225   DM_Forest_geometry_pforest *geom_pforest = (DM_Forest_geometry_pforest *)geom->user;
226   PetscErrorCode              ierr;
227 
228   p4est_geometry_destroy(geom_pforest->inner);
229   ierr = PetscFree(geom->user);
230   PETSC_P4EST_ASSERT(!ierr);
231   ierr = PetscFree(geom);
232   PETSC_P4EST_ASSERT(!ierr);
233 }
234 
235   #define DMFTopologyDestroy_pforest _append_pforest(DMFTopologyDestroy)
236 static PetscErrorCode DMFTopologyDestroy_pforest(DMFTopology_pforest **topo)
237 {
238   PetscFunctionBegin;
239   if (!(*topo)) PetscFunctionReturn(PETSC_SUCCESS);
240   if (--((*topo)->refct) > 0) {
241     *topo = NULL;
242     PetscFunctionReturn(PETSC_SUCCESS);
243   }
244   if ((*topo)->geom) PetscCallP4est(p4est_geometry_destroy, ((*topo)->geom));
245   PetscCallP4est(p4est_connectivity_destroy, ((*topo)->conn));
246   PetscCall(PetscFree((*topo)->tree_face_to_uniq));
247   PetscCall(PetscFree(*topo));
248   *topo = NULL;
249   PetscFunctionReturn(PETSC_SUCCESS);
250 }
251 
252 static PetscErrorCode PforestConnectivityEnumerateFacets(p4est_connectivity_t *, PetscInt **);
253 
254   #define DMFTopologyCreateBrick_pforest _append_pforest(DMFTopologyCreateBrick)
255 static PetscErrorCode DMFTopologyCreateBrick_pforest(DM dm, PetscInt N[], PetscInt P[], PetscReal B[], DMFTopology_pforest **topo, PetscBool useMorton)
256 {
257   double  *vertices;
258   PetscInt i, numVerts;
259 
260   PetscFunctionBegin;
261   PetscCheck(useMorton, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Lexicographic ordering not implemented yet");
262   PetscCall(PetscNew(topo));
263 
264   (*topo)->refct = 1;
265   #if !defined(P4_TO_P8)
266   PetscCallP4estReturn((*topo)->conn, p4est_connectivity_new_brick, ((int)N[0], (int)N[1], (P[0] == DM_BOUNDARY_NONE) ? 0 : 1, (P[1] == DM_BOUNDARY_NONE) ? 0 : 1));
267   #else
268   PetscCallP4estReturn((*topo)->conn, p8est_connectivity_new_brick, ((int)N[0], (int)N[1], (int)N[2], (P[0] == DM_BOUNDARY_NONE) ? 0 : 1, (P[1] == DM_BOUNDARY_NONE) ? 0 : 1, (P[2] == DM_BOUNDARY_NONE) ? 0 : 1));
269   #endif
270   numVerts = (*topo)->conn->num_vertices;
271   vertices = (*topo)->conn->vertices;
272   for (i = 0; i < 3 * numVerts; i++) {
273     PetscInt j = i % 3;
274 
275     vertices[i] = B[2 * j] + (vertices[i] / N[j]) * (B[2 * j + 1] - B[2 * j]);
276   }
277   (*topo)->geom = NULL;
278   PetscCall(PforestConnectivityEnumerateFacets((*topo)->conn, &(*topo)->tree_face_to_uniq));
279   PetscFunctionReturn(PETSC_SUCCESS);
280 }
281 
282   #define DMFTopologyCreate_pforest _append_pforest(DMFTopologyCreate)
283 static PetscErrorCode DMFTopologyCreate_pforest(DM dm, DMForestTopology topologyName, DMFTopology_pforest **topo)
284 {
285   const char *name = (const char *)topologyName;
286   const char *prefix;
287   PetscBool   isBrick, isShell, isSphere, isMoebius;
288 
289   PetscFunctionBegin;
290   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
291   PetscAssertPointer(name, 2);
292   PetscAssertPointer(topo, 3);
293   PetscCall(PetscStrcmp(name, "brick", &isBrick));
294   PetscCall(PetscStrcmp(name, "shell", &isShell));
295   PetscCall(PetscStrcmp(name, "sphere", &isSphere));
296   PetscCall(PetscStrcmp(name, "moebius", &isMoebius));
297   PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
298   if (isBrick) {
299     PetscBool flgN, flgP, flgM, flgB, useMorton = PETSC_TRUE, periodic = PETSC_FALSE;
300     PetscInt  N[3] = {2, 2, 2}, P[3] = {0, 0, 0}, nretN = P4EST_DIM, nretP = P4EST_DIM, nretB = 2 * P4EST_DIM, i;
301     PetscReal B[6] = {0.0, 1.0, 0.0, 1.0, 0.0, 1.0}, Lstart[3] = {0., 0., 0.}, L[3] = {-1.0, -1.0, -1.0}, maxCell[3] = {-1.0, -1.0, -1.0};
302 
303     if (dm->setfromoptionscalled) {
304       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_size", N, &nretN, &flgN));
305       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_periodicity", P, &nretP, &flgP));
306       PetscCall(PetscOptionsGetRealArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_bounds", B, &nretB, &flgB));
307       PetscCall(PetscOptionsGetBool(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_use_morton_curve", &useMorton, &flgM));
308       PetscCheck(!flgN || nretN == P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d sizes in -dm_p4est_brick_size, gave %" PetscInt_FMT, P4EST_DIM, nretN);
309       PetscCheck(!flgP || nretP == P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d periodicities in -dm_p4est_brick_periodicity, gave %" PetscInt_FMT, P4EST_DIM, nretP);
310       PetscCheck(!flgB || nretB == 2 * P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d bounds in -dm_p4est_brick_bounds, gave %" PetscInt_FMT, P4EST_DIM, nretP);
311     }
312     for (i = 0; i < P4EST_DIM; i++) {
313       P[i]     = (P[i] ? DM_BOUNDARY_PERIODIC : DM_BOUNDARY_NONE);
314       periodic = (PetscBool)(P[i] || periodic);
315       if (!flgB) B[2 * i + 1] = N[i];
316       if (P[i]) {
317         Lstart[i]  = B[2 * i + 0];
318         L[i]       = B[2 * i + 1] - B[2 * i + 0];
319         maxCell[i] = 1.1 * (L[i] / N[i]);
320       }
321     }
322     PetscCall(DMFTopologyCreateBrick_pforest(dm, N, P, B, topo, useMorton));
323     if (periodic) PetscCall(DMSetPeriodicity(dm, maxCell, Lstart, L));
324   } else {
325     PetscCall(PetscNew(topo));
326 
327     (*topo)->refct = 1;
328     PetscCallP4estReturn((*topo)->conn, p4est_connectivity_new_byname, (name));
329     (*topo)->geom = NULL;
330     if (isMoebius) PetscCall(DMSetCoordinateDim(dm, 3));
331   #if defined(P4_TO_P8)
332     if (isShell) {
333       PetscReal R2 = 1., R1 = .55;
334 
335       if (dm->setfromoptionscalled) {
336         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_shell_outer_radius", &R2, NULL));
337         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_shell_inner_radius", &R1, NULL));
338       }
339       PetscCallP4estReturn((*topo)->geom, p8est_geometry_new_shell, ((*topo)->conn, R2, R1));
340     } else if (isSphere) {
341       PetscReal R2 = 1., R1 = 0.191728, R0 = 0.039856;
342 
343       if (dm->setfromoptionscalled) {
344         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_outer_radius", &R2, NULL));
345         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_inner_radius", &R1, NULL));
346         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_core_radius", &R0, NULL));
347       }
348       PetscCallP4estReturn((*topo)->geom, p8est_geometry_new_sphere, ((*topo)->conn, R2, R1, R0));
349     }
350   #endif
351     PetscCall(PforestConnectivityEnumerateFacets((*topo)->conn, &(*topo)->tree_face_to_uniq));
352   }
353   PetscFunctionReturn(PETSC_SUCCESS);
354 }
355 
356   #define DMConvert_plex_pforest _append_pforest(DMConvert_plex)
357 static PetscErrorCode DMConvert_plex_pforest(DM dm, DMType newtype, DM *pforest)
358 {
359   MPI_Comm  comm;
360   PetscBool isPlex;
361   PetscInt  dim;
362   void     *ctx;
363 
364   PetscFunctionBegin;
365 
366   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
367   comm = PetscObjectComm((PetscObject)dm);
368   PetscCall(PetscObjectTypeCompare((PetscObject)dm, DMPLEX, &isPlex));
369   PetscCheck(isPlex, comm, PETSC_ERR_ARG_WRONG, "Expected DM type %s, got %s", DMPLEX, ((PetscObject)dm)->type_name);
370   PetscCall(DMGetDimension(dm, &dim));
371   PetscCheck(dim == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Expected DM dimension %d, got %" PetscInt_FMT, P4EST_DIM, dim);
372   PetscCall(DMCreate(comm, pforest));
373   PetscCall(DMSetType(*pforest, DMPFOREST));
374   PetscCall(DMForestSetBaseDM(*pforest, dm));
375   PetscCall(DMGetApplicationContext(dm, &ctx));
376   PetscCall(DMSetApplicationContext(*pforest, ctx));
377   PetscCall(DMCopyDisc(dm, *pforest));
378   PetscFunctionReturn(PETSC_SUCCESS);
379 }
380 
381   #define DMForestDestroy_pforest _append_pforest(DMForestDestroy)
382 static PetscErrorCode DMForestDestroy_pforest(DM dm)
383 {
384   DM_Forest         *forest  = (DM_Forest *)dm->data;
385   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
386 
387   PetscFunctionBegin;
388   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
389   if (pforest->lnodes) PetscCallP4est(p4est_lnodes_destroy, (pforest->lnodes));
390   pforest->lnodes = NULL;
391   if (pforest->ghost) PetscCallP4est(p4est_ghost_destroy, (pforest->ghost));
392   pforest->ghost = NULL;
393   if (pforest->forest) PetscCallP4est(p4est_destroy, (pforest->forest));
394   pforest->forest = NULL;
395   PetscCall(DMFTopologyDestroy_pforest(&pforest->topo));
396   PetscCall(PetscFree(pforest->ghostName));
397   PetscCall(DMDestroy(&pforest->plex));
398   PetscCall(PetscSFDestroy(&pforest->pointAdaptToSelfSF));
399   PetscCall(PetscSFDestroy(&pforest->pointSelfToAdaptSF));
400   PetscCall(PetscFree(pforest->pointAdaptToSelfCids));
401   PetscCall(PetscFree(pforest->pointSelfToAdaptCids));
402   PetscCall(PetscFree(forest->data));
403   PetscFunctionReturn(PETSC_SUCCESS);
404 }
405 
406   #define DMForestTemplate_pforest _append_pforest(DMForestTemplate)
407 static PetscErrorCode DMForestTemplate_pforest(DM dm, DM tdm)
408 {
409   DM_Forest_pforest *pforest  = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
410   DM_Forest_pforest *tpforest = (DM_Forest_pforest *)((DM_Forest *)tdm->data)->data;
411 
412   PetscFunctionBegin;
413   if (pforest->topo) pforest->topo->refct++;
414   PetscCall(DMFTopologyDestroy_pforest(&(tpforest->topo)));
415   tpforest->topo = pforest->topo;
416   PetscFunctionReturn(PETSC_SUCCESS);
417 }
418 
419   #define DMPlexCreateConnectivity_pforest _append_pforest(DMPlexCreateConnectivity)
420 static PetscErrorCode DMPlexCreateConnectivity_pforest(DM, p4est_connectivity_t **, PetscInt **);
421 
422 typedef struct _PforestAdaptCtx {
423   PetscInt  maxLevel;
424   PetscInt  minLevel;
425   PetscInt  currLevel;
426   PetscBool anyChange;
427 } PforestAdaptCtx;
428 
429 static int pforest_coarsen_currlevel(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
430 {
431   PforestAdaptCtx *ctx       = (PforestAdaptCtx *)p4est->user_pointer;
432   PetscInt         minLevel  = ctx->minLevel;
433   PetscInt         currLevel = ctx->currLevel;
434 
435   if (quadrants[0]->level <= minLevel) return 0;
436   return (int)((PetscInt)quadrants[0]->level == currLevel);
437 }
438 
439 static int pforest_coarsen_uniform(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
440 {
441   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
442   PetscInt         minLevel = ctx->minLevel;
443 
444   return (int)((PetscInt)quadrants[0]->level > minLevel);
445 }
446 
447 static int pforest_coarsen_flag_any(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
448 {
449   PetscInt         i;
450   PetscBool        any      = PETSC_FALSE;
451   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
452   PetscInt         minLevel = ctx->minLevel;
453 
454   if (quadrants[0]->level <= minLevel) return 0;
455   for (i = 0; i < P4EST_CHILDREN; i++) {
456     if (quadrants[i]->p.user_int == DM_ADAPT_KEEP) {
457       any = PETSC_FALSE;
458       break;
459     }
460     if (quadrants[i]->p.user_int == DM_ADAPT_COARSEN) {
461       any = PETSC_TRUE;
462       break;
463     }
464   }
465   return any ? 1 : 0;
466 }
467 
468 static int pforest_coarsen_flag_all(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
469 {
470   PetscInt         i;
471   PetscBool        all      = PETSC_TRUE;
472   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
473   PetscInt         minLevel = ctx->minLevel;
474 
475   if (quadrants[0]->level <= minLevel) return 0;
476   for (i = 0; i < P4EST_CHILDREN; i++) {
477     if (quadrants[i]->p.user_int != DM_ADAPT_COARSEN) {
478       all = PETSC_FALSE;
479       break;
480     }
481   }
482   return all ? 1 : 0;
483 }
484 
485 static void pforest_init_determine(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
486 {
487   quadrant->p.user_int = DM_ADAPT_DETERMINE;
488 }
489 
490 static int pforest_refine_uniform(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
491 {
492   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
493   PetscInt         maxLevel = ctx->maxLevel;
494 
495   return ((PetscInt)quadrant->level < maxLevel);
496 }
497 
498 static int pforest_refine_flag(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
499 {
500   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
501   PetscInt         maxLevel = ctx->maxLevel;
502 
503   if ((PetscInt)quadrant->level >= maxLevel) return 0;
504 
505   return (quadrant->p.user_int == DM_ADAPT_REFINE);
506 }
507 
508 static PetscErrorCode DMPforestComputeLocalCellTransferSF_loop(p4est_t *p4estFrom, PetscInt FromOffset, p4est_t *p4estTo, PetscInt ToOffset, p4est_topidx_t flt, p4est_topidx_t llt, PetscInt *toFineLeavesCount, PetscInt *toLeaves, PetscSFNode *fromRoots, PetscInt *fromFineLeavesCount, PetscInt *fromLeaves, PetscSFNode *toRoots)
509 {
510   PetscMPIInt    rank = p4estFrom->mpirank;
511   p4est_topidx_t t;
512   PetscInt       toFineLeaves = 0, fromFineLeaves = 0;
513 
514   PetscFunctionBegin;
515   /* -Wmaybe-uninitialized */
516   *toFineLeavesCount   = 0;
517   *fromFineLeavesCount = 0;
518   for (t = flt; t <= llt; t++) { /* count roots and leaves */
519     p4est_tree_t     *treeFrom  = &(((p4est_tree_t *)p4estFrom->trees->array)[t]);
520     p4est_tree_t     *treeTo    = &(((p4est_tree_t *)p4estTo->trees->array)[t]);
521     p4est_quadrant_t *firstFrom = &treeFrom->first_desc;
522     p4est_quadrant_t *firstTo   = &treeTo->first_desc;
523     PetscInt          numFrom   = (PetscInt)treeFrom->quadrants.elem_count;
524     PetscInt          numTo     = (PetscInt)treeTo->quadrants.elem_count;
525     p4est_quadrant_t *quadsFrom = (p4est_quadrant_t *)treeFrom->quadrants.array;
526     p4est_quadrant_t *quadsTo   = (p4est_quadrant_t *)treeTo->quadrants.array;
527     PetscInt          currentFrom, currentTo;
528     PetscInt          treeOffsetFrom = (PetscInt)treeFrom->quadrants_offset;
529     PetscInt          treeOffsetTo   = (PetscInt)treeTo->quadrants_offset;
530     int               comp;
531 
532     PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (firstFrom, firstTo));
533     PetscCheck(comp, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "non-matching partitions");
534 
535     for (currentFrom = 0, currentTo = 0; currentFrom < numFrom && currentTo < numTo;) {
536       p4est_quadrant_t *quadFrom = &quadsFrom[currentFrom];
537       p4est_quadrant_t *quadTo   = &quadsTo[currentTo];
538 
539       if (quadFrom->level == quadTo->level) {
540         if (toLeaves) {
541           toLeaves[toFineLeaves]        = currentTo + treeOffsetTo + ToOffset;
542           fromRoots[toFineLeaves].rank  = rank;
543           fromRoots[toFineLeaves].index = currentFrom + treeOffsetFrom + FromOffset;
544         }
545         toFineLeaves++;
546         currentFrom++;
547         currentTo++;
548       } else {
549         int fromIsAncestor;
550 
551         PetscCallP4estReturn(fromIsAncestor, p4est_quadrant_is_ancestor, (quadFrom, quadTo));
552         if (fromIsAncestor) {
553           p4est_quadrant_t lastDesc;
554 
555           if (toLeaves) {
556             toLeaves[toFineLeaves]        = currentTo + treeOffsetTo + ToOffset;
557             fromRoots[toFineLeaves].rank  = rank;
558             fromRoots[toFineLeaves].index = currentFrom + treeOffsetFrom + FromOffset;
559           }
560           toFineLeaves++;
561           currentTo++;
562           PetscCallP4est(p4est_quadrant_last_descendant, (quadFrom, &lastDesc, quadTo->level));
563           PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (quadTo, &lastDesc));
564           if (comp) currentFrom++;
565         } else {
566           p4est_quadrant_t lastDesc;
567 
568           if (fromLeaves) {
569             fromLeaves[fromFineLeaves]    = currentFrom + treeOffsetFrom + FromOffset;
570             toRoots[fromFineLeaves].rank  = rank;
571             toRoots[fromFineLeaves].index = currentTo + treeOffsetTo + ToOffset;
572           }
573           fromFineLeaves++;
574           currentFrom++;
575           PetscCallP4est(p4est_quadrant_last_descendant, (quadTo, &lastDesc, quadFrom->level));
576           PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (quadFrom, &lastDesc));
577           if (comp) currentTo++;
578         }
579       }
580     }
581   }
582   *toFineLeavesCount   = toFineLeaves;
583   *fromFineLeavesCount = fromFineLeaves;
584   PetscFunctionReturn(PETSC_SUCCESS);
585 }
586 
587 /* Compute the maximum level across all the trees */
588 static PetscErrorCode DMPforestGetRefinementLevel(DM dm, PetscInt *lev)
589 {
590   p4est_topidx_t     t, flt, llt;
591   DM_Forest         *forest      = (DM_Forest *)dm->data;
592   DM_Forest_pforest *pforest     = (DM_Forest_pforest *)forest->data;
593   PetscInt           maxlevelloc = 0;
594   p4est_t           *p4est;
595 
596   PetscFunctionBegin;
597   PetscCheck(pforest, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Missing DM_Forest_pforest");
598   PetscCheck(pforest->forest, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Missing p4est_t");
599   p4est = pforest->forest;
600   flt   = p4est->first_local_tree;
601   llt   = p4est->last_local_tree;
602   for (t = flt; t <= llt; t++) {
603     p4est_tree_t *tree = &(((p4est_tree_t *)p4est->trees->array)[t]);
604     maxlevelloc        = PetscMax((PetscInt)tree->maxlevel, maxlevelloc);
605   }
606   PetscCall(MPIU_Allreduce(&maxlevelloc, lev, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm)));
607   PetscFunctionReturn(PETSC_SUCCESS);
608 }
609 
610 /* Puts identity in coarseToFine */
611 /* assumes a matching partition */
612 static PetscErrorCode DMPforestComputeLocalCellTransferSF(MPI_Comm comm, p4est_t *p4estFrom, PetscInt FromOffset, p4est_t *p4estTo, PetscInt ToOffset, PetscSF *fromCoarseToFine, PetscSF *toCoarseFromFine)
613 {
614   p4est_topidx_t flt, llt;
615   PetscSF        fromCoarse, toCoarse;
616   PetscInt       numRootsFrom, numRootsTo, numLeavesFrom, numLeavesTo;
617   PetscInt      *fromLeaves = NULL, *toLeaves = NULL;
618   PetscSFNode   *fromRoots = NULL, *toRoots = NULL;
619 
620   PetscFunctionBegin;
621   flt = p4estFrom->first_local_tree;
622   llt = p4estFrom->last_local_tree;
623   PetscCall(PetscSFCreate(comm, &fromCoarse));
624   if (toCoarseFromFine) PetscCall(PetscSFCreate(comm, &toCoarse));
625   numRootsFrom = p4estFrom->local_num_quadrants + FromOffset;
626   numRootsTo   = p4estTo->local_num_quadrants + ToOffset;
627   PetscCall(DMPforestComputeLocalCellTransferSF_loop(p4estFrom, FromOffset, p4estTo, ToOffset, flt, llt, &numLeavesTo, NULL, NULL, &numLeavesFrom, NULL, NULL));
628   PetscCall(PetscMalloc1(numLeavesTo, &toLeaves));
629   PetscCall(PetscMalloc1(numLeavesTo, &fromRoots));
630   if (toCoarseFromFine) {
631     PetscCall(PetscMalloc1(numLeavesFrom, &fromLeaves));
632     PetscCall(PetscMalloc1(numLeavesFrom, &fromRoots));
633   }
634   PetscCall(DMPforestComputeLocalCellTransferSF_loop(p4estFrom, FromOffset, p4estTo, ToOffset, flt, llt, &numLeavesTo, toLeaves, fromRoots, &numLeavesFrom, fromLeaves, toRoots));
635   if (!ToOffset && (numLeavesTo == numRootsTo)) { /* compress */
636     PetscCall(PetscFree(toLeaves));
637     PetscCall(PetscSFSetGraph(fromCoarse, numRootsFrom, numLeavesTo, NULL, PETSC_OWN_POINTER, fromRoots, PETSC_OWN_POINTER));
638   } else PetscCall(PetscSFSetGraph(fromCoarse, numRootsFrom, numLeavesTo, toLeaves, PETSC_OWN_POINTER, fromRoots, PETSC_OWN_POINTER));
639   *fromCoarseToFine = fromCoarse;
640   if (toCoarseFromFine) {
641     PetscCall(PetscSFSetGraph(toCoarse, numRootsTo, numLeavesFrom, fromLeaves, PETSC_OWN_POINTER, toRoots, PETSC_OWN_POINTER));
642     *toCoarseFromFine = toCoarse;
643   }
644   PetscFunctionReturn(PETSC_SUCCESS);
645 }
646 
647 /* range of processes whose B sections overlap this ranks A section */
648 static PetscErrorCode DMPforestComputeOverlappingRanks(PetscMPIInt size, PetscMPIInt rank, p4est_t *p4estA, p4est_t *p4estB, PetscInt *startB, PetscInt *endB)
649 {
650   p4est_quadrant_t *myCoarseStart = &(p4estA->global_first_position[rank]);
651   p4est_quadrant_t *myCoarseEnd   = &(p4estA->global_first_position[rank + 1]);
652   p4est_quadrant_t *globalFirstB  = p4estB->global_first_position;
653 
654   PetscFunctionBegin;
655   *startB = -1;
656   *endB   = -1;
657   if (p4estA->local_num_quadrants) {
658     PetscInt lo, hi, guess;
659     /* binary search to find interval containing myCoarseStart */
660     lo    = 0;
661     hi    = size;
662     guess = rank;
663     while (1) {
664       int startCompMy, myCompEnd;
665 
666       PetscCallP4estReturn(startCompMy, p4est_quadrant_compare_piggy, (&globalFirstB[guess], myCoarseStart));
667       PetscCallP4estReturn(myCompEnd, p4est_quadrant_compare_piggy, (myCoarseStart, &globalFirstB[guess + 1]));
668       if (startCompMy <= 0 && myCompEnd < 0) {
669         *startB = guess;
670         break;
671       } else if (startCompMy > 0) { /* guess is to high */
672         hi = guess;
673       } else { /* guess is to low */
674         lo = guess + 1;
675       }
676       guess = lo + (hi - lo) / 2;
677     }
678     /* reset bounds, but not guess */
679     lo = 0;
680     hi = size;
681     while (1) {
682       int startCompMy, myCompEnd;
683 
684       PetscCallP4estReturn(startCompMy, p4est_quadrant_compare_piggy, (&globalFirstB[guess], myCoarseEnd));
685       PetscCallP4estReturn(myCompEnd, p4est_quadrant_compare_piggy, (myCoarseEnd, &globalFirstB[guess + 1]));
686       if (startCompMy < 0 && myCompEnd <= 0) { /* notice that the comparison operators are different from above */
687         *endB = guess + 1;
688         break;
689       } else if (startCompMy >= 0) { /* guess is to high */
690         hi = guess;
691       } else { /* guess is to low */
692         lo = guess + 1;
693       }
694       guess = lo + (hi - lo) / 2;
695     }
696   }
697   PetscFunctionReturn(PETSC_SUCCESS);
698 }
699 
700 static PetscErrorCode DMPforestGetPlex(DM, DM *);
701 
702   #define DMSetUp_pforest _append_pforest(DMSetUp)
703 static PetscErrorCode DMSetUp_pforest(DM dm)
704 {
705   DM_Forest         *forest  = (DM_Forest *)dm->data;
706   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
707   DM                 base, adaptFrom;
708   DMForestTopology   topoName;
709   PetscSF            preCoarseToFine = NULL, coarseToPreFine = NULL;
710   PforestAdaptCtx    ctx;
711 
712   PetscFunctionBegin;
713   ctx.minLevel  = PETSC_MAX_INT;
714   ctx.maxLevel  = 0;
715   ctx.currLevel = 0;
716   ctx.anyChange = PETSC_FALSE;
717   /* sanity check */
718   PetscCall(DMForestGetAdaptivityForest(dm, &adaptFrom));
719   PetscCall(DMForestGetBaseDM(dm, &base));
720   PetscCall(DMForestGetTopology(dm, &topoName));
721   PetscCheck(adaptFrom || base || topoName, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "A forest needs a topology, a base DM, or a DM to adapt from");
722 
723   /* === Step 1: DMFTopology === */
724   if (adaptFrom) { /* reference already created topology */
725     PetscBool          ispforest;
726     DM_Forest         *aforest  = (DM_Forest *)adaptFrom->data;
727     DM_Forest_pforest *apforest = (DM_Forest_pforest *)aforest->data;
728 
729     PetscCall(PetscObjectTypeCompare((PetscObject)adaptFrom, DMPFOREST, &ispforest));
730     PetscCheck(ispforest, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_NOTSAMETYPE, "Trying to adapt from %s, which is not %s", ((PetscObject)adaptFrom)->type_name, DMPFOREST);
731     PetscCheck(apforest->topo, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "The pre-adaptation forest must have a topology");
732     PetscCall(DMSetUp(adaptFrom));
733     PetscCall(DMForestGetBaseDM(dm, &base));
734     PetscCall(DMForestGetTopology(dm, &topoName));
735   } else if (base) { /* construct a connectivity from base */
736     PetscBool isPlex, isDA;
737 
738     PetscCall(PetscObjectGetName((PetscObject)base, &topoName));
739     PetscCall(DMForestSetTopology(dm, topoName));
740     PetscCall(PetscObjectTypeCompare((PetscObject)base, DMPLEX, &isPlex));
741     PetscCall(PetscObjectTypeCompare((PetscObject)base, DMDA, &isDA));
742     if (isPlex) {
743       MPI_Comm              comm = PetscObjectComm((PetscObject)dm);
744       PetscInt              depth;
745       PetscMPIInt           size;
746       p4est_connectivity_t *conn = NULL;
747       DMFTopology_pforest  *topo;
748       PetscInt             *tree_face_to_uniq = NULL;
749 
750       PetscCall(DMPlexGetDepth(base, &depth));
751       if (depth == 1) {
752         DM connDM;
753 
754         PetscCall(DMPlexInterpolate(base, &connDM));
755         base = connDM;
756         PetscCall(DMForestSetBaseDM(dm, base));
757         PetscCall(DMDestroy(&connDM));
758       } else PetscCheck(depth == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Base plex is neither interpolated nor uninterpolated? depth %" PetscInt_FMT ", expected 2 or %d", depth, P4EST_DIM + 1);
759       PetscCallMPI(MPI_Comm_size(comm, &size));
760       if (size > 1) {
761         DM      dmRedundant;
762         PetscSF sf;
763 
764         PetscCall(DMPlexGetRedundantDM(base, &sf, &dmRedundant));
765         PetscCheck(dmRedundant, comm, PETSC_ERR_PLIB, "Could not create redundant DM");
766         PetscCall(PetscObjectCompose((PetscObject)dmRedundant, "_base_migration_sf", (PetscObject)sf));
767         PetscCall(PetscSFDestroy(&sf));
768         base = dmRedundant;
769         PetscCall(DMForestSetBaseDM(dm, base));
770         PetscCall(DMDestroy(&dmRedundant));
771       }
772       PetscCall(DMViewFromOptions(base, NULL, "-dm_p4est_base_view"));
773       PetscCall(DMPlexCreateConnectivity_pforest(base, &conn, &tree_face_to_uniq));
774       PetscCall(PetscNew(&topo));
775       topo->refct = 1;
776       topo->conn  = conn;
777       topo->geom  = NULL;
778       {
779         PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
780         void *mapCtx;
781 
782         PetscCall(DMForestGetBaseCoordinateMapping(dm, &map, &mapCtx));
783         if (map) {
784           DM_Forest_geometry_pforest *geom_pforest;
785           p4est_geometry_t           *geom;
786 
787           PetscCall(PetscNew(&geom_pforest));
788           PetscCall(DMGetCoordinateDim(dm, &geom_pforest->coordDim));
789           geom_pforest->map    = map;
790           geom_pforest->mapCtx = mapCtx;
791           PetscCallP4estReturn(geom_pforest->inner, p4est_geometry_new_connectivity, (conn));
792           PetscCall(PetscNew(&geom));
793           geom->name    = topoName;
794           geom->user    = geom_pforest;
795           geom->X       = GeometryMapping_pforest;
796           geom->destroy = GeometryDestroy_pforest;
797           topo->geom    = geom;
798         }
799       }
800       topo->tree_face_to_uniq = tree_face_to_uniq;
801       pforest->topo           = topo;
802     } else PetscCheck(!isDA, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Not implemented yet");
803   #if 0
804       PetscInt N[3], P[3];
805 
806       /* get the sizes, periodicities */
807       /* ... */
808                                                                   /* don't use Morton order */
809       PetscCall(DMFTopologyCreateBrick_pforest(dm,N,P,&pforest->topo,PETSC_FALSE));
810   #endif
811     {
812       PetscInt numLabels, l;
813 
814       PetscCall(DMGetNumLabels(base, &numLabels));
815       for (l = 0; l < numLabels; l++) {
816         PetscBool   isDepth, isGhost, isVTK, isDim, isCellType;
817         DMLabel     label, labelNew;
818         PetscInt    defVal;
819         const char *name;
820 
821         PetscCall(DMGetLabelName(base, l, &name));
822         PetscCall(DMGetLabelByNum(base, l, &label));
823         PetscCall(PetscStrcmp(name, "depth", &isDepth));
824         if (isDepth) continue;
825         PetscCall(PetscStrcmp(name, "dim", &isDim));
826         if (isDim) continue;
827         PetscCall(PetscStrcmp(name, "celltype", &isCellType));
828         if (isCellType) continue;
829         PetscCall(PetscStrcmp(name, "ghost", &isGhost));
830         if (isGhost) continue;
831         PetscCall(PetscStrcmp(name, "vtk", &isVTK));
832         if (isVTK) continue;
833         PetscCall(DMCreateLabel(dm, name));
834         PetscCall(DMGetLabel(dm, name, &labelNew));
835         PetscCall(DMLabelGetDefaultValue(label, &defVal));
836         PetscCall(DMLabelSetDefaultValue(labelNew, defVal));
837       }
838       /* map dm points (internal plex) to base
839          we currently create the subpoint_map for the entire hierarchy, starting from the finest forest
840          and propagating back to the coarsest
841          This is not an optimal approach, since we need the map only on the coarsest level
842          during DMForestTransferVecFromBase */
843       PetscCall(DMForestGetMinimumRefinement(dm, &l));
844       if (!l) PetscCall(DMCreateLabel(dm, "_forest_base_subpoint_map"));
845     }
846   } else { /* construct from topology name */
847     DMFTopology_pforest *topo;
848 
849     PetscCall(DMFTopologyCreate_pforest(dm, topoName, &topo));
850     pforest->topo = topo;
851     /* TODO: construct base? */
852   }
853 
854   /* === Step 2: get the leaves of the forest === */
855   if (adaptFrom) { /* start with the old forest */
856     DMLabel            adaptLabel;
857     PetscInt           defaultValue;
858     PetscInt           numValues, numValuesGlobal, cLocalStart, count;
859     DM_Forest         *aforest  = (DM_Forest *)adaptFrom->data;
860     DM_Forest_pforest *apforest = (DM_Forest_pforest *)aforest->data;
861     PetscBool          computeAdaptSF;
862     p4est_topidx_t     flt, llt, t;
863 
864     flt         = apforest->forest->first_local_tree;
865     llt         = apforest->forest->last_local_tree;
866     cLocalStart = apforest->cLocalStart;
867     PetscCall(DMForestGetComputeAdaptivitySF(dm, &computeAdaptSF));
868     PetscCallP4estReturn(pforest->forest, p4est_copy, (apforest->forest, 0)); /* 0 indicates no data copying */
869     PetscCall(DMForestGetAdaptivityLabel(dm, &adaptLabel));
870     if (adaptLabel) {
871       /* apply the refinement/coarsening by flags, plus minimum/maximum refinement */
872       PetscCall(DMLabelGetNumValues(adaptLabel, &numValues));
873       PetscCall(MPIU_Allreduce(&numValues, &numValuesGlobal, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)adaptFrom)));
874       PetscCall(DMLabelGetDefaultValue(adaptLabel, &defaultValue));
875       if (!numValuesGlobal && defaultValue == DM_ADAPT_COARSEN_LAST) { /* uniform coarsen of the last level only (equivalent to DM_ADAPT_COARSEN for conforming grids)  */
876         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
877         PetscCall(DMPforestGetRefinementLevel(dm, &ctx.currLevel));
878         pforest->forest->user_pointer = (void *)&ctx;
879         PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_currlevel, NULL));
880         pforest->forest->user_pointer = (void *)dm;
881         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
882         /* we will have to change the offset after we compute the overlap */
883         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), pforest->forest, 0, apforest->forest, apforest->cLocalStart, &coarseToPreFine, NULL));
884       } else if (!numValuesGlobal && defaultValue == DM_ADAPT_COARSEN) { /* uniform coarsen */
885         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
886         pforest->forest->user_pointer = (void *)&ctx;
887         PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_uniform, NULL));
888         pforest->forest->user_pointer = (void *)dm;
889         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
890         /* we will have to change the offset after we compute the overlap */
891         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), pforest->forest, 0, apforest->forest, apforest->cLocalStart, &coarseToPreFine, NULL));
892       } else if (!numValuesGlobal && defaultValue == DM_ADAPT_REFINE) { /* uniform refine */
893         PetscCall(DMForestGetMaximumRefinement(dm, &ctx.maxLevel));
894         pforest->forest->user_pointer = (void *)&ctx;
895         PetscCallP4est(p4est_refine, (pforest->forest, 0, pforest_refine_uniform, NULL));
896         pforest->forest->user_pointer = (void *)dm;
897         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
898         /* we will have to change the offset after we compute the overlap */
899         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), apforest->forest, apforest->cLocalStart, pforest->forest, 0, &preCoarseToFine, NULL));
900       } else if (numValuesGlobal) {
901         p4est_t                   *p4est = pforest->forest;
902         PetscInt                  *cellFlags;
903         DMForestAdaptivityStrategy strategy;
904         PetscSF                    cellSF;
905         PetscInt                   c, cStart, cEnd;
906         PetscBool                  adaptAny;
907 
908         PetscCall(DMForestGetMaximumRefinement(dm, &ctx.maxLevel));
909         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
910         PetscCall(DMForestGetAdaptivityStrategy(dm, &strategy));
911         PetscCall(PetscStrncmp(strategy, "any", 3, &adaptAny));
912         PetscCall(DMForestGetCellChart(adaptFrom, &cStart, &cEnd));
913         PetscCall(DMForestGetCellSF(adaptFrom, &cellSF));
914         PetscCall(PetscMalloc1(cEnd - cStart, &cellFlags));
915         for (c = cStart; c < cEnd; c++) PetscCall(DMLabelGetValue(adaptLabel, c, &cellFlags[c - cStart]));
916         if (cellSF) {
917           if (adaptAny) {
918             PetscCall(PetscSFReduceBegin(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MAX));
919             PetscCall(PetscSFReduceEnd(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MAX));
920           } else {
921             PetscCall(PetscSFReduceBegin(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MIN));
922             PetscCall(PetscSFReduceEnd(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MIN));
923           }
924         }
925         for (t = flt, count = cLocalStart; t <= llt; t++) {
926           p4est_tree_t     *tree     = &(((p4est_tree_t *)p4est->trees->array)[t]);
927           PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count, i;
928           p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
929 
930           for (i = 0; i < numQuads; i++) {
931             p4est_quadrant_t *q = &quads[i];
932             q->p.user_int       = cellFlags[count++];
933           }
934         }
935         PetscCall(PetscFree(cellFlags));
936 
937         pforest->forest->user_pointer = (void *)&ctx;
938         if (adaptAny) PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_flag_any, pforest_init_determine));
939         else PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_flag_all, pforest_init_determine));
940         PetscCallP4est(p4est_refine, (pforest->forest, 0, pforest_refine_flag, NULL));
941         pforest->forest->user_pointer = (void *)dm;
942         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
943         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), apforest->forest, apforest->cLocalStart, pforest->forest, 0, &preCoarseToFine, &coarseToPreFine));
944       }
945       for (t = flt, count = cLocalStart; t <= llt; t++) {
946         p4est_tree_t     *atree     = &(((p4est_tree_t *)apforest->forest->trees->array)[t]);
947         p4est_tree_t     *tree      = &(((p4est_tree_t *)pforest->forest->trees->array)[t]);
948         PetscInt          anumQuads = (PetscInt)atree->quadrants.elem_count, i;
949         PetscInt          numQuads  = (PetscInt)tree->quadrants.elem_count;
950         p4est_quadrant_t *aquads    = (p4est_quadrant_t *)atree->quadrants.array;
951         p4est_quadrant_t *quads     = (p4est_quadrant_t *)tree->quadrants.array;
952 
953         if (anumQuads != numQuads) {
954           ctx.anyChange = PETSC_TRUE;
955         } else {
956           for (i = 0; i < numQuads; i++) {
957             p4est_quadrant_t *aq = &aquads[i];
958             p4est_quadrant_t *q  = &quads[i];
959 
960             if (aq->level != q->level) {
961               ctx.anyChange = PETSC_TRUE;
962               break;
963             }
964           }
965         }
966         if (ctx.anyChange) break;
967       }
968     }
969     {
970       PetscInt numLabels, l;
971 
972       PetscCall(DMGetNumLabels(adaptFrom, &numLabels));
973       for (l = 0; l < numLabels; l++) {
974         PetscBool   isDepth, isCellType, isGhost, isVTK;
975         DMLabel     label, labelNew;
976         PetscInt    defVal;
977         const char *name;
978 
979         PetscCall(DMGetLabelName(adaptFrom, l, &name));
980         PetscCall(DMGetLabelByNum(adaptFrom, l, &label));
981         PetscCall(PetscStrcmp(name, "depth", &isDepth));
982         if (isDepth) continue;
983         PetscCall(PetscStrcmp(name, "celltype", &isCellType));
984         if (isCellType) continue;
985         PetscCall(PetscStrcmp(name, "ghost", &isGhost));
986         if (isGhost) continue;
987         PetscCall(PetscStrcmp(name, "vtk", &isVTK));
988         if (isVTK) continue;
989         PetscCall(DMCreateLabel(dm, name));
990         PetscCall(DMGetLabel(dm, name, &labelNew));
991         PetscCall(DMLabelGetDefaultValue(label, &defVal));
992         PetscCall(DMLabelSetDefaultValue(labelNew, defVal));
993       }
994     }
995   } else { /* initial */
996     PetscInt initLevel, minLevel;
997   #if defined(PETSC_HAVE_MPIUNI)
998     sc_MPI_Comm comm = sc_MPI_COMM_WORLD;
999   #else
1000     MPI_Comm comm = PetscObjectComm((PetscObject)dm);
1001   #endif
1002 
1003     PetscCall(DMForestGetInitialRefinement(dm, &initLevel));
1004     PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
1005     PetscCallP4estReturn(pforest->forest, p4est_new_ext,
1006                          (comm, pforest->topo->conn, 0, /* minimum number of quadrants per processor */
1007                           initLevel,                    /* level of refinement */
1008                           1,                            /* uniform refinement */
1009                           0,                            /* we don't allocate any per quadrant data */
1010                           NULL,                         /* there is no special quadrant initialization */
1011                           (void *)dm));                 /* this dm is the user context */
1012 
1013     if (initLevel > minLevel) pforest->coarsen_hierarchy = PETSC_TRUE;
1014     if (dm->setfromoptionscalled) {
1015       PetscBool   flgPattern, flgFractal;
1016       PetscInt    corner = 0;
1017       PetscInt    corners[P4EST_CHILDREN], ncorner = P4EST_CHILDREN;
1018       PetscReal   likelihood = 1. / P4EST_DIM;
1019       PetscInt    pattern;
1020       const char *prefix;
1021 
1022       PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
1023       PetscCall(PetscOptionsGetEList(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_pattern", DMRefinePatternName, PATTERN_COUNT, &pattern, &flgPattern));
1024       PetscCall(PetscOptionsGetInt(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_corner", &corner, NULL));
1025       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_fractal_corners", corners, &ncorner, &flgFractal));
1026       PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_hash_likelihood", &likelihood, NULL));
1027 
1028       if (flgPattern) {
1029         DMRefinePatternCtx *ctx;
1030         PetscInt            maxLevel;
1031 
1032         PetscCall(DMForestGetMaximumRefinement(dm, &maxLevel));
1033         PetscCall(PetscNew(&ctx));
1034         ctx->maxLevel = PetscMin(maxLevel, P4EST_QMAXLEVEL);
1035         if (initLevel + ctx->maxLevel > minLevel) pforest->coarsen_hierarchy = PETSC_TRUE;
1036         switch (pattern) {
1037         case PATTERN_HASH:
1038           ctx->refine_fn      = DMRefinePattern_Hash;
1039           ctx->hashLikelihood = likelihood;
1040           break;
1041         case PATTERN_CORNER:
1042           ctx->corner    = corner;
1043           ctx->refine_fn = DMRefinePattern_Corner;
1044           break;
1045         case PATTERN_CENTER:
1046           ctx->refine_fn = DMRefinePattern_Center;
1047           break;
1048         case PATTERN_FRACTAL:
1049           if (flgFractal) {
1050             PetscInt i;
1051 
1052             for (i = 0; i < ncorner; i++) ctx->fractal[corners[i]] = PETSC_TRUE;
1053           } else {
1054   #if !defined(P4_TO_P8)
1055             ctx->fractal[0] = ctx->fractal[1] = ctx->fractal[2] = PETSC_TRUE;
1056   #else
1057             ctx->fractal[0] = ctx->fractal[3] = ctx->fractal[5] = ctx->fractal[6] = PETSC_TRUE;
1058   #endif
1059           }
1060           ctx->refine_fn = DMRefinePattern_Fractal;
1061           break;
1062         default:
1063           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Not a valid refinement pattern");
1064         }
1065 
1066         pforest->forest->user_pointer = (void *)ctx;
1067         PetscCallP4est(p4est_refine, (pforest->forest, 1, ctx->refine_fn, NULL));
1068         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
1069         PetscCall(PetscFree(ctx));
1070         pforest->forest->user_pointer = (void *)dm;
1071       }
1072     }
1073   }
1074   if (pforest->coarsen_hierarchy) {
1075     PetscInt initLevel, currLevel, minLevel;
1076 
1077     PetscCall(DMPforestGetRefinementLevel(dm, &currLevel));
1078     PetscCall(DMForestGetInitialRefinement(dm, &initLevel));
1079     PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
1080     if (currLevel > minLevel) {
1081       DM_Forest_pforest *coarse_pforest;
1082       DMLabel            coarsen;
1083       DM                 coarseDM;
1084 
1085       PetscCall(DMForestTemplate(dm, MPI_COMM_NULL, &coarseDM));
1086       PetscCall(DMForestSetAdaptivityPurpose(coarseDM, DM_ADAPT_COARSEN));
1087       PetscCall(DMLabelCreate(PETSC_COMM_SELF, "coarsen", &coarsen));
1088       PetscCall(DMLabelSetDefaultValue(coarsen, DM_ADAPT_COARSEN));
1089       PetscCall(DMForestSetAdaptivityLabel(coarseDM, coarsen));
1090       PetscCall(DMLabelDestroy(&coarsen));
1091       PetscCall(DMSetCoarseDM(dm, coarseDM));
1092       PetscCall(PetscObjectDereference((PetscObject)coarseDM));
1093       initLevel = currLevel == initLevel ? initLevel - 1 : initLevel;
1094       PetscCall(DMForestSetInitialRefinement(coarseDM, initLevel));
1095       PetscCall(DMForestSetMinimumRefinement(coarseDM, minLevel));
1096       coarse_pforest                    = (DM_Forest_pforest *)((DM_Forest *)coarseDM->data)->data;
1097       coarse_pforest->coarsen_hierarchy = PETSC_TRUE;
1098     }
1099   }
1100 
1101   { /* repartitioning and overlap */
1102     PetscMPIInt size, rank;
1103 
1104     PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size));
1105     PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
1106     if ((size > 1) && (pforest->partition_for_coarsening || forest->cellWeights || forest->weightCapacity != 1. || forest->weightsFactor != 1.)) {
1107       PetscBool      copyForest  = PETSC_FALSE;
1108       p4est_t       *forest_copy = NULL;
1109       p4est_gloidx_t shipped     = 0;
1110 
1111       if (preCoarseToFine || coarseToPreFine) copyForest = PETSC_TRUE;
1112       if (copyForest) PetscCallP4estReturn(forest_copy, p4est_copy, (pforest->forest, 0));
1113 
1114       if (!forest->cellWeights && forest->weightCapacity == 1. && forest->weightsFactor == 1.) {
1115         PetscCallP4estReturn(shipped, p4est_partition_ext, (pforest->forest, (int)pforest->partition_for_coarsening, NULL));
1116       } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Non-uniform partition cases not implemented yet");
1117       if (shipped) ctx.anyChange = PETSC_TRUE;
1118       if (forest_copy) {
1119         if (preCoarseToFine || coarseToPreFine) {
1120           PetscSF        repartSF; /* repartSF has roots in the old partition */
1121           PetscInt       pStart = -1, pEnd = -1, p;
1122           PetscInt       numRoots, numLeaves;
1123           PetscSFNode   *repartRoots;
1124           p4est_gloidx_t postStart  = pforest->forest->global_first_quadrant[rank];
1125           p4est_gloidx_t postEnd    = pforest->forest->global_first_quadrant[rank + 1];
1126           p4est_gloidx_t partOffset = postStart;
1127 
1128           numRoots  = (PetscInt)(forest_copy->global_first_quadrant[rank + 1] - forest_copy->global_first_quadrant[rank]);
1129           numLeaves = (PetscInt)(postEnd - postStart);
1130           PetscCall(DMPforestComputeOverlappingRanks(size, rank, pforest->forest, forest_copy, &pStart, &pEnd));
1131           PetscCall(PetscMalloc1((PetscInt)pforest->forest->local_num_quadrants, &repartRoots));
1132           for (p = pStart; p < pEnd; p++) {
1133             p4est_gloidx_t preStart = forest_copy->global_first_quadrant[p];
1134             p4est_gloidx_t preEnd   = forest_copy->global_first_quadrant[p + 1];
1135             PetscInt       q;
1136 
1137             if (preEnd == preStart) continue;
1138             PetscCheck(preStart <= postStart, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Bad partition overlap computation");
1139             preEnd = preEnd > postEnd ? postEnd : preEnd;
1140             for (q = partOffset; q < preEnd; q++) {
1141               repartRoots[q - postStart].rank  = p;
1142               repartRoots[q - postStart].index = partOffset - preStart;
1143             }
1144             partOffset = preEnd;
1145           }
1146           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &repartSF));
1147           PetscCall(PetscSFSetGraph(repartSF, numRoots, numLeaves, NULL, PETSC_OWN_POINTER, repartRoots, PETSC_OWN_POINTER));
1148           PetscCall(PetscSFSetUp(repartSF));
1149           if (preCoarseToFine) {
1150             PetscSF         repartSFembed, preCoarseToFineNew;
1151             PetscInt        nleaves;
1152             const PetscInt *leaves;
1153 
1154             PetscCall(PetscSFSetUp(preCoarseToFine));
1155             PetscCall(PetscSFGetGraph(preCoarseToFine, NULL, &nleaves, &leaves, NULL));
1156             if (leaves) {
1157               PetscCall(PetscSFCreateEmbeddedRootSF(repartSF, nleaves, leaves, &repartSFembed));
1158             } else {
1159               repartSFembed = repartSF;
1160               PetscCall(PetscObjectReference((PetscObject)repartSFembed));
1161             }
1162             PetscCall(PetscSFCompose(preCoarseToFine, repartSFembed, &preCoarseToFineNew));
1163             PetscCall(PetscSFDestroy(&preCoarseToFine));
1164             PetscCall(PetscSFDestroy(&repartSFembed));
1165             preCoarseToFine = preCoarseToFineNew;
1166           }
1167           if (coarseToPreFine) {
1168             PetscSF repartSFinv, coarseToPreFineNew;
1169 
1170             PetscCall(PetscSFCreateInverseSF(repartSF, &repartSFinv));
1171             PetscCall(PetscSFCompose(repartSFinv, coarseToPreFine, &coarseToPreFineNew));
1172             PetscCall(PetscSFDestroy(&coarseToPreFine));
1173             PetscCall(PetscSFDestroy(&repartSFinv));
1174             coarseToPreFine = coarseToPreFineNew;
1175           }
1176           PetscCall(PetscSFDestroy(&repartSF));
1177         }
1178         PetscCallP4est(p4est_destroy, (forest_copy));
1179       }
1180     }
1181     if (size > 1) {
1182       PetscInt overlap;
1183 
1184       PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
1185 
1186       if (adaptFrom) {
1187         PetscInt aoverlap;
1188 
1189         PetscCall(DMForestGetPartitionOverlap(adaptFrom, &aoverlap));
1190         if (aoverlap != overlap) ctx.anyChange = PETSC_TRUE;
1191       }
1192 
1193       if (overlap > 0) {
1194         PetscInt i, cLocalStart;
1195         PetscInt cEnd;
1196         PetscSF  preCellSF = NULL, cellSF = NULL;
1197 
1198         PetscCallP4estReturn(pforest->ghost, p4est_ghost_new, (pforest->forest, P4EST_CONNECT_FULL));
1199         PetscCallP4estReturn(pforest->lnodes, p4est_lnodes_new, (pforest->forest, pforest->ghost, -P4EST_DIM));
1200         PetscCallP4est(p4est_ghost_support_lnodes, (pforest->forest, pforest->lnodes, pforest->ghost));
1201         for (i = 1; i < overlap; i++) PetscCallP4est(p4est_ghost_expand_by_lnodes, (pforest->forest, pforest->lnodes, pforest->ghost));
1202 
1203         cLocalStart = pforest->cLocalStart = pforest->ghost->proc_offsets[rank];
1204         cEnd                               = pforest->forest->local_num_quadrants + pforest->ghost->proc_offsets[size];
1205 
1206         /* shift sfs by cLocalStart, expand by cell SFs */
1207         if (preCoarseToFine || coarseToPreFine) {
1208           if (adaptFrom) PetscCall(DMForestGetCellSF(adaptFrom, &preCellSF));
1209           dm->setupcalled = PETSC_TRUE;
1210           PetscCall(DMForestGetCellSF(dm, &cellSF));
1211         }
1212         if (preCoarseToFine) {
1213           PetscSF            preCoarseToFineNew;
1214           PetscInt           nleaves, nroots, *leavesNew, i, nleavesNew;
1215           const PetscInt    *leaves;
1216           const PetscSFNode *remotes;
1217           PetscSFNode       *remotesAll;
1218 
1219           PetscCall(PetscSFSetUp(preCoarseToFine));
1220           PetscCall(PetscSFGetGraph(preCoarseToFine, &nroots, &nleaves, &leaves, &remotes));
1221           PetscCall(PetscMalloc1(cEnd, &remotesAll));
1222           for (i = 0; i < cEnd; i++) {
1223             remotesAll[i].rank  = -1;
1224             remotesAll[i].index = -1;
1225           }
1226           for (i = 0; i < nleaves; i++) remotesAll[(leaves ? leaves[i] : i) + cLocalStart] = remotes[i];
1227           PetscCall(PetscSFSetUp(cellSF));
1228           PetscCall(PetscSFBcastBegin(cellSF, MPIU_2INT, remotesAll, remotesAll, MPI_REPLACE));
1229           PetscCall(PetscSFBcastEnd(cellSF, MPIU_2INT, remotesAll, remotesAll, MPI_REPLACE));
1230           nleavesNew = 0;
1231           for (i = 0; i < nleaves; i++) {
1232             if (remotesAll[i].rank >= 0) nleavesNew++;
1233           }
1234           PetscCall(PetscMalloc1(nleavesNew, &leavesNew));
1235           nleavesNew = 0;
1236           for (i = 0; i < nleaves; i++) {
1237             if (remotesAll[i].rank >= 0) {
1238               leavesNew[nleavesNew] = i;
1239               if (i > nleavesNew) remotesAll[nleavesNew] = remotesAll[i];
1240               nleavesNew++;
1241             }
1242           }
1243           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &preCoarseToFineNew));
1244           if (nleavesNew < cEnd) {
1245             PetscCall(PetscSFSetGraph(preCoarseToFineNew, nroots, nleavesNew, leavesNew, PETSC_OWN_POINTER, remotesAll, PETSC_COPY_VALUES));
1246           } else { /* all cells are leaves */
1247             PetscCall(PetscFree(leavesNew));
1248             PetscCall(PetscSFSetGraph(preCoarseToFineNew, nroots, nleavesNew, NULL, PETSC_OWN_POINTER, remotesAll, PETSC_COPY_VALUES));
1249           }
1250           PetscCall(PetscFree(remotesAll));
1251           PetscCall(PetscSFDestroy(&preCoarseToFine));
1252           preCoarseToFine = preCoarseToFineNew;
1253           preCoarseToFine = preCoarseToFineNew;
1254         }
1255         if (coarseToPreFine) {
1256           PetscSF            coarseToPreFineNew;
1257           PetscInt           nleaves, nroots, i, nleavesCellSF, nleavesExpanded, *leavesNew;
1258           const PetscInt    *leaves;
1259           const PetscSFNode *remotes;
1260           PetscSFNode       *remotesNew, *remotesNewRoot, *remotesExpanded;
1261 
1262           PetscCall(PetscSFSetUp(coarseToPreFine));
1263           PetscCall(PetscSFGetGraph(coarseToPreFine, &nroots, &nleaves, &leaves, &remotes));
1264           PetscCall(PetscSFGetGraph(preCellSF, NULL, &nleavesCellSF, NULL, NULL));
1265           PetscCall(PetscMalloc1(nroots, &remotesNewRoot));
1266           PetscCall(PetscMalloc1(nleaves, &remotesNew));
1267           for (i = 0; i < nroots; i++) {
1268             remotesNewRoot[i].rank  = rank;
1269             remotesNewRoot[i].index = i + cLocalStart;
1270           }
1271           PetscCall(PetscSFBcastBegin(coarseToPreFine, MPIU_2INT, remotesNewRoot, remotesNew, MPI_REPLACE));
1272           PetscCall(PetscSFBcastEnd(coarseToPreFine, MPIU_2INT, remotesNewRoot, remotesNew, MPI_REPLACE));
1273           PetscCall(PetscFree(remotesNewRoot));
1274           PetscCall(PetscMalloc1(nleavesCellSF, &remotesExpanded));
1275           for (i = 0; i < nleavesCellSF; i++) {
1276             remotesExpanded[i].rank  = -1;
1277             remotesExpanded[i].index = -1;
1278           }
1279           for (i = 0; i < nleaves; i++) remotesExpanded[leaves ? leaves[i] : i] = remotesNew[i];
1280           PetscCall(PetscFree(remotesNew));
1281           PetscCall(PetscSFBcastBegin(preCellSF, MPIU_2INT, remotesExpanded, remotesExpanded, MPI_REPLACE));
1282           PetscCall(PetscSFBcastEnd(preCellSF, MPIU_2INT, remotesExpanded, remotesExpanded, MPI_REPLACE));
1283 
1284           nleavesExpanded = 0;
1285           for (i = 0; i < nleavesCellSF; i++) {
1286             if (remotesExpanded[i].rank >= 0) nleavesExpanded++;
1287           }
1288           PetscCall(PetscMalloc1(nleavesExpanded, &leavesNew));
1289           nleavesExpanded = 0;
1290           for (i = 0; i < nleavesCellSF; i++) {
1291             if (remotesExpanded[i].rank >= 0) {
1292               leavesNew[nleavesExpanded] = i;
1293               if (i > nleavesExpanded) remotesExpanded[nleavesExpanded] = remotes[i];
1294               nleavesExpanded++;
1295             }
1296           }
1297           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &coarseToPreFineNew));
1298           if (nleavesExpanded < nleavesCellSF) {
1299             PetscCall(PetscSFSetGraph(coarseToPreFineNew, cEnd, nleavesExpanded, leavesNew, PETSC_OWN_POINTER, remotesExpanded, PETSC_COPY_VALUES));
1300           } else {
1301             PetscCall(PetscFree(leavesNew));
1302             PetscCall(PetscSFSetGraph(coarseToPreFineNew, cEnd, nleavesExpanded, NULL, PETSC_OWN_POINTER, remotesExpanded, PETSC_COPY_VALUES));
1303           }
1304           PetscCall(PetscFree(remotesExpanded));
1305           PetscCall(PetscSFDestroy(&coarseToPreFine));
1306           coarseToPreFine = coarseToPreFineNew;
1307         }
1308       }
1309     }
1310   }
1311   forest->preCoarseToFine = preCoarseToFine;
1312   forest->coarseToPreFine = coarseToPreFine;
1313   dm->setupcalled         = PETSC_TRUE;
1314   PetscCall(MPIU_Allreduce(&ctx.anyChange, &(pforest->adaptivitySuccess), 1, MPIU_BOOL, MPI_LOR, PetscObjectComm((PetscObject)dm)));
1315   PetscCall(DMPforestGetPlex(dm, NULL));
1316   PetscFunctionReturn(PETSC_SUCCESS);
1317 }
1318 
1319   #define DMForestGetAdaptivitySuccess_pforest _append_pforest(DMForestGetAdaptivitySuccess)
1320 static PetscErrorCode DMForestGetAdaptivitySuccess_pforest(DM dm, PetscBool *success)
1321 {
1322   DM_Forest         *forest;
1323   DM_Forest_pforest *pforest;
1324 
1325   PetscFunctionBegin;
1326   forest   = (DM_Forest *)dm->data;
1327   pforest  = (DM_Forest_pforest *)forest->data;
1328   *success = pforest->adaptivitySuccess;
1329   PetscFunctionReturn(PETSC_SUCCESS);
1330 }
1331 
1332   #define DMView_ASCII_pforest _append_pforest(DMView_ASCII)
1333 static PetscErrorCode DMView_ASCII_pforest(PetscObject odm, PetscViewer viewer)
1334 {
1335   DM dm = (DM)odm;
1336 
1337   PetscFunctionBegin;
1338   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1339   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1340   PetscCall(DMSetUp(dm));
1341   switch (viewer->format) {
1342   case PETSC_VIEWER_DEFAULT:
1343   case PETSC_VIEWER_ASCII_INFO: {
1344     PetscInt    dim;
1345     const char *name;
1346 
1347     PetscCall(PetscObjectGetName((PetscObject)dm, &name));
1348     PetscCall(DMGetDimension(dm, &dim));
1349     if (name) PetscCall(PetscViewerASCIIPrintf(viewer, "Forest %s in %" PetscInt_FMT " dimensions:\n", name, dim));
1350     else PetscCall(PetscViewerASCIIPrintf(viewer, "Forest in %" PetscInt_FMT " dimensions:\n", dim));
1351   } /* fall through */
1352   case PETSC_VIEWER_ASCII_INFO_DETAIL:
1353   case PETSC_VIEWER_LOAD_BALANCE: {
1354     DM plex;
1355 
1356     PetscCall(DMPforestGetPlex(dm, &plex));
1357     PetscCall(DMView(plex, viewer));
1358   } break;
1359   default:
1360     SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "No support for format '%s'", PetscViewerFormats[viewer->format]);
1361   }
1362   PetscFunctionReturn(PETSC_SUCCESS);
1363 }
1364 
1365   #define DMView_VTK_pforest _append_pforest(DMView_VTK)
1366 static PetscErrorCode DMView_VTK_pforest(PetscObject odm, PetscViewer viewer)
1367 {
1368   DM                 dm      = (DM)odm;
1369   DM_Forest         *forest  = (DM_Forest *)dm->data;
1370   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
1371   PetscBool          isvtk;
1372   PetscReal          vtkScale = 1. - PETSC_MACHINE_EPSILON;
1373   PetscViewer_VTK   *vtk      = (PetscViewer_VTK *)viewer->data;
1374   const char        *name;
1375   char              *filenameStrip = NULL;
1376   PetscBool          hasExt;
1377   size_t             len;
1378   p4est_geometry_t  *geom;
1379 
1380   PetscFunctionBegin;
1381   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1382   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1383   PetscCall(DMSetUp(dm));
1384   geom = pforest->topo->geom;
1385   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERVTK, &isvtk));
1386   PetscCheck(isvtk, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_INCOMP, "Cannot use viewer type %s", ((PetscObject)viewer)->type_name);
1387   switch (viewer->format) {
1388   case PETSC_VIEWER_VTK_VTU:
1389     PetscCheck(pforest->forest, PetscObjectComm(odm), PETSC_ERR_ARG_WRONG, "DM has not been setup with a valid forest");
1390     name = vtk->filename;
1391     PetscCall(PetscStrlen(name, &len));
1392     PetscCall(PetscStrcasecmp(name + len - 4, ".vtu", &hasExt));
1393     if (hasExt) {
1394       PetscCall(PetscStrallocpy(name, &filenameStrip));
1395       filenameStrip[len - 4] = '\0';
1396       name                   = filenameStrip;
1397     }
1398     if (!pforest->topo->geom) PetscCallP4estReturn(geom, p4est_geometry_new_connectivity, (pforest->topo->conn));
1399     {
1400       p4est_vtk_context_t *pvtk;
1401       int                  footerr;
1402 
1403       PetscCallP4estReturn(pvtk, p4est_vtk_context_new, (pforest->forest, name));
1404       PetscCallP4est(p4est_vtk_context_set_geom, (pvtk, geom));
1405       PetscCallP4est(p4est_vtk_context_set_scale, (pvtk, (double)vtkScale));
1406       PetscCallP4estReturn(pvtk, p4est_vtk_write_header, (pvtk));
1407       PetscCheck(pvtk, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_header() failed");
1408       PetscCallP4estReturn(pvtk, p4est_vtk_write_cell_dataf,
1409                            (pvtk, 1, /* write tree */
1410                             1,       /* write level */
1411                             1,       /* write rank */
1412                             0,       /* do not wrap rank */
1413                             0,       /* no scalar fields */
1414                             0,       /* no vector fields */
1415                             pvtk));
1416       PetscCheck(pvtk, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_cell_dataf() failed");
1417       PetscCallP4estReturn(footerr, p4est_vtk_write_footer, (pvtk));
1418       PetscCheck(!footerr, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_footer() failed");
1419     }
1420     if (!pforest->topo->geom) PetscCallP4est(p4est_geometry_destroy, (geom));
1421     PetscCall(PetscFree(filenameStrip));
1422     break;
1423   default:
1424     SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "No support for format '%s'", PetscViewerFormats[viewer->format]);
1425   }
1426   PetscFunctionReturn(PETSC_SUCCESS);
1427 }
1428 
1429   #define DMView_HDF5_pforest _append_pforest(DMView_HDF5)
1430 static PetscErrorCode DMView_HDF5_pforest(DM dm, PetscViewer viewer)
1431 {
1432   DM plex;
1433 
1434   PetscFunctionBegin;
1435   PetscCall(DMSetUp(dm));
1436   PetscCall(DMPforestGetPlex(dm, &plex));
1437   PetscCall(DMView(plex, viewer));
1438   PetscFunctionReturn(PETSC_SUCCESS);
1439 }
1440 
1441   #define DMView_GLVis_pforest _append_pforest(DMView_GLVis)
1442 static PetscErrorCode DMView_GLVis_pforest(DM dm, PetscViewer viewer)
1443 {
1444   DM plex;
1445 
1446   PetscFunctionBegin;
1447   PetscCall(DMSetUp(dm));
1448   PetscCall(DMPforestGetPlex(dm, &plex));
1449   PetscCall(DMView(plex, viewer));
1450   PetscFunctionReturn(PETSC_SUCCESS);
1451 }
1452 
1453   #define DMView_pforest _append_pforest(DMView)
1454 static PetscErrorCode DMView_pforest(DM dm, PetscViewer viewer)
1455 {
1456   PetscBool isascii, isvtk, ishdf5, isglvis;
1457 
1458   PetscFunctionBegin;
1459   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1460   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1461   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
1462   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERVTK, &isvtk));
1463   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERHDF5, &ishdf5));
1464   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERGLVIS, &isglvis));
1465   if (isascii) {
1466     PetscCall(DMView_ASCII_pforest((PetscObject)dm, viewer));
1467   } else if (isvtk) {
1468     PetscCall(DMView_VTK_pforest((PetscObject)dm, viewer));
1469   } else if (ishdf5) {
1470     PetscCall(DMView_HDF5_pforest(dm, viewer));
1471   } else if (isglvis) {
1472     PetscCall(DMView_GLVis_pforest(dm, viewer));
1473   } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Viewer not supported (not VTK, HDF5, or GLVis)");
1474   PetscFunctionReturn(PETSC_SUCCESS);
1475 }
1476 
1477 static PetscErrorCode PforestConnectivityEnumerateFacets(p4est_connectivity_t *conn, PetscInt **tree_face_to_uniq)
1478 {
1479   PetscInt *ttf, f, t, g, count;
1480   PetscInt  numFacets;
1481 
1482   PetscFunctionBegin;
1483   numFacets = conn->num_trees * P4EST_FACES;
1484   PetscCall(PetscMalloc1(numFacets, &ttf));
1485   for (f = 0; f < numFacets; f++) ttf[f] = -1;
1486   for (g = 0, count = 0, t = 0; t < conn->num_trees; t++) {
1487     for (f = 0; f < P4EST_FACES; f++, g++) {
1488       if (ttf[g] == -1) {
1489         PetscInt ng;
1490 
1491         ttf[g]  = count++;
1492         ng      = conn->tree_to_tree[g] * P4EST_FACES + (conn->tree_to_face[g] % P4EST_FACES);
1493         ttf[ng] = ttf[g];
1494       }
1495     }
1496   }
1497   *tree_face_to_uniq = ttf;
1498   PetscFunctionReturn(PETSC_SUCCESS);
1499 }
1500 
1501 static PetscErrorCode DMPlexCreateConnectivity_pforest(DM dm, p4est_connectivity_t **connOut, PetscInt **tree_face_to_uniq)
1502 {
1503   p4est_topidx_t numTrees, numVerts, numCorns, numCtt;
1504   PetscSection   ctt;
1505   #if defined(P4_TO_P8)
1506   p4est_topidx_t numEdges, numEtt;
1507   PetscSection   ett;
1508   PetscInt       eStart, eEnd, e, ettSize;
1509   PetscInt       vertOff = 1 + P4EST_FACES + P8EST_EDGES;
1510   PetscInt       edgeOff = 1 + P4EST_FACES;
1511   #else
1512   PetscInt vertOff = 1 + P4EST_FACES;
1513   #endif
1514   p4est_connectivity_t *conn;
1515   PetscInt              cStart, cEnd, c, vStart, vEnd, v, fStart, fEnd, f;
1516   PetscInt             *star = NULL, *closure = NULL, closureSize, starSize, cttSize;
1517   PetscInt             *ttf;
1518 
1519   PetscFunctionBegin;
1520   /* 1: count objects, allocate */
1521   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1522   PetscCall(P4estTopidxCast(cEnd - cStart, &numTrees));
1523   numVerts = P4EST_CHILDREN * numTrees;
1524   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1525   PetscCall(P4estTopidxCast(vEnd - vStart, &numCorns));
1526   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &ctt));
1527   PetscCall(PetscSectionSetChart(ctt, vStart, vEnd));
1528   for (v = vStart; v < vEnd; v++) {
1529     PetscInt s;
1530 
1531     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1532     for (s = 0; s < starSize; s++) {
1533       PetscInt p = star[2 * s];
1534 
1535       if (p >= cStart && p < cEnd) {
1536         /* we want to count every time cell p references v, so we see how many times it comes up in the closure.  This
1537          * only protects against periodicity problems */
1538         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1539         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cell %" PetscInt_FMT " with wrong closure size %" PetscInt_FMT " != %d", p, closureSize, P4EST_INSUL);
1540         for (c = 0; c < P4EST_CHILDREN; c++) {
1541           PetscInt cellVert = closure[2 * (c + vertOff)];
1542 
1543           PetscCheck(cellVert >= vStart && cellVert < vEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure: vertices");
1544           if (cellVert == v) PetscCall(PetscSectionAddDof(ctt, v, 1));
1545         }
1546         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1547       }
1548     }
1549     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1550   }
1551   PetscCall(PetscSectionSetUp(ctt));
1552   PetscCall(PetscSectionGetStorageSize(ctt, &cttSize));
1553   PetscCall(P4estTopidxCast(cttSize, &numCtt));
1554   #if defined(P4_TO_P8)
1555   PetscCall(DMPlexGetSimplexOrBoxCells(dm, P4EST_DIM - 1, &eStart, &eEnd));
1556   PetscCall(P4estTopidxCast(eEnd - eStart, &numEdges));
1557   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &ett));
1558   PetscCall(PetscSectionSetChart(ett, eStart, eEnd));
1559   for (e = eStart; e < eEnd; e++) {
1560     PetscInt s;
1561 
1562     PetscCall(DMPlexGetTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1563     for (s = 0; s < starSize; s++) {
1564       PetscInt p = star[2 * s];
1565 
1566       if (p >= cStart && p < cEnd) {
1567         /* we want to count every time cell p references e, so we see how many times it comes up in the closure.  This
1568          * only protects against periodicity problems */
1569         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1570         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cell with wrong closure size");
1571         for (c = 0; c < P8EST_EDGES; c++) {
1572           PetscInt cellEdge = closure[2 * (c + edgeOff)];
1573 
1574           PetscCheck(cellEdge >= eStart && cellEdge < eEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure: edges");
1575           if (cellEdge == e) PetscCall(PetscSectionAddDof(ett, e, 1));
1576         }
1577         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1578       }
1579     }
1580     PetscCall(DMPlexRestoreTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1581   }
1582   PetscCall(PetscSectionSetUp(ett));
1583   PetscCall(PetscSectionGetStorageSize(ett, &ettSize));
1584   PetscCall(P4estTopidxCast(ettSize, &numEtt));
1585 
1586   /* This routine allocates space for the arrays, which we fill below */
1587   PetscCallP4estReturn(conn, p8est_connectivity_new, (numVerts, numTrees, numEdges, numEtt, numCorns, numCtt));
1588   #else
1589   PetscCallP4estReturn(conn, p4est_connectivity_new, (numVerts, numTrees, numCorns, numCtt));
1590   #endif
1591 
1592   /* 2: visit every face, determine neighboring cells(trees) */
1593   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 1, &fStart, &fEnd));
1594   PetscCall(PetscMalloc1((cEnd - cStart) * P4EST_FACES, &ttf));
1595   for (f = fStart; f < fEnd; f++) {
1596     PetscInt        numSupp, s;
1597     PetscInt        myFace[2] = {-1, -1};
1598     PetscInt        myOrnt[2] = {PETSC_MIN_INT, PETSC_MIN_INT};
1599     const PetscInt *supp;
1600 
1601     PetscCall(DMPlexGetSupportSize(dm, f, &numSupp));
1602     PetscCheck(numSupp == 1 || numSupp == 2, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "point %" PetscInt_FMT " has facet with %" PetscInt_FMT " sides: must be 1 or 2 (boundary or conformal)", f, numSupp);
1603     PetscCall(DMPlexGetSupport(dm, f, &supp));
1604 
1605     for (s = 0; s < numSupp; s++) {
1606       PetscInt p = supp[s];
1607 
1608       if (p >= cEnd) {
1609         numSupp--;
1610         if (s) supp = &supp[1 - s];
1611         break;
1612       }
1613     }
1614     for (s = 0; s < numSupp; s++) {
1615       PetscInt        p = supp[s], i;
1616       PetscInt        numCone;
1617       DMPolytopeType  ct;
1618       const PetscInt *cone;
1619       const PetscInt *ornt;
1620       PetscInt        orient = PETSC_MIN_INT;
1621 
1622       PetscCall(DMPlexGetConeSize(dm, p, &numCone));
1623       PetscCheck(numCone == P4EST_FACES, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " has %" PetscInt_FMT " facets, expect %d", p, numCone, P4EST_FACES);
1624       PetscCall(DMPlexGetCone(dm, p, &cone));
1625       PetscCall(DMPlexGetCellType(dm, cone[0], &ct));
1626       PetscCall(DMPlexGetConeOrientation(dm, p, &ornt));
1627       for (i = 0; i < P4EST_FACES; i++) {
1628         if (cone[i] == f) {
1629           orient = DMPolytopeConvertNewOrientation_Internal(ct, ornt[i]);
1630           break;
1631         }
1632       }
1633       PetscCheck(i < P4EST_FACES, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " faced %" PetscInt_FMT " mismatch", p, f);
1634       if (p < cStart || p >= cEnd) {
1635         DMPolytopeType ct;
1636         PetscCall(DMPlexGetCellType(dm, p, &ct));
1637         SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " (%s) should be in [%" PetscInt_FMT ", %" PetscInt_FMT ")", p, DMPolytopeTypes[ct], cStart, cEnd);
1638       }
1639       ttf[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = f - fStart;
1640       if (numSupp == 1) {
1641         /* boundary faces indicated by self reference */
1642         conn->tree_to_tree[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = p - cStart;
1643         conn->tree_to_face[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = (int8_t)PetscFaceToP4estFace[i];
1644       } else {
1645         const PetscInt N = P4EST_CHILDREN / 2;
1646 
1647         conn->tree_to_tree[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = supp[1 - s] - cStart;
1648         myFace[s]                                                                = PetscFaceToP4estFace[i];
1649         /* get the orientation of cell p in p4est-type closure to facet f, by composing the p4est-closure to
1650          * petsc-closure permutation and the petsc-closure to facet orientation */
1651         myOrnt[s] = DihedralCompose(N, orient, DMPolytopeConvertNewOrientation_Internal(ct, P4estFaceToPetscOrnt[myFace[s]]));
1652       }
1653     }
1654     if (numSupp == 2) {
1655       for (s = 0; s < numSupp; s++) {
1656         PetscInt       p = supp[s];
1657         PetscInt       orntAtoB;
1658         PetscInt       p4estOrient;
1659         const PetscInt N = P4EST_CHILDREN / 2;
1660 
1661         /* composing the forward permutation with the other cell's inverse permutation gives the self-to-neighbor
1662          * permutation of this cell-facet's cone */
1663         orntAtoB = DihedralCompose(N, DihedralInvert(N, myOrnt[1 - s]), myOrnt[s]);
1664 
1665         /* convert cone-description permutation (i.e., edges around facet) to cap-description permutation (i.e.,
1666          * vertices around facet) */
1667   #if !defined(P4_TO_P8)
1668         p4estOrient = orntAtoB < 0 ? -(orntAtoB + 1) : orntAtoB;
1669   #else
1670         {
1671           PetscInt firstVert      = orntAtoB < 0 ? ((-orntAtoB) % N) : orntAtoB;
1672           PetscInt p4estFirstVert = firstVert < 2 ? firstVert : (firstVert ^ 1);
1673 
1674           /* swap bits */
1675           p4estOrient = ((myFace[s] <= myFace[1 - s]) || (orntAtoB < 0)) ? p4estFirstVert : ((p4estFirstVert >> 1) | ((p4estFirstVert & 1) << 1));
1676         }
1677   #endif
1678         /* encode neighbor face and orientation in tree_to_face per p4est_connectivity standard (see
1679          * p4est_connectivity.h, p8est_connectivity.h) */
1680         conn->tree_to_face[P4EST_FACES * (p - cStart) + myFace[s]] = (int8_t)myFace[1 - s] + p4estOrient * P4EST_FACES;
1681       }
1682     }
1683   }
1684 
1685   #if defined(P4_TO_P8)
1686   /* 3: visit every edge */
1687   conn->ett_offset[0] = 0;
1688   for (e = eStart; e < eEnd; e++) {
1689     PetscInt off, s;
1690 
1691     PetscCall(PetscSectionGetOffset(ett, e, &off));
1692     conn->ett_offset[e - eStart] = (p4est_topidx_t)off;
1693     PetscCall(DMPlexGetTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1694     for (s = 0; s < starSize; s++) {
1695       PetscInt p = star[2 * s];
1696 
1697       if (p >= cStart && p < cEnd) {
1698         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1699         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure");
1700         for (c = 0; c < P8EST_EDGES; c++) {
1701           PetscInt       cellEdge = closure[2 * (c + edgeOff)];
1702           PetscInt       cellOrnt = closure[2 * (c + edgeOff) + 1];
1703           DMPolytopeType ct;
1704 
1705           PetscCall(DMPlexGetCellType(dm, cellEdge, &ct));
1706           cellOrnt = DMPolytopeConvertNewOrientation_Internal(ct, cellOrnt);
1707           if (cellEdge == e) {
1708             PetscInt p4estEdge = PetscEdgeToP4estEdge[c];
1709             PetscInt totalOrient;
1710 
1711             /* compose p4est-closure to petsc-closure permutation and petsc-closure to edge orientation */
1712             totalOrient = DihedralCompose(2, cellOrnt, DMPolytopeConvertNewOrientation_Internal(DM_POLYTOPE_SEGMENT, P4estEdgeToPetscOrnt[p4estEdge]));
1713             /* p4est orientations are positive: -2 => 1, -1 => 0 */
1714             totalOrient             = (totalOrient < 0) ? -(totalOrient + 1) : totalOrient;
1715             conn->edge_to_tree[off] = (p4est_locidx_t)(p - cStart);
1716             /* encode cell-edge and orientation in edge_to_edge per p8est_connectivity standard (see
1717              * p8est_connectivity.h) */
1718             conn->edge_to_edge[off++]                                  = (int8_t)p4estEdge + P8EST_EDGES * totalOrient;
1719             conn->tree_to_edge[P8EST_EDGES * (p - cStart) + p4estEdge] = e - eStart;
1720           }
1721         }
1722         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1723       }
1724     }
1725     PetscCall(DMPlexRestoreTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1726   }
1727   PetscCall(PetscSectionDestroy(&ett));
1728   #endif
1729 
1730   /* 4: visit every vertex */
1731   conn->ctt_offset[0] = 0;
1732   for (v = vStart; v < vEnd; v++) {
1733     PetscInt off, s;
1734 
1735     PetscCall(PetscSectionGetOffset(ctt, v, &off));
1736     conn->ctt_offset[v - vStart] = (p4est_topidx_t)off;
1737     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1738     for (s = 0; s < starSize; s++) {
1739       PetscInt p = star[2 * s];
1740 
1741       if (p >= cStart && p < cEnd) {
1742         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1743         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure");
1744         for (c = 0; c < P4EST_CHILDREN; c++) {
1745           PetscInt cellVert = closure[2 * (c + vertOff)];
1746 
1747           if (cellVert == v) {
1748             PetscInt p4estVert = PetscVertToP4estVert[c];
1749 
1750             conn->corner_to_tree[off]                                       = (p4est_locidx_t)(p - cStart);
1751             conn->corner_to_corner[off++]                                   = (int8_t)p4estVert;
1752             conn->tree_to_corner[P4EST_CHILDREN * (p - cStart) + p4estVert] = v - vStart;
1753           }
1754         }
1755         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1756       }
1757     }
1758     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1759   }
1760   PetscCall(PetscSectionDestroy(&ctt));
1761 
1762   /* 5: Compute the coordinates */
1763   {
1764     PetscInt coordDim;
1765 
1766     PetscCall(DMGetCoordinateDim(dm, &coordDim));
1767     PetscCall(DMGetCoordinatesLocalSetUp(dm));
1768     for (c = cStart; c < cEnd; c++) {
1769       PetscInt           dof;
1770       PetscBool          isDG;
1771       PetscScalar       *cellCoords = NULL;
1772       const PetscScalar *array;
1773 
1774       PetscCall(DMPlexGetCellCoordinates(dm, c, &isDG, &dof, &array, &cellCoords));
1775       PetscCheck(dof == P4EST_CHILDREN * coordDim, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Need coordinates at the corners: (dof) %" PetscInt_FMT " != %d * %" PetscInt_FMT " (sdim)", dof, P4EST_CHILDREN, coordDim);
1776       for (v = 0; v < P4EST_CHILDREN; v++) {
1777         PetscInt i, lim = PetscMin(3, coordDim);
1778         PetscInt p4estVert = PetscVertToP4estVert[v];
1779 
1780         conn->tree_to_vertex[P4EST_CHILDREN * (c - cStart) + v] = P4EST_CHILDREN * (c - cStart) + v;
1781         /* p4est vertices are always embedded in R^3 */
1782         for (i = 0; i < 3; i++) conn->vertices[3 * (P4EST_CHILDREN * (c - cStart) + p4estVert) + i] = 0.;
1783         for (i = 0; i < lim; i++) conn->vertices[3 * (P4EST_CHILDREN * (c - cStart) + p4estVert) + i] = PetscRealPart(cellCoords[v * coordDim + i]);
1784       }
1785       PetscCall(DMPlexRestoreCellCoordinates(dm, c, &isDG, &dof, &array, &cellCoords));
1786     }
1787   }
1788 
1789   #if defined(P4EST_ENABLE_DEBUG)
1790   PetscCheck(p4est_connectivity_is_valid(conn), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Plex to p4est conversion failed");
1791   #endif
1792 
1793   *connOut = conn;
1794 
1795   *tree_face_to_uniq = ttf;
1796 
1797   PetscFunctionReturn(PETSC_SUCCESS);
1798 }
1799 
1800 static PetscErrorCode locidx_to_PetscInt(sc_array_t *array)
1801 {
1802   sc_array_t *newarray;
1803   size_t      zz, count = array->elem_count;
1804 
1805   PetscFunctionBegin;
1806   PetscCheck(array->elem_size == sizeof(p4est_locidx_t), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong locidx size");
1807 
1808   if (sizeof(p4est_locidx_t) == sizeof(PetscInt)) PetscFunctionReturn(PETSC_SUCCESS);
1809 
1810   newarray = sc_array_new_size(sizeof(PetscInt), array->elem_count);
1811   for (zz = 0; zz < count; zz++) {
1812     p4est_locidx_t il = *((p4est_locidx_t *)sc_array_index(array, zz));
1813     PetscInt      *ip = (PetscInt *)sc_array_index(newarray, zz);
1814 
1815     *ip = (PetscInt)il;
1816   }
1817 
1818   sc_array_reset(array);
1819   sc_array_init_size(array, sizeof(PetscInt), count);
1820   sc_array_copy(array, newarray);
1821   sc_array_destroy(newarray);
1822   PetscFunctionReturn(PETSC_SUCCESS);
1823 }
1824 
1825 static PetscErrorCode coords_double_to_PetscScalar(sc_array_t *array, PetscInt dim)
1826 {
1827   sc_array_t *newarray;
1828   size_t      zz, count = array->elem_count;
1829 
1830   PetscFunctionBegin;
1831   PetscCheck(array->elem_size == 3 * sizeof(double), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong coordinate size");
1832   #if !defined(PETSC_USE_COMPLEX)
1833   if (sizeof(double) == sizeof(PetscScalar) && dim == 3) PetscFunctionReturn(PETSC_SUCCESS);
1834   #endif
1835 
1836   newarray = sc_array_new_size(dim * sizeof(PetscScalar), array->elem_count);
1837   for (zz = 0; zz < count; zz++) {
1838     int          i;
1839     double      *id = (double *)sc_array_index(array, zz);
1840     PetscScalar *ip = (PetscScalar *)sc_array_index(newarray, zz);
1841 
1842     for (i = 0; i < dim; i++) ip[i] = 0.;
1843     for (i = 0; i < PetscMin(dim, 3); i++) ip[i] = (PetscScalar)id[i];
1844   }
1845 
1846   sc_array_reset(array);
1847   sc_array_init_size(array, dim * sizeof(PetscScalar), count);
1848   sc_array_copy(array, newarray);
1849   sc_array_destroy(newarray);
1850   PetscFunctionReturn(PETSC_SUCCESS);
1851 }
1852 
1853 static PetscErrorCode locidx_pair_to_PetscSFNode(sc_array_t *array)
1854 {
1855   sc_array_t *newarray;
1856   size_t      zz, count = array->elem_count;
1857 
1858   PetscFunctionBegin;
1859   PetscCheck(array->elem_size == 2 * sizeof(p4est_locidx_t), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong locidx size");
1860 
1861   newarray = sc_array_new_size(sizeof(PetscSFNode), array->elem_count);
1862   for (zz = 0; zz < count; zz++) {
1863     p4est_locidx_t *il = (p4est_locidx_t *)sc_array_index(array, zz);
1864     PetscSFNode    *ip = (PetscSFNode *)sc_array_index(newarray, zz);
1865 
1866     ip->rank  = (PetscInt)il[0];
1867     ip->index = (PetscInt)il[1];
1868   }
1869 
1870   sc_array_reset(array);
1871   sc_array_init_size(array, sizeof(PetscSFNode), count);
1872   sc_array_copy(array, newarray);
1873   sc_array_destroy(newarray);
1874   PetscFunctionReturn(PETSC_SUCCESS);
1875 }
1876 
1877 static PetscErrorCode P4estToPlex_Local(p4est_t *p4est, DM *plex)
1878 {
1879   PetscFunctionBegin;
1880   {
1881     sc_array_t    *points_per_dim    = sc_array_new(sizeof(p4est_locidx_t));
1882     sc_array_t    *cone_sizes        = sc_array_new(sizeof(p4est_locidx_t));
1883     sc_array_t    *cones             = sc_array_new(sizeof(p4est_locidx_t));
1884     sc_array_t    *cone_orientations = sc_array_new(sizeof(p4est_locidx_t));
1885     sc_array_t    *coords            = sc_array_new(3 * sizeof(double));
1886     sc_array_t    *children          = sc_array_new(sizeof(p4est_locidx_t));
1887     sc_array_t    *parents           = sc_array_new(sizeof(p4est_locidx_t));
1888     sc_array_t    *childids          = sc_array_new(sizeof(p4est_locidx_t));
1889     sc_array_t    *leaves            = sc_array_new(sizeof(p4est_locidx_t));
1890     sc_array_t    *remotes           = sc_array_new(2 * sizeof(p4est_locidx_t));
1891     p4est_locidx_t first_local_quad;
1892 
1893     PetscCallP4est(p4est_get_plex_data, (p4est, P4EST_CONNECT_FULL, 0, &first_local_quad, points_per_dim, cone_sizes, cones, cone_orientations, coords, children, parents, childids, leaves, remotes));
1894 
1895     PetscCall(locidx_to_PetscInt(points_per_dim));
1896     PetscCall(locidx_to_PetscInt(cone_sizes));
1897     PetscCall(locidx_to_PetscInt(cones));
1898     PetscCall(locidx_to_PetscInt(cone_orientations));
1899     PetscCall(coords_double_to_PetscScalar(coords, P4EST_DIM));
1900 
1901     PetscCall(DMPlexCreate(PETSC_COMM_SELF, plex));
1902     PetscCall(DMSetDimension(*plex, P4EST_DIM));
1903     PetscCall(DMPlexCreateFromDAG(*plex, P4EST_DIM, (PetscInt *)points_per_dim->array, (PetscInt *)cone_sizes->array, (PetscInt *)cones->array, (PetscInt *)cone_orientations->array, (PetscScalar *)coords->array));
1904     PetscCall(DMPlexConvertOldOrientations_Internal(*plex));
1905     sc_array_destroy(points_per_dim);
1906     sc_array_destroy(cone_sizes);
1907     sc_array_destroy(cones);
1908     sc_array_destroy(cone_orientations);
1909     sc_array_destroy(coords);
1910     sc_array_destroy(children);
1911     sc_array_destroy(parents);
1912     sc_array_destroy(childids);
1913     sc_array_destroy(leaves);
1914     sc_array_destroy(remotes);
1915   }
1916   PetscFunctionReturn(PETSC_SUCCESS);
1917 }
1918 
1919   #define DMReferenceTreeGetChildSymmetry_pforest _append_pforest(DMReferenceTreeGetChildSymmetry)
1920 static PetscErrorCode DMReferenceTreeGetChildSymmetry_pforest(DM dm, PetscInt parent, PetscInt parentOrientA, PetscInt childOrientA, PetscInt childA, PetscInt parentOrientB, PetscInt *childOrientB, PetscInt *childB)
1921 {
1922   PetscInt coneSize, dStart, dEnd, vStart, vEnd, dim, ABswap, oAvert, oBvert, ABswapVert;
1923 
1924   PetscFunctionBegin;
1925   if (parentOrientA == parentOrientB) {
1926     if (childOrientB) *childOrientB = childOrientA;
1927     if (childB) *childB = childA;
1928     PetscFunctionReturn(PETSC_SUCCESS);
1929   }
1930   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1931   if (childA >= vStart && childA < vEnd) { /* vertices (always in the middle) are invariant under rotation */
1932     if (childOrientB) *childOrientB = 0;
1933     if (childB) *childB = childA;
1934     PetscFunctionReturn(PETSC_SUCCESS);
1935   }
1936   for (dim = 0; dim < 3; dim++) {
1937     PetscCall(DMPlexGetDepthStratum(dm, dim, &dStart, &dEnd));
1938     if (parent >= dStart && parent <= dEnd) break;
1939   }
1940   PetscCheck(dim <= 2, PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot perform child symmetry for %" PetscInt_FMT "-cells", dim);
1941   PetscCheck(dim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "A vertex has no children");
1942   if (childA < dStart || childA >= dEnd) { /* a 1-cell in a 2-cell */
1943     /* this is a lower-dimensional child: bootstrap */
1944     PetscInt        size, i, sA = -1, sB, sOrientB, sConeSize;
1945     const PetscInt *supp, *coneA, *coneB, *oA, *oB;
1946 
1947     PetscCall(DMPlexGetSupportSize(dm, childA, &size));
1948     PetscCall(DMPlexGetSupport(dm, childA, &supp));
1949 
1950     /* find a point sA in supp(childA) that has the same parent */
1951     for (i = 0; i < size; i++) {
1952       PetscInt sParent;
1953 
1954       sA = supp[i];
1955       if (sA == parent) continue;
1956       PetscCall(DMPlexGetTreeParent(dm, sA, &sParent, NULL));
1957       if (sParent == parent) break;
1958     }
1959     PetscCheck(i != size, PETSC_COMM_SELF, PETSC_ERR_PLIB, "could not find support in children");
1960     /* find out which point sB is in an equivalent position to sA under
1961      * parentOrientB */
1962     PetscCall(DMReferenceTreeGetChildSymmetry_pforest(dm, parent, parentOrientA, 0, sA, parentOrientB, &sOrientB, &sB));
1963     PetscCall(DMPlexGetConeSize(dm, sA, &sConeSize));
1964     PetscCall(DMPlexGetCone(dm, sA, &coneA));
1965     PetscCall(DMPlexGetCone(dm, sB, &coneB));
1966     PetscCall(DMPlexGetConeOrientation(dm, sA, &oA));
1967     PetscCall(DMPlexGetConeOrientation(dm, sB, &oB));
1968     /* step through the cone of sA in natural order */
1969     for (i = 0; i < sConeSize; i++) {
1970       if (coneA[i] == childA) {
1971         /* if childA is at position i in coneA,
1972          * then we want the point that is at sOrientB*i in coneB */
1973         PetscInt j = (sOrientB >= 0) ? ((sOrientB + i) % sConeSize) : ((sConeSize - (sOrientB + 1) - i) % sConeSize);
1974         if (childB) *childB = coneB[j];
1975         if (childOrientB) {
1976           DMPolytopeType ct;
1977           PetscInt       oBtrue;
1978 
1979           PetscCall(DMPlexGetConeSize(dm, childA, &coneSize));
1980           /* compose sOrientB and oB[j] */
1981           PetscCheck(coneSize == 0 || coneSize == 2, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Expected a vertex or an edge");
1982           ct = coneSize ? DM_POLYTOPE_SEGMENT : DM_POLYTOPE_POINT;
1983           /* we may have to flip an edge */
1984           oBtrue        = (sOrientB >= 0) ? oB[j] : DMPolytopeTypeComposeOrientationInv(ct, -1, oB[j]);
1985           oBtrue        = DMPolytopeConvertNewOrientation_Internal(ct, oBtrue);
1986           ABswap        = DihedralSwap(coneSize, DMPolytopeConvertNewOrientation_Internal(ct, oA[i]), oBtrue);
1987           *childOrientB = DihedralCompose(coneSize, childOrientA, ABswap);
1988         }
1989         break;
1990       }
1991     }
1992     PetscCheck(i != sConeSize, PETSC_COMM_SELF, PETSC_ERR_PLIB, "support cone mismatch");
1993     PetscFunctionReturn(PETSC_SUCCESS);
1994   }
1995   /* get the cone size and symmetry swap */
1996   PetscCall(DMPlexGetConeSize(dm, parent, &coneSize));
1997   ABswap = DihedralSwap(coneSize, parentOrientA, parentOrientB);
1998   if (dim == 2) {
1999     /* orientations refer to cones: we want them to refer to vertices:
2000      * if it's a rotation, they are the same, but if the order is reversed, a
2001      * permutation that puts side i first does *not* put vertex i first */
2002     oAvert     = (parentOrientA >= 0) ? parentOrientA : -((-parentOrientA % coneSize) + 1);
2003     oBvert     = (parentOrientB >= 0) ? parentOrientB : -((-parentOrientB % coneSize) + 1);
2004     ABswapVert = DihedralSwap(coneSize, oAvert, oBvert);
2005   } else {
2006     oAvert     = parentOrientA;
2007     oBvert     = parentOrientB;
2008     ABswapVert = ABswap;
2009   }
2010   if (childB) {
2011     /* assume that each child corresponds to a vertex, in the same order */
2012     PetscInt        p, posA = -1, numChildren, i;
2013     const PetscInt *children;
2014 
2015     /* count which position the child is in */
2016     PetscCall(DMPlexGetTreeChildren(dm, parent, &numChildren, &children));
2017     for (i = 0; i < numChildren; i++) {
2018       p = children[i];
2019       if (p == childA) {
2020         if (dim == 1) {
2021           posA = i;
2022         } else { /* 2D Morton to rotation */
2023           posA = (i & 2) ? (i ^ 1) : i;
2024         }
2025         break;
2026       }
2027     }
2028     if (posA >= coneSize) {
2029       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find childA in children of parent");
2030     } else {
2031       /* figure out position B by applying ABswapVert */
2032       PetscInt posB, childIdB;
2033 
2034       posB = (ABswapVert >= 0) ? ((ABswapVert + posA) % coneSize) : ((coneSize - (ABswapVert + 1) - posA) % coneSize);
2035       if (dim == 1) {
2036         childIdB = posB;
2037       } else { /* 2D rotation to Morton */
2038         childIdB = (posB & 2) ? (posB ^ 1) : posB;
2039       }
2040       if (childB) *childB = children[childIdB];
2041     }
2042   }
2043   if (childOrientB) *childOrientB = DihedralCompose(coneSize, childOrientA, ABswap);
2044   PetscFunctionReturn(PETSC_SUCCESS);
2045 }
2046 
2047   #define DMCreateReferenceTree_pforest _append_pforest(DMCreateReferenceTree)
2048 static PetscErrorCode DMCreateReferenceTree_pforest(MPI_Comm comm, DM *dm)
2049 {
2050   p4est_connectivity_t *refcube;
2051   p4est_t              *root, *refined;
2052   DM                    dmRoot, dmRefined;
2053   DM_Plex              *mesh;
2054   PetscMPIInt           rank;
2055   #if defined(PETSC_HAVE_MPIUNI)
2056   sc_MPI_Comm comm_self = sc_MPI_COMM_SELF;
2057   #else
2058   MPI_Comm comm_self = PETSC_COMM_SELF;
2059   #endif
2060 
2061   PetscFunctionBegin;
2062   PetscCallP4estReturn(refcube, p4est_connectivity_new_byname, ("unit"));
2063   { /* [-1,1]^d geometry */
2064     PetscInt i, j;
2065 
2066     for (i = 0; i < P4EST_CHILDREN; i++) {
2067       for (j = 0; j < 3; j++) {
2068         refcube->vertices[3 * i + j] *= 2.;
2069         refcube->vertices[3 * i + j] -= 1.;
2070       }
2071     }
2072   }
2073   PetscCallP4estReturn(root, p4est_new, (comm_self, refcube, 0, NULL, NULL));
2074   PetscCallP4estReturn(refined, p4est_new_ext, (comm_self, refcube, 0, 1, 1, 0, NULL, NULL));
2075   PetscCall(P4estToPlex_Local(root, &dmRoot));
2076   PetscCall(P4estToPlex_Local(refined, &dmRefined));
2077   {
2078   #if !defined(P4_TO_P8)
2079     PetscInt nPoints   = 25;
2080     PetscInt perm[25]  = {0, 1, 2, 3, 4, 12, 8, 14, 6, 9, 15, 5, 13, 10, 7, 11, 16, 22, 20, 24, 17, 21, 18, 23, 19};
2081     PetscInt ident[25] = {0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 0, 0, 0, 0, 5, 6, 7, 8, 1, 2, 3, 4, 0};
2082   #else
2083     PetscInt nPoints    = 125;
2084     PetscInt perm[125]  = {0,  1,  2,  3,  4,  5,  6,  7,  8,  32, 16, 36, 24, 40, 12, 17,  37,  25,  41,  9,   33,  20,  26, 42,  13,  21,  27,  43,  10,  34,  18,  38,  28,  14,  19,  39,  29,  11,  35,  22,  30, 15,
2085                            23, 31, 44, 84, 76, 92, 52, 86, 68, 94, 60, 78, 70, 96, 45, 85,  77,  93,  54,  72,  62,  74,  46, 80,  53,  87,  69,  95,  64,  82,  47,  81,  55,  73,  66,  48,  88,  56,  90,  61,  79, 71,
2086                            97, 49, 89, 58, 63, 75, 50, 57, 91, 65, 83, 51, 59, 67, 98, 106, 110, 122, 114, 120, 118, 124, 99, 111, 115, 119, 100, 107, 116, 121, 101, 117, 102, 108, 112, 123, 103, 113, 104, 109, 105};
2087     PetscInt ident[125] = {0,  0,  0,  0,  0,  0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 0, 0, 0, 0,  0,  0,  0,  0,  0,  0,  0,  0, 7, 7, 8,  8,  9,  9,  10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16,
2088                            16, 17, 17, 18, 18, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 0, 0, 0, 0, 0, 0, 19, 20, 21, 22, 23, 24, 25, 26, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 1,  2,  3,  4,  5,  6,  0};
2089 
2090   #endif
2091     IS permIS;
2092     DM dmPerm;
2093 
2094     PetscCall(ISCreateGeneral(PETSC_COMM_SELF, nPoints, perm, PETSC_USE_POINTER, &permIS));
2095     PetscCall(DMPlexPermute(dmRefined, permIS, &dmPerm));
2096     if (dmPerm) {
2097       PetscCall(DMDestroy(&dmRefined));
2098       dmRefined = dmPerm;
2099     }
2100     PetscCall(ISDestroy(&permIS));
2101     {
2102       PetscInt p;
2103       PetscCall(DMCreateLabel(dmRoot, "identity"));
2104       PetscCall(DMCreateLabel(dmRefined, "identity"));
2105       for (p = 0; p < P4EST_INSUL; p++) PetscCall(DMSetLabelValue(dmRoot, "identity", p, p));
2106       for (p = 0; p < nPoints; p++) PetscCall(DMSetLabelValue(dmRefined, "identity", p, ident[p]));
2107     }
2108   }
2109   PetscCall(DMPlexCreateReferenceTree_Union(dmRoot, dmRefined, "identity", dm));
2110   mesh                   = (DM_Plex *)(*dm)->data;
2111   mesh->getchildsymmetry = DMReferenceTreeGetChildSymmetry_pforest;
2112   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2113   if (rank == 0) {
2114     PetscCall(DMViewFromOptions(dmRoot, NULL, "-dm_p4est_ref_root_view"));
2115     PetscCall(DMViewFromOptions(dmRefined, NULL, "-dm_p4est_ref_refined_view"));
2116     PetscCall(DMViewFromOptions(dmRefined, NULL, "-dm_p4est_ref_tree_view"));
2117   }
2118   PetscCall(DMDestroy(&dmRefined));
2119   PetscCall(DMDestroy(&dmRoot));
2120   PetscCallP4est(p4est_destroy, (refined));
2121   PetscCallP4est(p4est_destroy, (root));
2122   PetscCallP4est(p4est_connectivity_destroy, (refcube));
2123   PetscFunctionReturn(PETSC_SUCCESS);
2124 }
2125 
2126 static PetscErrorCode DMShareDiscretization(DM dmA, DM dmB)
2127 {
2128   void     *ctx;
2129   PetscInt  num;
2130   PetscReal val;
2131 
2132   PetscFunctionBegin;
2133   PetscCall(DMGetApplicationContext(dmA, &ctx));
2134   PetscCall(DMSetApplicationContext(dmB, ctx));
2135   PetscCall(DMCopyDisc(dmA, dmB));
2136   PetscCall(DMGetOutputSequenceNumber(dmA, &num, &val));
2137   PetscCall(DMSetOutputSequenceNumber(dmB, num, val));
2138   if (dmB->localSection != dmA->localSection || dmB->globalSection != dmA->globalSection) {
2139     PetscCall(DMClearLocalVectors(dmB));
2140     PetscCall(PetscObjectReference((PetscObject)dmA->localSection));
2141     PetscCall(PetscSectionDestroy(&(dmB->localSection)));
2142     dmB->localSection = dmA->localSection;
2143     PetscCall(DMClearGlobalVectors(dmB));
2144     PetscCall(PetscObjectReference((PetscObject)dmA->globalSection));
2145     PetscCall(PetscSectionDestroy(&(dmB->globalSection)));
2146     dmB->globalSection = dmA->globalSection;
2147     PetscCall(PetscObjectReference((PetscObject)dmA->defaultConstraint.section));
2148     PetscCall(PetscSectionDestroy(&(dmB->defaultConstraint.section)));
2149     dmB->defaultConstraint.section = dmA->defaultConstraint.section;
2150     PetscCall(PetscObjectReference((PetscObject)dmA->defaultConstraint.mat));
2151     PetscCall(MatDestroy(&(dmB->defaultConstraint.mat)));
2152     dmB->defaultConstraint.mat = dmA->defaultConstraint.mat;
2153     if (dmA->map) PetscCall(PetscLayoutReference(dmA->map, &dmB->map));
2154   }
2155   if (dmB->sectionSF != dmA->sectionSF) {
2156     PetscCall(PetscObjectReference((PetscObject)dmA->sectionSF));
2157     PetscCall(PetscSFDestroy(&dmB->sectionSF));
2158     dmB->sectionSF = dmA->sectionSF;
2159   }
2160   PetscFunctionReturn(PETSC_SUCCESS);
2161 }
2162 
2163 /* Get an SF that broadcasts a coarse-cell covering of the local fine cells */
2164 static PetscErrorCode DMPforestGetCellCoveringSF(MPI_Comm comm, p4est_t *p4estC, p4est_t *p4estF, PetscInt cStart, PetscInt cEnd, PetscSF *coveringSF)
2165 {
2166   PetscInt     startF, endF, startC, endC, p, nLeaves;
2167   PetscSFNode *leaves;
2168   PetscSF      sf;
2169   PetscInt    *recv, *send;
2170   PetscMPIInt  tag;
2171   MPI_Request *recvReqs, *sendReqs;
2172   PetscSection section;
2173 
2174   PetscFunctionBegin;
2175   PetscCall(DMPforestComputeOverlappingRanks(p4estC->mpisize, p4estC->mpirank, p4estF, p4estC, &startC, &endC));
2176   PetscCall(PetscMalloc2(2 * (endC - startC), &recv, endC - startC, &recvReqs));
2177   PetscCall(PetscCommGetNewTag(comm, &tag));
2178   for (p = startC; p < endC; p++) {
2179     recvReqs[p - startC] = MPI_REQUEST_NULL;                                        /* just in case we don't initiate a receive */
2180     if (p4estC->global_first_quadrant[p] == p4estC->global_first_quadrant[p + 1]) { /* empty coarse partition */
2181       recv[2 * (p - startC)]     = 0;
2182       recv[2 * (p - startC) + 1] = 0;
2183       continue;
2184     }
2185 
2186     PetscCallMPI(MPI_Irecv(&recv[2 * (p - startC)], 2, MPIU_INT, p, tag, comm, &recvReqs[p - startC]));
2187   }
2188   PetscCall(DMPforestComputeOverlappingRanks(p4estC->mpisize, p4estC->mpirank, p4estC, p4estF, &startF, &endF));
2189   PetscCall(PetscMalloc2(2 * (endF - startF), &send, endF - startF, &sendReqs));
2190   /* count the quadrants rank will send to each of [startF,endF) */
2191   for (p = startF; p < endF; p++) {
2192     p4est_quadrant_t *myFineStart = &p4estF->global_first_position[p];
2193     p4est_quadrant_t *myFineEnd   = &p4estF->global_first_position[p + 1];
2194     PetscInt          tStart      = (PetscInt)myFineStart->p.which_tree;
2195     PetscInt          tEnd        = (PetscInt)myFineEnd->p.which_tree;
2196     PetscInt          firstCell = -1, lastCell = -1;
2197     p4est_tree_t     *treeStart = &(((p4est_tree_t *)p4estC->trees->array)[tStart]);
2198     p4est_tree_t     *treeEnd   = (size_t)tEnd < p4estC->trees->elem_count ? &(((p4est_tree_t *)p4estC->trees->array)[tEnd]) : NULL;
2199     ssize_t           overlapIndex;
2200 
2201     sendReqs[p - startF] = MPI_REQUEST_NULL; /* just in case we don't initiate a send */
2202     if (p4estF->global_first_quadrant[p] == p4estF->global_first_quadrant[p + 1]) continue;
2203 
2204     /* locate myFineStart in (or before) a cell */
2205     if (treeStart->quadrants.elem_count) {
2206       PetscCallP4estReturn(overlapIndex, sc_array_bsearch, (&(treeStart->quadrants), myFineStart, p4est_quadrant_disjoint));
2207       if (overlapIndex < 0) {
2208         firstCell = 0;
2209       } else {
2210         firstCell = treeStart->quadrants_offset + overlapIndex;
2211       }
2212     } else {
2213       firstCell = 0;
2214     }
2215     if (treeEnd && treeEnd->quadrants.elem_count) {
2216       PetscCallP4estReturn(overlapIndex, sc_array_bsearch, (&(treeEnd->quadrants), myFineEnd, p4est_quadrant_disjoint));
2217       if (overlapIndex < 0) { /* all of this local section is overlapped */
2218         lastCell = p4estC->local_num_quadrants;
2219       } else {
2220         p4est_quadrant_t *container = &(((p4est_quadrant_t *)treeEnd->quadrants.array)[overlapIndex]);
2221         p4est_quadrant_t  first_desc;
2222         int               equal;
2223 
2224         PetscCallP4est(p4est_quadrant_first_descendant, (container, &first_desc, P4EST_QMAXLEVEL));
2225         PetscCallP4estReturn(equal, p4est_quadrant_is_equal, (myFineEnd, &first_desc));
2226         if (equal) {
2227           lastCell = treeEnd->quadrants_offset + overlapIndex;
2228         } else {
2229           lastCell = treeEnd->quadrants_offset + overlapIndex + 1;
2230         }
2231       }
2232     } else {
2233       lastCell = p4estC->local_num_quadrants;
2234     }
2235     send[2 * (p - startF)]     = firstCell;
2236     send[2 * (p - startF) + 1] = lastCell - firstCell;
2237     PetscCallMPI(MPI_Isend(&send[2 * (p - startF)], 2, MPIU_INT, p, tag, comm, &sendReqs[p - startF]));
2238   }
2239   PetscCallMPI(MPI_Waitall((PetscMPIInt)(endC - startC), recvReqs, MPI_STATUSES_IGNORE));
2240   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &section));
2241   PetscCall(PetscSectionSetChart(section, startC, endC));
2242   for (p = startC; p < endC; p++) {
2243     PetscInt numCells = recv[2 * (p - startC) + 1];
2244     PetscCall(PetscSectionSetDof(section, p, numCells));
2245   }
2246   PetscCall(PetscSectionSetUp(section));
2247   PetscCall(PetscSectionGetStorageSize(section, &nLeaves));
2248   PetscCall(PetscMalloc1(nLeaves, &leaves));
2249   for (p = startC; p < endC; p++) {
2250     PetscInt firstCell = recv[2 * (p - startC)];
2251     PetscInt numCells  = recv[2 * (p - startC) + 1];
2252     PetscInt off, i;
2253 
2254     PetscCall(PetscSectionGetOffset(section, p, &off));
2255     for (i = 0; i < numCells; i++) {
2256       leaves[off + i].rank  = p;
2257       leaves[off + i].index = firstCell + i;
2258     }
2259   }
2260   PetscCall(PetscSFCreate(comm, &sf));
2261   PetscCall(PetscSFSetGraph(sf, cEnd - cStart, nLeaves, NULL, PETSC_OWN_POINTER, leaves, PETSC_OWN_POINTER));
2262   PetscCall(PetscSectionDestroy(&section));
2263   PetscCallMPI(MPI_Waitall((PetscMPIInt)(endF - startF), sendReqs, MPI_STATUSES_IGNORE));
2264   PetscCall(PetscFree2(send, sendReqs));
2265   PetscCall(PetscFree2(recv, recvReqs));
2266   *coveringSF = sf;
2267   PetscFunctionReturn(PETSC_SUCCESS);
2268 }
2269 
2270 /* closure points for locally-owned cells */
2271 static PetscErrorCode DMPforestGetCellSFNodes(DM dm, PetscInt numClosureIndices, PetscInt *numClosurePoints, PetscSFNode **closurePoints, PetscBool redirect)
2272 {
2273   PetscInt           cStart, cEnd;
2274   PetscInt           count, c;
2275   PetscMPIInt        rank;
2276   PetscInt           closureSize = -1;
2277   PetscInt          *closure     = NULL;
2278   PetscSF            pointSF;
2279   PetscInt           nleaves, nroots;
2280   const PetscInt    *ilocal;
2281   const PetscSFNode *iremote;
2282   DM                 plex;
2283   DM_Forest         *forest;
2284   DM_Forest_pforest *pforest;
2285 
2286   PetscFunctionBegin;
2287   forest  = (DM_Forest *)dm->data;
2288   pforest = (DM_Forest_pforest *)forest->data;
2289   cStart  = pforest->cLocalStart;
2290   cEnd    = pforest->cLocalEnd;
2291   PetscCall(DMPforestGetPlex(dm, &plex));
2292   PetscCall(DMGetPointSF(dm, &pointSF));
2293   PetscCall(PetscSFGetGraph(pointSF, &nroots, &nleaves, &ilocal, &iremote));
2294   nleaves           = PetscMax(0, nleaves);
2295   nroots            = PetscMax(0, nroots);
2296   *numClosurePoints = numClosureIndices * (cEnd - cStart);
2297   PetscCall(PetscMalloc1(*numClosurePoints, closurePoints));
2298   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
2299   for (c = cStart, count = 0; c < cEnd; c++) {
2300     PetscInt i;
2301     PetscCall(DMPlexGetTransitiveClosure(plex, c, PETSC_TRUE, &closureSize, &closure));
2302 
2303     for (i = 0; i < numClosureIndices; i++, count++) {
2304       PetscInt p   = closure[2 * i];
2305       PetscInt loc = -1;
2306 
2307       PetscCall(PetscFindInt(p, nleaves, ilocal, &loc));
2308       if (redirect && loc >= 0) {
2309         (*closurePoints)[count].rank  = iremote[loc].rank;
2310         (*closurePoints)[count].index = iremote[loc].index;
2311       } else {
2312         (*closurePoints)[count].rank  = rank;
2313         (*closurePoints)[count].index = p;
2314       }
2315     }
2316     PetscCall(DMPlexRestoreTransitiveClosure(plex, c, PETSC_TRUE, &closureSize, &closure));
2317   }
2318   PetscFunctionReturn(PETSC_SUCCESS);
2319 }
2320 
2321 static void MPIAPI DMPforestMaxSFNode(void *a, void *b, PetscMPIInt *len, MPI_Datatype *type)
2322 {
2323   PetscMPIInt i;
2324 
2325   for (i = 0; i < *len; i++) {
2326     PetscSFNode *A = (PetscSFNode *)a;
2327     PetscSFNode *B = (PetscSFNode *)b;
2328 
2329     if (B->rank < 0) *B = *A;
2330   }
2331 }
2332 
2333 static PetscErrorCode DMPforestGetTransferSF_Point(DM coarse, DM fine, PetscSF *sf, PetscBool transferIdent, PetscInt *childIds[])
2334 {
2335   MPI_Comm           comm;
2336   PetscMPIInt        rank, size;
2337   DM_Forest_pforest *pforestC, *pforestF;
2338   p4est_t           *p4estC, *p4estF;
2339   PetscInt           numClosureIndices;
2340   PetscInt           numClosurePointsC, numClosurePointsF;
2341   PetscSFNode       *closurePointsC, *closurePointsF;
2342   p4est_quadrant_t  *coverQuads = NULL;
2343   p4est_quadrant_t **treeQuads;
2344   PetscInt          *treeQuadCounts;
2345   MPI_Datatype       nodeType;
2346   MPI_Datatype       nodeClosureType;
2347   MPI_Op             sfNodeReduce;
2348   p4est_topidx_t     fltF, lltF, t;
2349   DM                 plexC, plexF;
2350   PetscInt           pStartF, pEndF, pStartC, pEndC;
2351   PetscBool          saveInCoarse = PETSC_FALSE;
2352   PetscBool          saveInFine   = PETSC_FALSE;
2353   PetscBool          formCids     = (childIds != NULL) ? PETSC_TRUE : PETSC_FALSE;
2354   PetscInt          *cids         = NULL;
2355 
2356   PetscFunctionBegin;
2357   pforestC = (DM_Forest_pforest *)((DM_Forest *)coarse->data)->data;
2358   pforestF = (DM_Forest_pforest *)((DM_Forest *)fine->data)->data;
2359   p4estC   = pforestC->forest;
2360   p4estF   = pforestF->forest;
2361   PetscCheck(pforestC->topo == pforestF->topo, PetscObjectComm((PetscObject)coarse), PETSC_ERR_ARG_INCOMP, "DM's must have the same base DM");
2362   comm = PetscObjectComm((PetscObject)coarse);
2363   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2364   PetscCallMPI(MPI_Comm_size(comm, &size));
2365   PetscCall(DMPforestGetPlex(fine, &plexF));
2366   PetscCall(DMPlexGetChart(plexF, &pStartF, &pEndF));
2367   PetscCall(DMPforestGetPlex(coarse, &plexC));
2368   PetscCall(DMPlexGetChart(plexC, &pStartC, &pEndC));
2369   { /* check if the results have been cached */
2370     DM adaptCoarse, adaptFine;
2371 
2372     PetscCall(DMForestGetAdaptivityForest(coarse, &adaptCoarse));
2373     PetscCall(DMForestGetAdaptivityForest(fine, &adaptFine));
2374     if (adaptCoarse && adaptCoarse->data == fine->data) { /* coarse is adapted from fine */
2375       if (pforestC->pointSelfToAdaptSF) {
2376         PetscCall(PetscObjectReference((PetscObject)(pforestC->pointSelfToAdaptSF)));
2377         *sf = pforestC->pointSelfToAdaptSF;
2378         if (childIds) {
2379           PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2380           PetscCall(PetscArraycpy(cids, pforestC->pointSelfToAdaptCids, pEndF - pStartF));
2381           *childIds = cids;
2382         }
2383         PetscFunctionReturn(PETSC_SUCCESS);
2384       } else {
2385         saveInCoarse = PETSC_TRUE;
2386         formCids     = PETSC_TRUE;
2387       }
2388     } else if (adaptFine && adaptFine->data == coarse->data) { /* fine is adapted from coarse */
2389       if (pforestF->pointAdaptToSelfSF) {
2390         PetscCall(PetscObjectReference((PetscObject)(pforestF->pointAdaptToSelfSF)));
2391         *sf = pforestF->pointAdaptToSelfSF;
2392         if (childIds) {
2393           PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2394           PetscCall(PetscArraycpy(cids, pforestF->pointAdaptToSelfCids, pEndF - pStartF));
2395           *childIds = cids;
2396         }
2397         PetscFunctionReturn(PETSC_SUCCESS);
2398       } else {
2399         saveInFine = PETSC_TRUE;
2400         formCids   = PETSC_TRUE;
2401       }
2402     }
2403   }
2404 
2405   /* count the number of closure points that have dofs and create a list */
2406   numClosureIndices = P4EST_INSUL;
2407   /* create the datatype */
2408   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &nodeType));
2409   PetscCallMPI(MPI_Type_commit(&nodeType));
2410   PetscCallMPI(MPI_Op_create(DMPforestMaxSFNode, PETSC_FALSE, &sfNodeReduce));
2411   PetscCallMPI(MPI_Type_contiguous(numClosureIndices * 2, MPIU_INT, &nodeClosureType));
2412   PetscCallMPI(MPI_Type_commit(&nodeClosureType));
2413   /* everything has to go through cells: for each cell, create a list of the sfnodes in its closure */
2414   /* get lists of closure point SF nodes for every cell */
2415   PetscCall(DMPforestGetCellSFNodes(coarse, numClosureIndices, &numClosurePointsC, &closurePointsC, PETSC_TRUE));
2416   PetscCall(DMPforestGetCellSFNodes(fine, numClosureIndices, &numClosurePointsF, &closurePointsF, PETSC_FALSE));
2417   /* create pointers for tree lists */
2418   fltF = p4estF->first_local_tree;
2419   lltF = p4estF->last_local_tree;
2420   PetscCall(PetscCalloc2(lltF + 1 - fltF, &treeQuads, lltF + 1 - fltF, &treeQuadCounts));
2421   /* if the partitions don't match, ship the coarse to cover the fine */
2422   if (size > 1) {
2423     PetscInt p;
2424 
2425     for (p = 0; p < size; p++) {
2426       int equal;
2427 
2428       PetscCallP4estReturn(equal, p4est_quadrant_is_equal_piggy, (&p4estC->global_first_position[p], &p4estF->global_first_position[p]));
2429       if (!equal) break;
2430     }
2431     if (p < size) { /* non-matching distribution: send the coarse to cover the fine */
2432       PetscInt          cStartC, cEndC;
2433       PetscSF           coveringSF;
2434       PetscInt          nleaves;
2435       PetscInt          count;
2436       PetscSFNode      *newClosurePointsC;
2437       p4est_quadrant_t *coverQuadsSend;
2438       p4est_topidx_t    fltC = p4estC->first_local_tree;
2439       p4est_topidx_t    lltC = p4estC->last_local_tree;
2440       p4est_topidx_t    t;
2441       PetscMPIInt       blockSizes[4]   = {P4EST_DIM, 2, 1, 1};
2442       MPI_Aint          blockOffsets[4] = {offsetof(p4est_quadrant_t, x), offsetof(p4est_quadrant_t, level), offsetof(p4est_quadrant_t, pad16), offsetof(p4est_quadrant_t, p)};
2443       MPI_Datatype      blockTypes[4]   = {MPI_INT32_T, MPI_INT8_T, MPI_INT16_T, MPI_INT32_T /* p.which_tree */};
2444       MPI_Datatype      quadStruct, quadType;
2445 
2446       PetscCall(DMPlexGetSimplexOrBoxCells(plexC, 0, &cStartC, &cEndC));
2447       PetscCall(DMPforestGetCellCoveringSF(comm, p4estC, p4estF, pforestC->cLocalStart, pforestC->cLocalEnd, &coveringSF));
2448       PetscCall(PetscSFGetGraph(coveringSF, NULL, &nleaves, NULL, NULL));
2449       PetscCall(PetscMalloc1(numClosureIndices * nleaves, &newClosurePointsC));
2450       PetscCall(PetscMalloc1(nleaves, &coverQuads));
2451       PetscCall(PetscMalloc1(cEndC - cStartC, &coverQuadsSend));
2452       count = 0;
2453       for (t = fltC; t <= lltC; t++) { /* unfortunately, we need to pack a send array, since quads are not stored packed in p4est */
2454         p4est_tree_t *tree = &(((p4est_tree_t *)p4estC->trees->array)[t]);
2455         PetscInt      q;
2456 
2457         PetscCall(PetscMemcpy(&coverQuadsSend[count], tree->quadrants.array, tree->quadrants.elem_count * sizeof(p4est_quadrant_t)));
2458         for (q = 0; (size_t)q < tree->quadrants.elem_count; q++) coverQuadsSend[count + q].p.which_tree = t;
2459         count += tree->quadrants.elem_count;
2460       }
2461       /* p is of a union type p4est_quadrant_data, but only the p.which_tree field is active at this time. So, we
2462          have a simple blockTypes[] to use. Note that quadStruct does not count potential padding in array of
2463          p4est_quadrant_t. We have to call MPI_Type_create_resized() to change upper-bound of quadStruct.
2464        */
2465       PetscCallMPI(MPI_Type_create_struct(4, blockSizes, blockOffsets, blockTypes, &quadStruct));
2466       PetscCallMPI(MPI_Type_create_resized(quadStruct, 0, sizeof(p4est_quadrant_t), &quadType));
2467       PetscCallMPI(MPI_Type_commit(&quadType));
2468       PetscCall(PetscSFBcastBegin(coveringSF, nodeClosureType, closurePointsC, newClosurePointsC, MPI_REPLACE));
2469       PetscCall(PetscSFBcastBegin(coveringSF, quadType, coverQuadsSend, coverQuads, MPI_REPLACE));
2470       PetscCall(PetscSFBcastEnd(coveringSF, nodeClosureType, closurePointsC, newClosurePointsC, MPI_REPLACE));
2471       PetscCall(PetscSFBcastEnd(coveringSF, quadType, coverQuadsSend, coverQuads, MPI_REPLACE));
2472       PetscCallMPI(MPI_Type_free(&quadStruct));
2473       PetscCallMPI(MPI_Type_free(&quadType));
2474       PetscCall(PetscFree(coverQuadsSend));
2475       PetscCall(PetscFree(closurePointsC));
2476       PetscCall(PetscSFDestroy(&coveringSF));
2477       closurePointsC = newClosurePointsC;
2478 
2479       /* assign tree quads based on locations in coverQuads */
2480       {
2481         PetscInt q;
2482         for (q = 0; q < nleaves; q++) {
2483           p4est_locidx_t t = coverQuads[q].p.which_tree;
2484           if (!treeQuadCounts[t - fltF]++) treeQuads[t - fltF] = &coverQuads[q];
2485         }
2486       }
2487     }
2488   }
2489   if (!coverQuads) { /* matching partitions: assign tree quads based on locations in p4est native arrays */
2490     for (t = fltF; t <= lltF; t++) {
2491       p4est_tree_t *tree = &(((p4est_tree_t *)p4estC->trees->array)[t]);
2492 
2493       treeQuadCounts[t - fltF] = tree->quadrants.elem_count;
2494       treeQuads[t - fltF]      = (p4est_quadrant_t *)tree->quadrants.array;
2495     }
2496   }
2497 
2498   {
2499     PetscInt     p;
2500     PetscInt     cLocalStartF;
2501     PetscSF      pointSF;
2502     PetscSFNode *roots;
2503     PetscInt    *rootType;
2504     DM           refTree = NULL;
2505     DMLabel      canonical;
2506     PetscInt    *childClosures[P4EST_CHILDREN] = {NULL};
2507     PetscInt    *rootClosure                   = NULL;
2508     PetscInt     coarseOffset;
2509     PetscInt     numCoarseQuads;
2510 
2511     PetscCall(PetscMalloc1(pEndF - pStartF, &roots));
2512     PetscCall(PetscMalloc1(pEndF - pStartF, &rootType));
2513     PetscCall(DMGetPointSF(fine, &pointSF));
2514     for (p = pStartF; p < pEndF; p++) {
2515       roots[p - pStartF].rank  = -1;
2516       roots[p - pStartF].index = -1;
2517       rootType[p - pStartF]    = -1;
2518     }
2519     if (formCids) {
2520       PetscInt child;
2521 
2522       PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2523       for (p = pStartF; p < pEndF; p++) cids[p - pStartF] = -2;
2524       PetscCall(DMPlexGetReferenceTree(plexF, &refTree));
2525       PetscCall(DMPlexGetTransitiveClosure(refTree, 0, PETSC_TRUE, NULL, &rootClosure));
2526       for (child = 0; child < P4EST_CHILDREN; child++) { /* get the closures of the child cells in the reference tree */
2527         PetscCall(DMPlexGetTransitiveClosure(refTree, child + 1, PETSC_TRUE, NULL, &childClosures[child]));
2528       }
2529       PetscCall(DMGetLabel(refTree, "canonical", &canonical));
2530     }
2531     cLocalStartF = pforestF->cLocalStart;
2532     for (t = fltF, coarseOffset = 0, numCoarseQuads = 0; t <= lltF; t++, coarseOffset += numCoarseQuads) {
2533       p4est_tree_t     *tree         = &(((p4est_tree_t *)p4estF->trees->array)[t]);
2534       PetscInt          numFineQuads = tree->quadrants.elem_count;
2535       p4est_quadrant_t *coarseQuads  = treeQuads[t - fltF];
2536       p4est_quadrant_t *fineQuads    = (p4est_quadrant_t *)tree->quadrants.array;
2537       PetscInt          i, coarseCount = 0;
2538       PetscInt          offset = tree->quadrants_offset;
2539       sc_array_t        coarseQuadsArray;
2540 
2541       numCoarseQuads = treeQuadCounts[t - fltF];
2542       PetscCallP4est(sc_array_init_data, (&coarseQuadsArray, coarseQuads, sizeof(p4est_quadrant_t), (size_t)numCoarseQuads));
2543       for (i = 0; i < numFineQuads; i++) {
2544         PetscInt          c          = i + offset;
2545         p4est_quadrant_t *quad       = &fineQuads[i];
2546         p4est_quadrant_t *quadCoarse = NULL;
2547         ssize_t           disjoint   = -1;
2548 
2549         while (disjoint < 0 && coarseCount < numCoarseQuads) {
2550           quadCoarse = &coarseQuads[coarseCount];
2551           PetscCallP4estReturn(disjoint, p4est_quadrant_disjoint, (quadCoarse, quad));
2552           if (disjoint < 0) coarseCount++;
2553         }
2554         PetscCheck(disjoint == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "did not find overlapping coarse quad");
2555         if (quadCoarse->level > quad->level || (quadCoarse->level == quad->level && !transferIdent)) { /* the "coarse" mesh is finer than the fine mesh at the point: continue */
2556           if (transferIdent) {                                                                         /* find corners */
2557             PetscInt j = 0;
2558 
2559             do {
2560               if (j < P4EST_CHILDREN) {
2561                 p4est_quadrant_t cornerQuad;
2562                 int              equal;
2563 
2564                 PetscCallP4est(p4est_quadrant_corner_descendant, (quad, &cornerQuad, j, quadCoarse->level));
2565                 PetscCallP4estReturn(equal, p4est_quadrant_is_equal, (&cornerQuad, quadCoarse));
2566                 if (equal) {
2567                   PetscInt    petscJ = P4estVertToPetscVert[j];
2568                   PetscInt    p      = closurePointsF[numClosureIndices * c + (P4EST_INSUL - P4EST_CHILDREN) + petscJ].index;
2569                   PetscSFNode q      = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + (P4EST_INSUL - P4EST_CHILDREN) + petscJ];
2570 
2571                   roots[p - pStartF]    = q;
2572                   rootType[p - pStartF] = PETSC_MAX_INT;
2573                   cids[p - pStartF]     = -1;
2574                   j++;
2575                 }
2576               }
2577               coarseCount++;
2578               disjoint = 1;
2579               if (coarseCount < numCoarseQuads) {
2580                 quadCoarse = &coarseQuads[coarseCount];
2581                 PetscCallP4estReturn(disjoint, p4est_quadrant_disjoint, (quadCoarse, quad));
2582               }
2583             } while (!disjoint);
2584           }
2585           continue;
2586         }
2587         if (quadCoarse->level == quad->level) { /* same quad present in coarse and fine mesh */
2588           PetscInt j;
2589           for (j = 0; j < numClosureIndices; j++) {
2590             PetscInt p = closurePointsF[numClosureIndices * c + j].index;
2591 
2592             roots[p - pStartF]    = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + j];
2593             rootType[p - pStartF] = PETSC_MAX_INT; /* unconditionally accept */
2594             cids[p - pStartF]     = -1;
2595           }
2596         } else {
2597           PetscInt levelDiff                 = quad->level - quadCoarse->level;
2598           PetscInt proposedCids[P4EST_INSUL] = {0};
2599 
2600           if (formCids) {
2601             PetscInt  cl;
2602             PetscInt *pointClosure = NULL;
2603             int       cid;
2604 
2605             PetscCheck(levelDiff <= 1, PETSC_COMM_SELF, PETSC_ERR_USER, "Recursive child ids not implemented");
2606             PetscCallP4estReturn(cid, p4est_quadrant_child_id, (quad));
2607             PetscCall(DMPlexGetTransitiveClosure(plexF, c + cLocalStartF, PETSC_TRUE, NULL, &pointClosure));
2608             for (cl = 0; cl < P4EST_INSUL; cl++) {
2609               PetscInt       p      = pointClosure[2 * cl];
2610               PetscInt       point  = childClosures[cid][2 * cl];
2611               PetscInt       ornt   = childClosures[cid][2 * cl + 1];
2612               PetscInt       newcid = -1;
2613               DMPolytopeType ct;
2614 
2615               if (rootType[p - pStartF] == PETSC_MAX_INT) continue;
2616               PetscCall(DMPlexGetCellType(refTree, point, &ct));
2617               ornt = DMPolytopeConvertNewOrientation_Internal(ct, ornt);
2618               if (!cl) {
2619                 newcid = cid + 1;
2620               } else {
2621                 PetscInt rcl, parent, parentOrnt = 0;
2622 
2623                 PetscCall(DMPlexGetTreeParent(refTree, point, &parent, NULL));
2624                 if (parent == point) {
2625                   newcid = -1;
2626                 } else if (!parent) { /* in the root */
2627                   newcid = point;
2628                 } else {
2629                   DMPolytopeType rct = DM_POLYTOPE_UNKNOWN;
2630 
2631                   for (rcl = 1; rcl < P4EST_INSUL; rcl++) {
2632                     if (rootClosure[2 * rcl] == parent) {
2633                       PetscCall(DMPlexGetCellType(refTree, parent, &rct));
2634                       parentOrnt = DMPolytopeConvertNewOrientation_Internal(rct, rootClosure[2 * rcl + 1]);
2635                       break;
2636                     }
2637                   }
2638                   PetscCheck(rcl < P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Couldn't find parent in root closure");
2639                   PetscCall(DMPlexReferenceTreeGetChildSymmetry(refTree, parent, parentOrnt, ornt, point, DMPolytopeConvertNewOrientation_Internal(rct, pointClosure[2 * rcl + 1]), NULL, &newcid));
2640                 }
2641               }
2642               if (newcid >= 0) {
2643                 if (canonical) PetscCall(DMLabelGetValue(canonical, newcid, &newcid));
2644                 proposedCids[cl] = newcid;
2645               }
2646             }
2647             PetscCall(DMPlexRestoreTransitiveClosure(plexF, c + cLocalStartF, PETSC_TRUE, NULL, &pointClosure));
2648           }
2649           p4est_qcoord_t coarseBound[2][P4EST_DIM] = {
2650             {quadCoarse->x, quadCoarse->y,
2651   #if defined(P4_TO_P8)
2652              quadCoarse->z
2653   #endif
2654             },
2655             {0}
2656           };
2657           p4est_qcoord_t fineBound[2][P4EST_DIM] = {
2658             {quad->x, quad->y,
2659   #if defined(P4_TO_P8)
2660              quad->z
2661   #endif
2662             },
2663             {0}
2664           };
2665           PetscInt j;
2666           for (j = 0; j < P4EST_DIM; j++) { /* get the coordinates of cell boundaries in each direction */
2667             coarseBound[1][j] = coarseBound[0][j] + P4EST_QUADRANT_LEN(quadCoarse->level);
2668             fineBound[1][j]   = fineBound[0][j] + P4EST_QUADRANT_LEN(quad->level);
2669           }
2670           for (j = 0; j < numClosureIndices; j++) {
2671             PetscInt    l, p;
2672             PetscSFNode q;
2673 
2674             p = closurePointsF[numClosureIndices * c + j].index;
2675             if (rootType[p - pStartF] == PETSC_MAX_INT) continue;
2676             if (j == 0) { /* volume: ancestor is volume */
2677               l = 0;
2678             } else if (j < 1 + P4EST_FACES) { /* facet */
2679               PetscInt face       = PetscFaceToP4estFace[j - 1];
2680               PetscInt direction  = face / 2;
2681               PetscInt coarseFace = -1;
2682 
2683               if (coarseBound[face % 2][direction] == fineBound[face % 2][direction]) {
2684                 coarseFace = face;
2685                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2686               } else {
2687                 l = 0;
2688               }
2689   #if defined(P4_TO_P8)
2690             } else if (j < 1 + P4EST_FACES + P8EST_EDGES) {
2691               PetscInt  edge       = PetscEdgeToP4estEdge[j - (1 + P4EST_FACES)];
2692               PetscInt  direction  = edge / 4;
2693               PetscInt  mod        = edge % 4;
2694               PetscInt  coarseEdge = -1, coarseFace = -1;
2695               PetscInt  minDir = PetscMin((direction + 1) % 3, (direction + 2) % 3);
2696               PetscInt  maxDir = PetscMax((direction + 1) % 3, (direction + 2) % 3);
2697               PetscBool dirTest[2];
2698 
2699               dirTest[0] = (PetscBool)(coarseBound[mod % 2][minDir] == fineBound[mod % 2][minDir]);
2700               dirTest[1] = (PetscBool)(coarseBound[mod / 2][maxDir] == fineBound[mod / 2][maxDir]);
2701 
2702               if (dirTest[0] && dirTest[1]) { /* fine edge falls on coarse edge */
2703                 coarseEdge = edge;
2704                 l          = 1 + P4EST_FACES + P4estEdgeToPetscEdge[coarseEdge];
2705               } else if (dirTest[0]) { /* fine edge falls on a coarse face in the minDir direction */
2706                 coarseFace = 2 * minDir + (mod % 2);
2707                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2708               } else if (dirTest[1]) { /* fine edge falls on a coarse face in the maxDir direction */
2709                 coarseFace = 2 * maxDir + (mod / 2);
2710                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2711               } else {
2712                 l = 0;
2713               }
2714   #endif
2715             } else {
2716               PetscInt  vertex = PetscVertToP4estVert[P4EST_CHILDREN - (P4EST_INSUL - j)];
2717               PetscBool dirTest[P4EST_DIM];
2718               PetscInt  m;
2719               PetscInt  numMatch     = 0;
2720               PetscInt  coarseVertex = -1, coarseFace = -1;
2721   #if defined(P4_TO_P8)
2722               PetscInt coarseEdge = -1;
2723   #endif
2724 
2725               for (m = 0; m < P4EST_DIM; m++) {
2726                 dirTest[m] = (PetscBool)(coarseBound[(vertex >> m) & 1][m] == fineBound[(vertex >> m) & 1][m]);
2727                 if (dirTest[m]) numMatch++;
2728               }
2729               if (numMatch == P4EST_DIM) { /* vertex on vertex */
2730                 coarseVertex = vertex;
2731                 l            = P4EST_INSUL - (P4EST_CHILDREN - P4estVertToPetscVert[coarseVertex]);
2732               } else if (numMatch == 1) { /* vertex on face */
2733                 for (m = 0; m < P4EST_DIM; m++) {
2734                   if (dirTest[m]) {
2735                     coarseFace = 2 * m + ((vertex >> m) & 1);
2736                     break;
2737                   }
2738                 }
2739                 l = 1 + P4estFaceToPetscFace[coarseFace];
2740   #if defined(P4_TO_P8)
2741               } else if (numMatch == 2) { /* vertex on edge */
2742                 for (m = 0; m < P4EST_DIM; m++) {
2743                   if (!dirTest[m]) {
2744                     PetscInt otherDir1 = (m + 1) % 3;
2745                     PetscInt otherDir2 = (m + 2) % 3;
2746                     PetscInt minDir    = PetscMin(otherDir1, otherDir2);
2747                     PetscInt maxDir    = PetscMax(otherDir1, otherDir2);
2748 
2749                     coarseEdge = m * 4 + 2 * ((vertex >> maxDir) & 1) + ((vertex >> minDir) & 1);
2750                     break;
2751                   }
2752                 }
2753                 l = 1 + P4EST_FACES + P4estEdgeToPetscEdge[coarseEdge];
2754   #endif
2755               } else { /* volume */
2756                 l = 0;
2757               }
2758             }
2759             q = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + l];
2760             if (l > rootType[p - pStartF]) {
2761               if (l >= P4EST_INSUL - P4EST_CHILDREN) { /* vertex on vertex: unconditional acceptance */
2762                 if (transferIdent) {
2763                   roots[p - pStartF]    = q;
2764                   rootType[p - pStartF] = PETSC_MAX_INT;
2765                   if (formCids) cids[p - pStartF] = -1;
2766                 }
2767               } else {
2768                 PetscInt k, thisp = p, limit;
2769 
2770                 roots[p - pStartF]    = q;
2771                 rootType[p - pStartF] = l;
2772                 if (formCids) cids[p - pStartF] = proposedCids[j];
2773                 limit = transferIdent ? levelDiff : (levelDiff - 1);
2774                 for (k = 0; k < limit; k++) {
2775                   PetscInt parent;
2776 
2777                   PetscCall(DMPlexGetTreeParent(plexF, thisp, &parent, NULL));
2778                   if (parent == thisp) break;
2779 
2780                   roots[parent - pStartF]    = q;
2781                   rootType[parent - pStartF] = PETSC_MAX_INT;
2782                   if (formCids) cids[parent - pStartF] = -1;
2783                   thisp = parent;
2784                 }
2785               }
2786             }
2787           }
2788         }
2789       }
2790     }
2791 
2792     /* now every cell has labeled the points in its closure, so we first make sure everyone agrees by reducing to roots, and the broadcast the agreements */
2793     if (size > 1) {
2794       PetscInt *rootTypeCopy, p;
2795 
2796       PetscCall(PetscMalloc1(pEndF - pStartF, &rootTypeCopy));
2797       PetscCall(PetscArraycpy(rootTypeCopy, rootType, pEndF - pStartF));
2798       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_MAX));
2799       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_MAX));
2800       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_REPLACE));
2801       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_REPLACE));
2802       for (p = pStartF; p < pEndF; p++) {
2803         if (rootTypeCopy[p - pStartF] > rootType[p - pStartF]) { /* another process found a root of higher type (e.g. vertex instead of edge), which we want to accept, so nullify this */
2804           roots[p - pStartF].rank  = -1;
2805           roots[p - pStartF].index = -1;
2806         }
2807         if (formCids && rootTypeCopy[p - pStartF] == PETSC_MAX_INT) { cids[p - pStartF] = -1; /* we have found an antecedent that is the same: no child id */ }
2808       }
2809       PetscCall(PetscFree(rootTypeCopy));
2810       PetscCall(PetscSFReduceBegin(pointSF, nodeType, roots, roots, sfNodeReduce));
2811       PetscCall(PetscSFReduceEnd(pointSF, nodeType, roots, roots, sfNodeReduce));
2812       PetscCall(PetscSFBcastBegin(pointSF, nodeType, roots, roots, MPI_REPLACE));
2813       PetscCall(PetscSFBcastEnd(pointSF, nodeType, roots, roots, MPI_REPLACE));
2814     }
2815     PetscCall(PetscFree(rootType));
2816 
2817     {
2818       PetscInt     numRoots;
2819       PetscInt     numLeaves;
2820       PetscInt    *leaves;
2821       PetscSFNode *iremote;
2822       /* count leaves */
2823 
2824       numRoots = pEndC - pStartC;
2825 
2826       numLeaves = 0;
2827       for (p = pStartF; p < pEndF; p++) {
2828         if (roots[p - pStartF].index >= 0) numLeaves++;
2829       }
2830       PetscCall(PetscMalloc1(numLeaves, &leaves));
2831       PetscCall(PetscMalloc1(numLeaves, &iremote));
2832       numLeaves = 0;
2833       for (p = pStartF; p < pEndF; p++) {
2834         if (roots[p - pStartF].index >= 0) {
2835           leaves[numLeaves]  = p - pStartF;
2836           iremote[numLeaves] = roots[p - pStartF];
2837           numLeaves++;
2838         }
2839       }
2840       PetscCall(PetscFree(roots));
2841       PetscCall(PetscSFCreate(comm, sf));
2842       if (numLeaves == (pEndF - pStartF)) {
2843         PetscCall(PetscFree(leaves));
2844         PetscCall(PetscSFSetGraph(*sf, numRoots, numLeaves, NULL, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER));
2845       } else {
2846         PetscCall(PetscSFSetGraph(*sf, numRoots, numLeaves, leaves, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER));
2847       }
2848     }
2849     if (formCids) {
2850       PetscSF  pointSF;
2851       PetscInt child;
2852 
2853       PetscCall(DMPlexGetReferenceTree(plexF, &refTree));
2854       PetscCall(DMGetPointSF(plexF, &pointSF));
2855       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, cids, cids, MPI_MAX));
2856       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, cids, cids, MPI_MAX));
2857       if (childIds) *childIds = cids;
2858       for (child = 0; child < P4EST_CHILDREN; child++) PetscCall(DMPlexRestoreTransitiveClosure(refTree, child + 1, PETSC_TRUE, NULL, &childClosures[child]));
2859       PetscCall(DMPlexRestoreTransitiveClosure(refTree, 0, PETSC_TRUE, NULL, &rootClosure));
2860     }
2861   }
2862   if (saveInCoarse) { /* cache results */
2863     PetscCall(PetscObjectReference((PetscObject)*sf));
2864     pforestC->pointSelfToAdaptSF = *sf;
2865     if (!childIds) {
2866       pforestC->pointSelfToAdaptCids = cids;
2867     } else {
2868       PetscCall(PetscMalloc1(pEndF - pStartF, &pforestC->pointSelfToAdaptCids));
2869       PetscCall(PetscArraycpy(pforestC->pointSelfToAdaptCids, cids, pEndF - pStartF));
2870     }
2871   } else if (saveInFine) {
2872     PetscCall(PetscObjectReference((PetscObject)*sf));
2873     pforestF->pointAdaptToSelfSF = *sf;
2874     if (!childIds) {
2875       pforestF->pointAdaptToSelfCids = cids;
2876     } else {
2877       PetscCall(PetscMalloc1(pEndF - pStartF, &pforestF->pointAdaptToSelfCids));
2878       PetscCall(PetscArraycpy(pforestF->pointAdaptToSelfCids, cids, pEndF - pStartF));
2879     }
2880   }
2881   PetscCall(PetscFree2(treeQuads, treeQuadCounts));
2882   PetscCall(PetscFree(coverQuads));
2883   PetscCall(PetscFree(closurePointsC));
2884   PetscCall(PetscFree(closurePointsF));
2885   PetscCallMPI(MPI_Type_free(&nodeClosureType));
2886   PetscCallMPI(MPI_Op_free(&sfNodeReduce));
2887   PetscCallMPI(MPI_Type_free(&nodeType));
2888   PetscFunctionReturn(PETSC_SUCCESS);
2889 }
2890 
2891 /* children are sf leaves of parents */
2892 static PetscErrorCode DMPforestGetTransferSF_Internal(DM coarse, DM fine, const PetscInt dofPerDim[], PetscSF *sf, PetscBool transferIdent, PetscInt *childIds[])
2893 {
2894   MPI_Comm           comm;
2895   PetscMPIInt        rank;
2896   DM_Forest_pforest *pforestC, *pforestF;
2897   DM                 plexC, plexF;
2898   PetscInt           pStartC, pEndC, pStartF, pEndF;
2899   PetscSF            pointTransferSF;
2900   PetscBool          allOnes = PETSC_TRUE;
2901 
2902   PetscFunctionBegin;
2903   pforestC = (DM_Forest_pforest *)((DM_Forest *)coarse->data)->data;
2904   pforestF = (DM_Forest_pforest *)((DM_Forest *)fine->data)->data;
2905   PetscCheck(pforestC->topo == pforestF->topo, PetscObjectComm((PetscObject)coarse), PETSC_ERR_ARG_INCOMP, "DM's must have the same base DM");
2906   comm = PetscObjectComm((PetscObject)coarse);
2907   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2908 
2909   {
2910     PetscInt i;
2911     for (i = 0; i <= P4EST_DIM; i++) {
2912       if (dofPerDim[i] != 1) {
2913         allOnes = PETSC_FALSE;
2914         break;
2915       }
2916     }
2917   }
2918   PetscCall(DMPforestGetTransferSF_Point(coarse, fine, &pointTransferSF, transferIdent, childIds));
2919   if (allOnes) {
2920     *sf = pointTransferSF;
2921     PetscFunctionReturn(PETSC_SUCCESS);
2922   }
2923 
2924   PetscCall(DMPforestGetPlex(fine, &plexF));
2925   PetscCall(DMPlexGetChart(plexF, &pStartF, &pEndF));
2926   PetscCall(DMPforestGetPlex(coarse, &plexC));
2927   PetscCall(DMPlexGetChart(plexC, &pStartC, &pEndC));
2928   {
2929     PetscInt           numRoots;
2930     PetscInt           numLeaves;
2931     const PetscInt    *leaves;
2932     const PetscSFNode *iremote;
2933     PetscInt           d;
2934     PetscSection       leafSection, rootSection;
2935     /* count leaves */
2936 
2937     PetscCall(PetscSFGetGraph(pointTransferSF, &numRoots, &numLeaves, &leaves, &iremote));
2938     PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &rootSection));
2939     PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &leafSection));
2940     PetscCall(PetscSectionSetChart(rootSection, pStartC, pEndC));
2941     PetscCall(PetscSectionSetChart(leafSection, pStartF, pEndF));
2942 
2943     for (d = 0; d <= P4EST_DIM; d++) {
2944       PetscInt startC, endC, e;
2945 
2946       PetscCall(DMPlexGetSimplexOrBoxCells(plexC, P4EST_DIM - d, &startC, &endC));
2947       for (e = startC; e < endC; e++) PetscCall(PetscSectionSetDof(rootSection, e, dofPerDim[d]));
2948     }
2949 
2950     for (d = 0; d <= P4EST_DIM; d++) {
2951       PetscInt startF, endF, e;
2952 
2953       PetscCall(DMPlexGetSimplexOrBoxCells(plexF, P4EST_DIM - d, &startF, &endF));
2954       for (e = startF; e < endF; e++) PetscCall(PetscSectionSetDof(leafSection, e, dofPerDim[d]));
2955     }
2956 
2957     PetscCall(PetscSectionSetUp(rootSection));
2958     PetscCall(PetscSectionSetUp(leafSection));
2959     {
2960       PetscInt     nroots, nleaves;
2961       PetscInt    *mine, i, p;
2962       PetscInt    *offsets, *offsetsRoot;
2963       PetscSFNode *remote;
2964 
2965       PetscCall(PetscMalloc1(pEndF - pStartF, &offsets));
2966       PetscCall(PetscMalloc1(pEndC - pStartC, &offsetsRoot));
2967       for (p = pStartC; p < pEndC; p++) PetscCall(PetscSectionGetOffset(rootSection, p, &offsetsRoot[p - pStartC]));
2968       PetscCall(PetscSFBcastBegin(pointTransferSF, MPIU_INT, offsetsRoot, offsets, MPI_REPLACE));
2969       PetscCall(PetscSFBcastEnd(pointTransferSF, MPIU_INT, offsetsRoot, offsets, MPI_REPLACE));
2970       PetscCall(PetscSectionGetStorageSize(rootSection, &nroots));
2971       nleaves = 0;
2972       for (i = 0; i < numLeaves; i++) {
2973         PetscInt leaf = leaves ? leaves[i] : i;
2974         PetscInt dof;
2975 
2976         PetscCall(PetscSectionGetDof(leafSection, leaf, &dof));
2977         nleaves += dof;
2978       }
2979       PetscCall(PetscMalloc1(nleaves, &mine));
2980       PetscCall(PetscMalloc1(nleaves, &remote));
2981       nleaves = 0;
2982       for (i = 0; i < numLeaves; i++) {
2983         PetscInt leaf = leaves ? leaves[i] : i;
2984         PetscInt dof;
2985         PetscInt off, j;
2986 
2987         PetscCall(PetscSectionGetDof(leafSection, leaf, &dof));
2988         PetscCall(PetscSectionGetOffset(leafSection, leaf, &off));
2989         for (j = 0; j < dof; j++) {
2990           remote[nleaves].rank  = iremote[i].rank;
2991           remote[nleaves].index = offsets[leaf] + j;
2992           mine[nleaves++]       = off + j;
2993         }
2994       }
2995       PetscCall(PetscFree(offsetsRoot));
2996       PetscCall(PetscFree(offsets));
2997       PetscCall(PetscSFCreate(comm, sf));
2998       PetscCall(PetscSFSetGraph(*sf, nroots, nleaves, mine, PETSC_OWN_POINTER, remote, PETSC_OWN_POINTER));
2999     }
3000     PetscCall(PetscSectionDestroy(&leafSection));
3001     PetscCall(PetscSectionDestroy(&rootSection));
3002     PetscCall(PetscSFDestroy(&pointTransferSF));
3003   }
3004   PetscFunctionReturn(PETSC_SUCCESS);
3005 }
3006 
3007 static PetscErrorCode DMPforestGetTransferSF(DM dmA, DM dmB, const PetscInt dofPerDim[], PetscSF *sfAtoB, PetscSF *sfBtoA)
3008 {
3009   DM          adaptA, adaptB;
3010   DMAdaptFlag purpose;
3011 
3012   PetscFunctionBegin;
3013   PetscCall(DMForestGetAdaptivityForest(dmA, &adaptA));
3014   PetscCall(DMForestGetAdaptivityForest(dmB, &adaptB));
3015   /* it is more efficient when the coarser mesh is the first argument: reorder if we know one is coarser than the other */
3016   if (adaptA && adaptA->data == dmB->data) { /* dmA was adapted from dmB */
3017     PetscCall(DMForestGetAdaptivityPurpose(dmA, &purpose));
3018     if (purpose == DM_ADAPT_REFINE) {
3019       PetscCall(DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB));
3020       PetscFunctionReturn(PETSC_SUCCESS);
3021     }
3022   } else if (adaptB && adaptB->data == dmA->data) { /* dmB was adapted from dmA */
3023     PetscCall(DMForestGetAdaptivityPurpose(dmB, &purpose));
3024     if (purpose == DM_ADAPT_COARSEN) {
3025       PetscCall(DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB));
3026       PetscFunctionReturn(PETSC_SUCCESS);
3027     }
3028   }
3029   if (sfAtoB) PetscCall(DMPforestGetTransferSF_Internal(dmA, dmB, dofPerDim, sfAtoB, PETSC_TRUE, NULL));
3030   if (sfBtoA) PetscCall(DMPforestGetTransferSF_Internal(dmB, dmA, dofPerDim, sfBtoA, (PetscBool)(sfAtoB == NULL), NULL));
3031   PetscFunctionReturn(PETSC_SUCCESS);
3032 }
3033 
3034 static PetscErrorCode DMPforestLabelsInitialize(DM dm, DM plex)
3035 {
3036   DM_Forest         *forest  = (DM_Forest *)dm->data;
3037   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
3038   PetscInt           cLocalStart, cLocalEnd, cStart, cEnd, fStart, fEnd, eStart, eEnd, vStart, vEnd;
3039   PetscInt           cStartBase, cEndBase, fStartBase, fEndBase, vStartBase, vEndBase, eStartBase, eEndBase;
3040   PetscInt           pStart, pEnd, pStartBase, pEndBase, p;
3041   DM                 base;
3042   PetscInt          *star      = NULL, starSize;
3043   DMLabelLink        next      = dm->labels;
3044   PetscInt           guess     = 0;
3045   p4est_topidx_t     num_trees = pforest->topo->conn->num_trees;
3046 
3047   PetscFunctionBegin;
3048   pforest->labelsFinalized = PETSC_TRUE;
3049   cLocalStart              = pforest->cLocalStart;
3050   cLocalEnd                = pforest->cLocalEnd;
3051   PetscCall(DMForestGetBaseDM(dm, &base));
3052   if (!base) {
3053     if (pforest->ghostName) { /* insert a label to make the boundaries, with stratum values denoting which face of the element touches the boundary */
3054       p4est_connectivity_t *conn  = pforest->topo->conn;
3055       p4est_t              *p4est = pforest->forest;
3056       p4est_tree_t         *trees = (p4est_tree_t *)p4est->trees->array;
3057       p4est_topidx_t        t, flt = p4est->first_local_tree;
3058       p4est_topidx_t        llt = pforest->forest->last_local_tree;
3059       DMLabel               ghostLabel;
3060       PetscInt              c;
3061 
3062       PetscCall(DMCreateLabel(plex, pforest->ghostName));
3063       PetscCall(DMGetLabel(plex, pforest->ghostName, &ghostLabel));
3064       for (c = cLocalStart, t = flt; t <= llt; t++) {
3065         p4est_tree_t     *tree     = &trees[t];
3066         p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
3067         PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
3068         PetscInt          q;
3069 
3070         for (q = 0; q < numQuads; q++, c++) {
3071           p4est_quadrant_t *quad = &quads[q];
3072           PetscInt          f;
3073 
3074           for (f = 0; f < P4EST_FACES; f++) {
3075             p4est_quadrant_t neigh;
3076             int              isOutside;
3077 
3078             PetscCallP4est(p4est_quadrant_face_neighbor, (quad, f, &neigh));
3079             PetscCallP4estReturn(isOutside, p4est_quadrant_is_outside_face, (&neigh));
3080             if (isOutside) {
3081               p4est_topidx_t nt;
3082               PetscInt       nf;
3083 
3084               nt = conn->tree_to_tree[t * P4EST_FACES + f];
3085               nf = (PetscInt)conn->tree_to_face[t * P4EST_FACES + f];
3086               nf = nf % P4EST_FACES;
3087               if (nt == t && nf == f) {
3088                 PetscInt        plexF = P4estFaceToPetscFace[f];
3089                 const PetscInt *cone;
3090 
3091                 PetscCall(DMPlexGetCone(plex, c, &cone));
3092                 PetscCall(DMLabelSetValue(ghostLabel, cone[plexF], plexF + 1));
3093               }
3094             }
3095           }
3096         }
3097       }
3098     }
3099     PetscFunctionReturn(PETSC_SUCCESS);
3100   }
3101   PetscCall(DMPlexGetSimplexOrBoxCells(base, 0, &cStartBase, &cEndBase));
3102   PetscCall(DMPlexGetSimplexOrBoxCells(base, 1, &fStartBase, &fEndBase));
3103   PetscCall(DMPlexGetSimplexOrBoxCells(base, P4EST_DIM - 1, &eStartBase, &eEndBase));
3104   PetscCall(DMPlexGetDepthStratum(base, 0, &vStartBase, &vEndBase));
3105 
3106   PetscCall(DMPlexGetSimplexOrBoxCells(plex, 0, &cStart, &cEnd));
3107   PetscCall(DMPlexGetSimplexOrBoxCells(plex, 1, &fStart, &fEnd));
3108   PetscCall(DMPlexGetSimplexOrBoxCells(plex, P4EST_DIM - 1, &eStart, &eEnd));
3109   PetscCall(DMPlexGetDepthStratum(plex, 0, &vStart, &vEnd));
3110 
3111   PetscCall(DMPlexGetChart(plex, &pStart, &pEnd));
3112   PetscCall(DMPlexGetChart(base, &pStartBase, &pEndBase));
3113   /* go through the mesh: use star to find a quadrant that borders a point.  Use the closure to determine the
3114    * orientation of the quadrant relative to that point.  Use that to relate the point to the numbering in the base
3115    * mesh, and extract a label value (since the base mesh is redundantly distributed, can be found locally). */
3116   while (next) {
3117     DMLabel     baseLabel;
3118     DMLabel     label = next->label;
3119     PetscBool   isDepth, isCellType, isGhost, isVTK, isSpmap;
3120     const char *name;
3121 
3122     PetscCall(PetscObjectGetName((PetscObject)label, &name));
3123     PetscCall(PetscStrcmp(name, "depth", &isDepth));
3124     if (isDepth) {
3125       next = next->next;
3126       continue;
3127     }
3128     PetscCall(PetscStrcmp(name, "celltype", &isCellType));
3129     if (isCellType) {
3130       next = next->next;
3131       continue;
3132     }
3133     PetscCall(PetscStrcmp(name, "ghost", &isGhost));
3134     if (isGhost) {
3135       next = next->next;
3136       continue;
3137     }
3138     PetscCall(PetscStrcmp(name, "vtk", &isVTK));
3139     if (isVTK) {
3140       next = next->next;
3141       continue;
3142     }
3143     PetscCall(PetscStrcmp(name, "_forest_base_subpoint_map", &isSpmap));
3144     if (!isSpmap) {
3145       PetscCall(DMGetLabel(base, name, &baseLabel));
3146       if (!baseLabel) {
3147         next = next->next;
3148         continue;
3149       }
3150       PetscCall(DMLabelCreateIndex(baseLabel, pStartBase, pEndBase));
3151     } else baseLabel = NULL;
3152 
3153     for (p = pStart; p < pEnd; p++) {
3154       PetscInt          s, c = -1, l;
3155       PetscInt         *closure = NULL, closureSize;
3156       p4est_quadrant_t *ghosts  = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3157       p4est_tree_t     *trees   = (p4est_tree_t *)pforest->forest->trees->array;
3158       p4est_quadrant_t *q;
3159       PetscInt          t, val;
3160       PetscBool         zerosupportpoint = PETSC_FALSE;
3161 
3162       PetscCall(DMPlexGetTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3163       for (s = 0; s < starSize; s++) {
3164         PetscInt point = star[2 * s];
3165 
3166         if (cStart <= point && point < cEnd) {
3167           PetscCall(DMPlexGetTransitiveClosure(plex, point, PETSC_TRUE, &closureSize, &closure));
3168           for (l = 0; l < closureSize; l++) {
3169             PetscInt qParent = closure[2 * l], q, pp = p, pParent = p;
3170             do { /* check parents of q */
3171               q = qParent;
3172               if (q == p) {
3173                 c = point;
3174                 break;
3175               }
3176               PetscCall(DMPlexGetTreeParent(plex, q, &qParent, NULL));
3177             } while (qParent != q);
3178             if (c != -1) break;
3179             PetscCall(DMPlexGetTreeParent(plex, pp, &pParent, NULL));
3180             q = closure[2 * l];
3181             while (pParent != pp) { /* check parents of p */
3182               pp = pParent;
3183               if (pp == q) {
3184                 c = point;
3185                 break;
3186               }
3187               PetscCall(DMPlexGetTreeParent(plex, pp, &pParent, NULL));
3188             }
3189             if (c != -1) break;
3190           }
3191           PetscCall(DMPlexRestoreTransitiveClosure(plex, point, PETSC_TRUE, NULL, &closure));
3192           if (l < closureSize) break;
3193         } else {
3194           PetscInt supportSize;
3195 
3196           PetscCall(DMPlexGetSupportSize(plex, point, &supportSize));
3197           zerosupportpoint = (PetscBool)(zerosupportpoint || !supportSize);
3198         }
3199       }
3200       if (c < 0) {
3201         const char *prefix;
3202         PetscBool   print = PETSC_FALSE;
3203 
3204         PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
3205         PetscCall(PetscOptionsGetBool(((PetscObject)dm)->options, prefix, "-dm_forest_print_label_error", &print, NULL));
3206         if (print) {
3207           PetscInt i;
3208 
3209           PetscCall(PetscPrintf(PETSC_COMM_SELF, "[%d] Failed to find cell with point %" PetscInt_FMT " in its closure for label %s (starSize %" PetscInt_FMT ")\n", PetscGlobalRank, p, baseLabel ? ((PetscObject)baseLabel)->name : "_forest_base_subpoint_map", starSize));
3210           for (i = 0; i < starSize; i++) PetscCall(PetscPrintf(PETSC_COMM_SELF, "  star[%" PetscInt_FMT "] = %" PetscInt_FMT ",%" PetscInt_FMT "\n", i, star[2 * i], star[2 * i + 1]));
3211         }
3212         PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, NULL, &star));
3213         if (zerosupportpoint) continue;
3214         else
3215           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Failed to find cell with point %" PetscInt_FMT " in its closure for label %s. Rerun with -dm_forest_print_label_error for more information", p, baseLabel ? ((PetscObject)baseLabel)->name : "_forest_base_subpoint_map");
3216       }
3217       PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, NULL, &star));
3218 
3219       if (c < cLocalStart) {
3220         /* get from the beginning of the ghost layer */
3221         q = &(ghosts[c]);
3222         t = (PetscInt)q->p.which_tree;
3223       } else if (c < cLocalEnd) {
3224         PetscInt lo = 0, hi = num_trees;
3225         /* get from local quadrants: have to find the right tree */
3226 
3227         c -= cLocalStart;
3228 
3229         do {
3230           p4est_tree_t *tree;
3231 
3232           PetscCheck(guess >= lo && guess < num_trees && lo < hi, PETSC_COMM_SELF, PETSC_ERR_PLIB, "failed binary search");
3233           tree = &trees[guess];
3234           if (c < tree->quadrants_offset) {
3235             hi = guess;
3236           } else if (c < tree->quadrants_offset + (PetscInt)tree->quadrants.elem_count) {
3237             q = &((p4est_quadrant_t *)tree->quadrants.array)[c - (PetscInt)tree->quadrants_offset];
3238             t = guess;
3239             break;
3240           } else {
3241             lo = guess + 1;
3242           }
3243           guess = lo + (hi - lo) / 2;
3244         } while (1);
3245       } else {
3246         /* get from the end of the ghost layer */
3247         c -= (cLocalEnd - cLocalStart);
3248 
3249         q = &(ghosts[c]);
3250         t = (PetscInt)q->p.which_tree;
3251       }
3252 
3253       if (l == 0) { /* cell */
3254         if (baseLabel) {
3255           PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3256         } else {
3257           val = t + cStartBase;
3258         }
3259         PetscCall(DMLabelSetValue(label, p, val));
3260       } else if (l >= 1 && l < 1 + P4EST_FACES) { /* facet */
3261         p4est_quadrant_t nq;
3262         int              isInside;
3263 
3264         l = PetscFaceToP4estFace[l - 1];
3265         PetscCallP4est(p4est_quadrant_face_neighbor, (q, l, &nq));
3266         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3267         if (isInside) {
3268           /* this facet is in the interior of a tree, so it inherits the label of the tree */
3269           if (baseLabel) {
3270             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3271           } else {
3272             val = t + cStartBase;
3273           }
3274           PetscCall(DMLabelSetValue(label, p, val));
3275         } else {
3276           PetscInt f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + l];
3277 
3278           if (baseLabel) {
3279             PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3280           } else {
3281             val = f + fStartBase;
3282           }
3283           PetscCall(DMLabelSetValue(label, p, val));
3284         }
3285   #if defined(P4_TO_P8)
3286       } else if (l >= 1 + P4EST_FACES && l < 1 + P4EST_FACES + P8EST_EDGES) { /* edge */
3287         p4est_quadrant_t nq;
3288         int              isInside;
3289 
3290         l = PetscEdgeToP4estEdge[l - (1 + P4EST_FACES)];
3291         PetscCallP4est(p8est_quadrant_edge_neighbor, (q, l, &nq));
3292         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3293         if (isInside) {
3294           /* this edge is in the interior of a tree, so it inherits the label of the tree */
3295           if (baseLabel) {
3296             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3297           } else {
3298             val = t + cStartBase;
3299           }
3300           PetscCall(DMLabelSetValue(label, p, val));
3301         } else {
3302           int isOutsideFace;
3303 
3304           PetscCallP4estReturn(isOutsideFace, p4est_quadrant_is_outside_face, (&nq));
3305           if (isOutsideFace) {
3306             PetscInt f;
3307 
3308             if (nq.x < 0) {
3309               f = 0;
3310             } else if (nq.x >= P4EST_ROOT_LEN) {
3311               f = 1;
3312             } else if (nq.y < 0) {
3313               f = 2;
3314             } else if (nq.y >= P4EST_ROOT_LEN) {
3315               f = 3;
3316             } else if (nq.z < 0) {
3317               f = 4;
3318             } else {
3319               f = 5;
3320             }
3321             f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f];
3322             if (baseLabel) {
3323               PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3324             } else {
3325               val = f + fStartBase;
3326             }
3327             PetscCall(DMLabelSetValue(label, p, val));
3328           } else { /* the quadrant edge corresponds to the tree edge */
3329             PetscInt e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + l];
3330 
3331             if (baseLabel) {
3332               PetscCall(DMLabelGetValue(baseLabel, e + eStartBase, &val));
3333             } else {
3334               val = e + eStartBase;
3335             }
3336             PetscCall(DMLabelSetValue(label, p, val));
3337           }
3338         }
3339   #endif
3340       } else { /* vertex */
3341         p4est_quadrant_t nq;
3342         int              isInside;
3343 
3344   #if defined(P4_TO_P8)
3345         l = PetscVertToP4estVert[l - (1 + P4EST_FACES + P8EST_EDGES)];
3346   #else
3347         l = PetscVertToP4estVert[l - (1 + P4EST_FACES)];
3348   #endif
3349         PetscCallP4est(p4est_quadrant_corner_neighbor, (q, l, &nq));
3350         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3351         if (isInside) {
3352           if (baseLabel) {
3353             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3354           } else {
3355             val = t + cStartBase;
3356           }
3357           PetscCall(DMLabelSetValue(label, p, val));
3358         } else {
3359           int isOutside;
3360 
3361           PetscCallP4estReturn(isOutside, p4est_quadrant_is_outside_face, (&nq));
3362           if (isOutside) {
3363             PetscInt f = -1;
3364 
3365             if (nq.x < 0) {
3366               f = 0;
3367             } else if (nq.x >= P4EST_ROOT_LEN) {
3368               f = 1;
3369             } else if (nq.y < 0) {
3370               f = 2;
3371             } else if (nq.y >= P4EST_ROOT_LEN) {
3372               f = 3;
3373   #if defined(P4_TO_P8)
3374             } else if (nq.z < 0) {
3375               f = 4;
3376             } else {
3377               f = 5;
3378   #endif
3379             }
3380             f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f];
3381             if (baseLabel) {
3382               PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3383             } else {
3384               val = f + fStartBase;
3385             }
3386             PetscCall(DMLabelSetValue(label, p, val));
3387             continue;
3388           }
3389   #if defined(P4_TO_P8)
3390           PetscCallP4estReturn(isOutside, p8est_quadrant_is_outside_edge, (&nq));
3391           if (isOutside) {
3392             /* outside edge */
3393             PetscInt e = -1;
3394 
3395             if (nq.x >= 0 && nq.x < P4EST_ROOT_LEN) {
3396               if (nq.z < 0) {
3397                 if (nq.y < 0) {
3398                   e = 0;
3399                 } else {
3400                   e = 1;
3401                 }
3402               } else {
3403                 if (nq.y < 0) {
3404                   e = 2;
3405                 } else {
3406                   e = 3;
3407                 }
3408               }
3409             } else if (nq.y >= 0 && nq.y < P4EST_ROOT_LEN) {
3410               if (nq.z < 0) {
3411                 if (nq.x < 0) {
3412                   e = 4;
3413                 } else {
3414                   e = 5;
3415                 }
3416               } else {
3417                 if (nq.x < 0) {
3418                   e = 6;
3419                 } else {
3420                   e = 7;
3421                 }
3422               }
3423             } else {
3424               if (nq.y < 0) {
3425                 if (nq.x < 0) {
3426                   e = 8;
3427                 } else {
3428                   e = 9;
3429                 }
3430               } else {
3431                 if (nq.x < 0) {
3432                   e = 10;
3433                 } else {
3434                   e = 11;
3435                 }
3436               }
3437             }
3438 
3439             e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + e];
3440             if (baseLabel) {
3441               PetscCall(DMLabelGetValue(baseLabel, e + eStartBase, &val));
3442             } else {
3443               val = e + eStartBase;
3444             }
3445             PetscCall(DMLabelSetValue(label, p, val));
3446             continue;
3447           }
3448   #endif
3449           {
3450             /* outside vertex: same corner as quadrant corner */
3451             PetscInt v = pforest->topo->conn->tree_to_corner[P4EST_CHILDREN * t + l];
3452 
3453             if (baseLabel) {
3454               PetscCall(DMLabelGetValue(baseLabel, v + vStartBase, &val));
3455             } else {
3456               val = v + vStartBase;
3457             }
3458             PetscCall(DMLabelSetValue(label, p, val));
3459           }
3460         }
3461       }
3462     }
3463     next = next->next;
3464   }
3465   PetscFunctionReturn(PETSC_SUCCESS);
3466 }
3467 
3468 static PetscErrorCode DMPforestLabelsFinalize(DM dm, DM plex)
3469 {
3470   DM_Forest_pforest *pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
3471   DM                 adapt;
3472 
3473   PetscFunctionBegin;
3474   if (pforest->labelsFinalized) PetscFunctionReturn(PETSC_SUCCESS);
3475   pforest->labelsFinalized = PETSC_TRUE;
3476   PetscCall(DMForestGetAdaptivityForest(dm, &adapt));
3477   if (!adapt) {
3478     /* Initialize labels from the base dm */
3479     PetscCall(DMPforestLabelsInitialize(dm, plex));
3480   } else {
3481     PetscInt    dofPerDim[4] = {1, 1, 1, 1};
3482     PetscSF     transferForward, transferBackward, pointSF;
3483     PetscInt    pStart, pEnd, pStartA, pEndA;
3484     PetscInt   *values, *adaptValues;
3485     DMLabelLink next = adapt->labels;
3486     DMLabel     adaptLabel;
3487     DM          adaptPlex;
3488 
3489     PetscCall(DMForestGetAdaptivityLabel(dm, &adaptLabel));
3490     PetscCall(DMPforestGetPlex(adapt, &adaptPlex));
3491     PetscCall(DMPforestGetTransferSF(adapt, dm, dofPerDim, &transferForward, &transferBackward));
3492     PetscCall(DMPlexGetChart(plex, &pStart, &pEnd));
3493     PetscCall(DMPlexGetChart(adaptPlex, &pStartA, &pEndA));
3494     PetscCall(PetscMalloc2(pEnd - pStart, &values, pEndA - pStartA, &adaptValues));
3495     PetscCall(DMGetPointSF(plex, &pointSF));
3496     if (PetscDefined(USE_DEBUG)) {
3497       PetscInt p;
3498       for (p = pStartA; p < pEndA; p++) adaptValues[p - pStartA] = -1;
3499       for (p = pStart; p < pEnd; p++) values[p - pStart] = -2;
3500       if (transferForward) {
3501         PetscCall(PetscSFBcastBegin(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3502         PetscCall(PetscSFBcastEnd(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3503       }
3504       if (transferBackward) {
3505         PetscCall(PetscSFReduceBegin(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3506         PetscCall(PetscSFReduceEnd(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3507       }
3508       for (p = pStart; p < pEnd; p++) {
3509         PetscInt q = p, parent;
3510 
3511         PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3512         while (parent != q) {
3513           if (values[parent] == -2) values[parent] = values[q];
3514           q = parent;
3515           PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3516         }
3517       }
3518       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, values, values, MPI_MAX));
3519       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, values, values, MPI_MAX));
3520       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3521       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3522       for (p = pStart; p < pEnd; p++) PetscCheck(values[p - pStart] != -2, PETSC_COMM_SELF, PETSC_ERR_PLIB, "uncovered point %" PetscInt_FMT, p);
3523     }
3524     while (next) {
3525       DMLabel     nextLabel = next->label;
3526       const char *name;
3527       PetscBool   isDepth, isCellType, isGhost, isVTK;
3528       DMLabel     label;
3529       PetscInt    p;
3530 
3531       PetscCall(PetscObjectGetName((PetscObject)nextLabel, &name));
3532       PetscCall(PetscStrcmp(name, "depth", &isDepth));
3533       if (isDepth) {
3534         next = next->next;
3535         continue;
3536       }
3537       PetscCall(PetscStrcmp(name, "celltype", &isCellType));
3538       if (isCellType) {
3539         next = next->next;
3540         continue;
3541       }
3542       PetscCall(PetscStrcmp(name, "ghost", &isGhost));
3543       if (isGhost) {
3544         next = next->next;
3545         continue;
3546       }
3547       PetscCall(PetscStrcmp(name, "vtk", &isVTK));
3548       if (isVTK) {
3549         next = next->next;
3550         continue;
3551       }
3552       if (nextLabel == adaptLabel) {
3553         next = next->next;
3554         continue;
3555       }
3556       /* label was created earlier */
3557       PetscCall(DMGetLabel(dm, name, &label));
3558       for (p = pStartA; p < pEndA; p++) PetscCall(DMLabelGetValue(nextLabel, p, &adaptValues[p]));
3559       for (p = pStart; p < pEnd; p++) values[p] = PETSC_MIN_INT;
3560 
3561       if (transferForward) PetscCall(PetscSFBcastBegin(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3562       if (transferBackward) PetscCall(PetscSFReduceBegin(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3563       if (transferForward) PetscCall(PetscSFBcastEnd(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3564       if (transferBackward) PetscCall(PetscSFReduceEnd(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3565       for (p = pStart; p < pEnd; p++) {
3566         PetscInt q = p, parent;
3567 
3568         PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3569         while (parent != q) {
3570           if (values[parent] == PETSC_MIN_INT) values[parent] = values[q];
3571           q = parent;
3572           PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3573         }
3574       }
3575       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, values, values, MPI_MAX));
3576       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, values, values, MPI_MAX));
3577       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3578       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3579 
3580       for (p = pStart; p < pEnd; p++) PetscCall(DMLabelSetValue(label, p, values[p]));
3581       next = next->next;
3582     }
3583     PetscCall(PetscFree2(values, adaptValues));
3584     PetscCall(PetscSFDestroy(&transferForward));
3585     PetscCall(PetscSFDestroy(&transferBackward));
3586     pforest->labelsFinalized = PETSC_TRUE;
3587   }
3588   PetscFunctionReturn(PETSC_SUCCESS);
3589 }
3590 
3591 static PetscErrorCode DMPforestMapCoordinates_Cell(DM plex, p4est_geometry_t *geom, PetscInt cell, p4est_quadrant_t *q, p4est_topidx_t t, p4est_connectivity_t *conn, PetscScalar *coords)
3592 {
3593   PetscInt     closureSize, c, coordStart, coordEnd, coordDim;
3594   PetscInt    *closure = NULL;
3595   PetscSection coordSec;
3596 
3597   PetscFunctionBegin;
3598   PetscCall(DMGetCoordinateSection(plex, &coordSec));
3599   PetscCall(PetscSectionGetChart(coordSec, &coordStart, &coordEnd));
3600   PetscCall(DMGetCoordinateDim(plex, &coordDim));
3601   PetscCall(DMPlexGetTransitiveClosure(plex, cell, PETSC_TRUE, &closureSize, &closure));
3602   for (c = 0; c < closureSize; c++) {
3603     PetscInt point = closure[2 * c];
3604 
3605     if (point >= coordStart && point < coordEnd) {
3606       PetscInt dof, off;
3607       PetscInt nCoords, i;
3608       PetscCall(PetscSectionGetDof(coordSec, point, &dof));
3609       PetscCheck(dof % coordDim == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not understand coordinate layout");
3610       nCoords = dof / coordDim;
3611       PetscCall(PetscSectionGetOffset(coordSec, point, &off));
3612       for (i = 0; i < nCoords; i++) {
3613         PetscScalar *coord               = &coords[off + i * coordDim];
3614         double       coordP4est[3]       = {0.};
3615         double       coordP4estMapped[3] = {0.};
3616         PetscInt     j;
3617         PetscReal    treeCoords[P4EST_CHILDREN][3] = {{0.}};
3618         PetscReal    eta[3]                        = {0.};
3619         PetscInt     numRounds                     = 10;
3620         PetscReal    coordGuess[3]                 = {0.};
3621 
3622         eta[0] = (PetscReal)q->x / (PetscReal)P4EST_ROOT_LEN;
3623         eta[1] = (PetscReal)q->y / (PetscReal)P4EST_ROOT_LEN;
3624   #if defined(P4_TO_P8)
3625         eta[2] = (PetscReal)q->z / (PetscReal)P4EST_ROOT_LEN;
3626   #endif
3627 
3628         for (j = 0; j < P4EST_CHILDREN; j++) {
3629           PetscInt k;
3630 
3631           for (k = 0; k < 3; k++) treeCoords[j][k] = conn->vertices[3 * conn->tree_to_vertex[P4EST_CHILDREN * t + j] + k];
3632         }
3633 
3634         for (j = 0; j < P4EST_CHILDREN; j++) {
3635           PetscInt  k;
3636           PetscReal prod = 1.;
3637 
3638           for (k = 0; k < P4EST_DIM; k++) prod *= (j & (1 << k)) ? eta[k] : (1. - eta[k]);
3639           for (k = 0; k < 3; k++) coordGuess[k] += prod * treeCoords[j][k];
3640         }
3641 
3642         for (j = 0; j < numRounds; j++) {
3643           PetscInt dir;
3644 
3645           for (dir = 0; dir < P4EST_DIM; dir++) {
3646             PetscInt  k;
3647             PetscReal diff[3];
3648             PetscReal dXdeta[3] = {0.};
3649             PetscReal rhs, scale, update;
3650 
3651             for (k = 0; k < 3; k++) diff[k] = coordP4est[k] - coordGuess[k];
3652             for (k = 0; k < P4EST_CHILDREN; k++) {
3653               PetscInt  l;
3654               PetscReal prod = 1.;
3655 
3656               for (l = 0; l < P4EST_DIM; l++) {
3657                 if (l == dir) {
3658                   prod *= (k & (1 << l)) ? 1. : -1.;
3659                 } else {
3660                   prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]);
3661                 }
3662               }
3663               for (l = 0; l < 3; l++) dXdeta[l] += prod * treeCoords[k][l];
3664             }
3665             rhs   = 0.;
3666             scale = 0;
3667             for (k = 0; k < 3; k++) {
3668               rhs += diff[k] * dXdeta[k];
3669               scale += dXdeta[k] * dXdeta[k];
3670             }
3671             update = rhs / scale;
3672             eta[dir] += update;
3673             eta[dir] = PetscMin(eta[dir], 1.);
3674             eta[dir] = PetscMax(eta[dir], 0.);
3675 
3676             coordGuess[0] = coordGuess[1] = coordGuess[2] = 0.;
3677             for (k = 0; k < P4EST_CHILDREN; k++) {
3678               PetscInt  l;
3679               PetscReal prod = 1.;
3680 
3681               for (l = 0; l < P4EST_DIM; l++) prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]);
3682               for (l = 0; l < 3; l++) coordGuess[l] += prod * treeCoords[k][l];
3683             }
3684           }
3685         }
3686         for (j = 0; j < 3; j++) coordP4est[j] = (double)eta[j];
3687 
3688         if (geom) {
3689           (geom->X)(geom, t, coordP4est, coordP4estMapped);
3690           for (j = 0; j < coordDim; j++) coord[j] = (PetscScalar)coordP4estMapped[j];
3691         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not coded");
3692       }
3693     }
3694   }
3695   PetscCall(DMPlexRestoreTransitiveClosure(plex, cell, PETSC_TRUE, &closureSize, &closure));
3696   PetscFunctionReturn(PETSC_SUCCESS);
3697 }
3698 
3699 static PetscErrorCode DMPforestMapCoordinates(DM dm, DM plex)
3700 {
3701   DM_Forest         *forest;
3702   DM_Forest_pforest *pforest;
3703   p4est_geometry_t  *geom;
3704   PetscInt           cLocalStart, cLocalEnd;
3705   Vec                coordLocalVec;
3706   PetscScalar       *coords;
3707   p4est_topidx_t     flt, llt, t;
3708   p4est_tree_t      *trees;
3709   PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
3710   void *mapCtx;
3711 
3712   PetscFunctionBegin;
3713   forest  = (DM_Forest *)dm->data;
3714   pforest = (DM_Forest_pforest *)forest->data;
3715   geom    = pforest->topo->geom;
3716   PetscCall(DMForestGetBaseCoordinateMapping(dm, &map, &mapCtx));
3717   if (!geom && !map) PetscFunctionReturn(PETSC_SUCCESS);
3718   PetscCall(DMGetCoordinatesLocal(plex, &coordLocalVec));
3719   PetscCall(VecGetArray(coordLocalVec, &coords));
3720   cLocalStart = pforest->cLocalStart;
3721   cLocalEnd   = pforest->cLocalEnd;
3722   flt         = pforest->forest->first_local_tree;
3723   llt         = pforest->forest->last_local_tree;
3724   trees       = (p4est_tree_t *)pforest->forest->trees->array;
3725   if (map) { /* apply the map directly to the existing coordinates */
3726     PetscSection coordSec;
3727     PetscInt     coordStart, coordEnd, p, coordDim, p4estCoordDim, cStart, cEnd, cEndInterior;
3728     DM           base;
3729 
3730     PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3731     PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3732     cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3733     PetscCall(DMForestGetBaseDM(dm, &base));
3734     PetscCall(DMGetCoordinateSection(plex, &coordSec));
3735     PetscCall(PetscSectionGetChart(coordSec, &coordStart, &coordEnd));
3736     PetscCall(DMGetCoordinateDim(plex, &coordDim));
3737     p4estCoordDim = PetscMin(coordDim, 3);
3738     for (p = coordStart; p < coordEnd; p++) {
3739       PetscInt *star = NULL, starSize;
3740       PetscInt  dof, off, cell = -1, coarsePoint = -1;
3741       PetscInt  nCoords, i;
3742       PetscCall(PetscSectionGetDof(coordSec, p, &dof));
3743       PetscCheck(dof % coordDim == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not understand coordinate layout");
3744       nCoords = dof / coordDim;
3745       PetscCall(PetscSectionGetOffset(coordSec, p, &off));
3746       PetscCall(DMPlexGetTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3747       for (i = 0; i < starSize; i++) {
3748         PetscInt point = star[2 * i];
3749 
3750         if (cStart <= point && point < cEnd) {
3751           cell = point;
3752           break;
3753         }
3754       }
3755       PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3756       if (cell >= 0) {
3757         if (cell < cLocalStart) {
3758           p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3759 
3760           coarsePoint = ghosts[cell].p.which_tree;
3761         } else if (cell < cLocalEnd) {
3762           cell -= cLocalStart;
3763           for (t = flt; t <= llt; t++) {
3764             p4est_tree_t *tree = &(trees[t]);
3765 
3766             if (cell >= tree->quadrants_offset && (size_t)cell < tree->quadrants_offset + tree->quadrants.elem_count) {
3767               coarsePoint = t;
3768               break;
3769             }
3770           }
3771         } else {
3772           p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3773 
3774           coarsePoint = ghosts[cell - cLocalEnd].p.which_tree;
3775         }
3776       }
3777       for (i = 0; i < nCoords; i++) {
3778         PetscScalar *coord               = &coords[off + i * coordDim];
3779         PetscReal    coordP4est[3]       = {0.};
3780         PetscReal    coordP4estMapped[3] = {0.};
3781         PetscInt     j;
3782 
3783         for (j = 0; j < p4estCoordDim; j++) coordP4est[j] = PetscRealPart(coord[j]);
3784         PetscCall((map)(base, coarsePoint, p4estCoordDim, coordP4est, coordP4estMapped, mapCtx));
3785         for (j = 0; j < p4estCoordDim; j++) coord[j] = (PetscScalar)coordP4estMapped[j];
3786       }
3787     }
3788   } else { /* we have to transform coordinates back to the unit cube (where geom is defined), and then apply geom */
3789     PetscInt cStart, cEnd, cEndInterior;
3790 
3791     PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3792     PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3793     cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3794     if (cLocalStart > 0) {
3795       p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3796       PetscInt          count;
3797 
3798       for (count = 0; count < cLocalStart; count++) {
3799         p4est_quadrant_t *quad = &ghosts[count];
3800         p4est_topidx_t    t    = quad->p.which_tree;
3801 
3802         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count, quad, t, pforest->topo->conn, coords));
3803       }
3804     }
3805     for (t = flt; t <= llt; t++) {
3806       p4est_tree_t     *tree     = &(trees[t]);
3807       PetscInt          offset   = cLocalStart + tree->quadrants_offset, i;
3808       PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
3809       p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
3810 
3811       for (i = 0; i < numQuads; i++) {
3812         PetscInt count = i + offset;
3813 
3814         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count, &quads[i], t, pforest->topo->conn, coords));
3815       }
3816     }
3817     if (cLocalEnd - cLocalStart < cEnd - cStart) {
3818       p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3819       PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
3820       PetscInt          count;
3821 
3822       for (count = 0; count < numGhosts - cLocalStart; count++) {
3823         p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
3824         p4est_topidx_t    t    = quad->p.which_tree;
3825 
3826         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count + cLocalEnd, quad, t, pforest->topo->conn, coords));
3827       }
3828     }
3829   }
3830   PetscCall(VecRestoreArray(coordLocalVec, &coords));
3831   PetscFunctionReturn(PETSC_SUCCESS);
3832 }
3833 
3834 static PetscErrorCode PforestQuadrantIsInterior(p4est_quadrant_t *quad, PetscBool *is_interior)
3835 {
3836   PetscFunctionBegin;
3837   p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3838   if ((quad->x > 0) && (quad->x + h < P4EST_ROOT_LEN)
3839   #ifdef P4_TO_P8
3840       && (quad->z > 0) && (quad->z + h < P4EST_ROOT_LEN)
3841   #endif
3842       && (quad->y > 0) && (quad->y + h < P4EST_ROOT_LEN)) {
3843     *is_interior = PETSC_TRUE;
3844   } else {
3845     *is_interior = PETSC_FALSE;
3846   }
3847   PetscFunctionReturn(PETSC_SUCCESS);
3848 }
3849 
3850 /* We always use DG coordinates with p4est: if they do not match the vertex
3851    coordinates, add space for them in the section */
3852 static PetscErrorCode PforestCheckLocalizeCell(DM plex, PetscInt cDim, Vec cVecOld, DM_Forest_pforest *pforest, PetscSection oldSection, PetscSection newSection, PetscInt cell, PetscInt coarsePoint, p4est_quadrant_t *quad)
3853 {
3854   PetscBool is_interior;
3855 
3856   PetscFunctionBegin;
3857   PetscCall(PforestQuadrantIsInterior(quad, &is_interior));
3858   if (is_interior) { // quads in the interior of a coarse cell can't touch periodic interfaces
3859     PetscCall(PetscSectionSetDof(newSection, cell, 0));
3860     PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, 0));
3861   } else {
3862     PetscInt     cSize;
3863     PetscScalar *values      = NULL;
3864     PetscBool    same_coords = PETSC_TRUE;
3865 
3866     PetscCall(DMPlexVecGetClosure(plex, oldSection, cVecOld, cell, &cSize, &values));
3867     PetscAssert(cSize == cDim * P4EST_CHILDREN, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unexpected closure size");
3868     for (int c = 0; c < P4EST_CHILDREN; c++) {
3869       p4est_qcoord_t quad_coords[3];
3870       p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3871       double         corner_coords[3];
3872       double         vert_coords[3];
3873       PetscInt       corner = PetscVertToP4estVert[c];
3874 
3875       for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) vert_coords[d] = PetscRealPart(values[c * cDim + d]);
3876 
3877       quad_coords[0] = quad->x;
3878       quad_coords[1] = quad->y;
3879   #ifdef P4_TO_P8
3880       quad_coords[2] = quad->z;
3881   #endif
3882       for (int d = 0; d < 3; d++) quad_coords[d] += (corner & (1 << d)) ? h : 0;
3883   #ifndef P4_TO_P8
3884       PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], corner_coords));
3885   #else
3886       PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], quad_coords[2], corner_coords));
3887   #endif
3888       for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) {
3889         if (fabs(vert_coords[d] - corner_coords[d]) > PETSC_SMALL) {
3890           same_coords = PETSC_FALSE;
3891           break;
3892         }
3893       }
3894     }
3895     if (same_coords) {
3896       PetscCall(PetscSectionSetDof(newSection, cell, 0));
3897       PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, 0));
3898     } else {
3899       PetscCall(PetscSectionSetDof(newSection, cell, cSize));
3900       PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, cSize));
3901     }
3902     PetscCall(DMPlexVecRestoreClosure(plex, oldSection, cVecOld, cell, &cSize, &values));
3903   }
3904   PetscFunctionReturn(PETSC_SUCCESS);
3905 }
3906 
3907 static PetscErrorCode PforestLocalizeCell(DM plex, PetscInt cDim, DM_Forest_pforest *pforest, PetscSection newSection, PetscInt cell, PetscInt coarsePoint, p4est_quadrant_t *quad, PetscScalar coords[])
3908 {
3909   PetscInt cdof, off;
3910 
3911   PetscFunctionBegin;
3912   PetscCall(PetscSectionGetDof(newSection, cell, &cdof));
3913   if (!cdof) PetscFunctionReturn(PETSC_SUCCESS);
3914 
3915   PetscCall(PetscSectionGetOffset(newSection, cell, &off));
3916   for (PetscInt c = 0, pos = off; c < P4EST_CHILDREN; c++) {
3917     p4est_qcoord_t quad_coords[3];
3918     p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3919     double         corner_coords[3];
3920     PetscInt       corner = PetscVertToP4estVert[c];
3921 
3922     quad_coords[0] = quad->x;
3923     quad_coords[1] = quad->y;
3924   #ifdef P4_TO_P8
3925     quad_coords[2] = quad->z;
3926   #endif
3927     for (int d = 0; d < 3; d++) quad_coords[d] += (corner & (1 << d)) ? h : 0;
3928   #ifndef P4_TO_P8
3929     PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], corner_coords));
3930   #else
3931     PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], quad_coords[2], corner_coords));
3932   #endif
3933     for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) coords[pos++] = corner_coords[d];
3934     for (PetscInt d = PetscMin(cDim, 3); d < cDim; d++) coords[pos++] = 0.;
3935   }
3936   PetscFunctionReturn(PETSC_SUCCESS);
3937 }
3938 
3939 static PetscErrorCode DMPforestLocalizeCoordinates(DM dm, DM plex)
3940 {
3941   DM_Forest         *forest;
3942   DM_Forest_pforest *pforest;
3943   DM                 base, cdm, cdmCell;
3944   Vec                cVec, cVecOld;
3945   PetscSection       oldSection, newSection;
3946   PetscScalar       *coords2;
3947   const PetscReal   *L;
3948   PetscInt           cLocalStart, cLocalEnd, coarsePoint;
3949   PetscInt           cDim, newStart, newEnd;
3950   PetscInt           v, vStart, vEnd, cp, cStart, cEnd, cEndInterior;
3951   p4est_topidx_t     flt, llt, t;
3952   p4est_tree_t      *trees;
3953   PetscBool          baseLocalized = PETSC_FALSE;
3954 
3955   PetscFunctionBegin;
3956   PetscCall(DMGetPeriodicity(dm, NULL, NULL, &L));
3957   /* we localize on all cells if we don't have a base DM or the base DM coordinates have not been localized */
3958   PetscCall(DMGetCoordinateDim(dm, &cDim));
3959   PetscCall(DMForestGetBaseDM(dm, &base));
3960   if (base) PetscCall(DMGetCoordinatesLocalized(base, &baseLocalized));
3961   if (!baseLocalized) base = NULL;
3962   if (!baseLocalized && !L) PetscFunctionReturn(PETSC_SUCCESS);
3963   PetscCall(DMPlexGetChart(plex, &newStart, &newEnd));
3964 
3965   PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dm), &newSection));
3966   PetscCall(PetscSectionSetNumFields(newSection, 1));
3967   PetscCall(PetscSectionSetFieldComponents(newSection, 0, cDim));
3968   PetscCall(PetscSectionSetChart(newSection, newStart, newEnd));
3969 
3970   PetscCall(DMGetCoordinateSection(plex, &oldSection));
3971   PetscCall(DMPlexGetDepthStratum(plex, 0, &vStart, &vEnd));
3972   PetscCall(DMGetCoordinatesLocal(plex, &cVecOld));
3973 
3974   forest      = (DM_Forest *)dm->data;
3975   pforest     = (DM_Forest_pforest *)forest->data;
3976   cLocalStart = pforest->cLocalStart;
3977   cLocalEnd   = pforest->cLocalEnd;
3978   flt         = pforest->forest->first_local_tree;
3979   llt         = pforest->forest->last_local_tree;
3980   trees       = (p4est_tree_t *)pforest->forest->trees->array;
3981 
3982   PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3983   PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3984   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3985   cp   = 0;
3986   if (cLocalStart > 0) {
3987     p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3988     PetscInt          cell;
3989 
3990     for (cell = 0; cell < cLocalStart; ++cell, cp++) {
3991       p4est_quadrant_t *quad = &ghosts[cell];
3992 
3993       coarsePoint = quad->p.which_tree;
3994       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
3995     }
3996   }
3997   for (t = flt; t <= llt; t++) {
3998     p4est_tree_t     *tree     = &(trees[t]);
3999     PetscInt          offset   = cLocalStart + tree->quadrants_offset;
4000     PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
4001     p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
4002     PetscInt          i;
4003 
4004     if (!numQuads) continue;
4005     coarsePoint = t;
4006     for (i = 0; i < numQuads; i++, cp++) {
4007       PetscInt          cell = i + offset;
4008       p4est_quadrant_t *quad = &quads[i];
4009 
4010       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
4011     }
4012   }
4013   if (cLocalEnd - cLocalStart < cEnd - cStart) {
4014     p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4015     PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
4016     PetscInt          count;
4017 
4018     for (count = 0; count < numGhosts - cLocalStart; count++, cp++) {
4019       p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
4020       coarsePoint            = quad->p.which_tree;
4021       PetscInt cell          = count + cLocalEnd;
4022 
4023       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
4024     }
4025   }
4026   PetscAssert(cp == cEnd - cStart, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unexpected number of fine cells %" PetscInt_FMT " != %" PetscInt_FMT, cp, cEnd - cStart);
4027 
4028   PetscCall(PetscSectionSetUp(newSection));
4029   PetscCall(DMGetCoordinateDM(plex, &cdm));
4030   PetscCall(DMClone(cdm, &cdmCell));
4031   PetscCall(DMSetCellCoordinateDM(plex, cdmCell));
4032   PetscCall(DMDestroy(&cdmCell));
4033   PetscCall(DMSetCellCoordinateSection(plex, cDim, newSection));
4034   PetscCall(PetscSectionGetStorageSize(newSection, &v));
4035   PetscCall(VecCreate(PETSC_COMM_SELF, &cVec));
4036   PetscCall(PetscObjectSetName((PetscObject)cVec, "coordinates"));
4037   PetscCall(VecSetBlockSize(cVec, cDim));
4038   PetscCall(VecSetSizes(cVec, v, PETSC_DETERMINE));
4039   PetscCall(VecSetType(cVec, VECSTANDARD));
4040   PetscCall(VecSet(cVec, PETSC_MIN_REAL));
4041 
4042   /* Localize coordinates on cells if needed */
4043   PetscCall(VecGetArray(cVec, &coords2));
4044   cp = 0;
4045   if (cLocalStart > 0) {
4046     p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4047     PetscInt          cell;
4048 
4049     for (cell = 0; cell < cLocalStart; ++cell, cp++) {
4050       p4est_quadrant_t *quad = &ghosts[cell];
4051 
4052       coarsePoint = quad->p.which_tree;
4053       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4054     }
4055   }
4056   for (t = flt; t <= llt; t++) {
4057     p4est_tree_t     *tree     = &(trees[t]);
4058     PetscInt          offset   = cLocalStart + tree->quadrants_offset;
4059     PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
4060     p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
4061     PetscInt          i;
4062 
4063     if (!numQuads) continue;
4064     coarsePoint = t;
4065     for (i = 0; i < numQuads; i++, cp++) {
4066       PetscInt          cell = i + offset;
4067       p4est_quadrant_t *quad = &quads[i];
4068 
4069       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4070     }
4071   }
4072   if (cLocalEnd - cLocalStart < cEnd - cStart) {
4073     p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4074     PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
4075     PetscInt          count;
4076 
4077     for (count = 0; count < numGhosts - cLocalStart; count++, cp++) {
4078       p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
4079       coarsePoint            = quad->p.which_tree;
4080       PetscInt cell          = count + cLocalEnd;
4081 
4082       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4083     }
4084   }
4085   PetscCall(VecRestoreArray(cVec, &coords2));
4086   PetscCall(DMSetCellCoordinatesLocal(plex, cVec));
4087   PetscCall(VecDestroy(&cVec));
4088   PetscCall(PetscSectionDestroy(&newSection));
4089   PetscFunctionReturn(PETSC_SUCCESS);
4090 }
4091 
4092   #define DMForestClearAdaptivityForest_pforest _append_pforest(DMForestClearAdaptivityForest)
4093 static PetscErrorCode DMForestClearAdaptivityForest_pforest(DM dm)
4094 {
4095   DM_Forest         *forest;
4096   DM_Forest_pforest *pforest;
4097 
4098   PetscFunctionBegin;
4099   forest  = (DM_Forest *)dm->data;
4100   pforest = (DM_Forest_pforest *)forest->data;
4101   PetscCall(PetscSFDestroy(&(pforest->pointAdaptToSelfSF)));
4102   PetscCall(PetscSFDestroy(&(pforest->pointSelfToAdaptSF)));
4103   PetscCall(PetscFree(pforest->pointAdaptToSelfCids));
4104   PetscCall(PetscFree(pforest->pointSelfToAdaptCids));
4105   PetscFunctionReturn(PETSC_SUCCESS);
4106 }
4107 
4108 static PetscErrorCode DMConvert_pforest_plex(DM dm, DMType newtype, DM *plex)
4109 {
4110   DM_Forest           *forest;
4111   DM_Forest_pforest   *pforest;
4112   DM                   refTree, newPlex, base;
4113   PetscInt             adjDim, adjCodim, coordDim;
4114   MPI_Comm             comm;
4115   PetscBool            isPforest;
4116   PetscInt             dim;
4117   PetscInt             overlap;
4118   p4est_connect_type_t ctype;
4119   p4est_locidx_t       first_local_quad = -1;
4120   sc_array_t          *points_per_dim, *cone_sizes, *cones, *cone_orientations, *coords, *children, *parents, *childids, *leaves, *remotes;
4121   PetscSection         parentSection;
4122   PetscSF              pointSF;
4123   size_t               zz, count;
4124   PetscInt             pStart, pEnd;
4125   DMLabel              ghostLabelBase = NULL;
4126 
4127   PetscFunctionBegin;
4128 
4129   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4130   comm = PetscObjectComm((PetscObject)dm);
4131   PetscCall(PetscObjectTypeCompare((PetscObject)dm, DMPFOREST, &isPforest));
4132   PetscCheck(isPforest, comm, PETSC_ERR_ARG_WRONG, "Expected DM type %s, got %s", DMPFOREST, ((PetscObject)dm)->type_name);
4133   PetscCall(DMGetDimension(dm, &dim));
4134   PetscCheck(dim == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Expected DM dimension %d, got %" PetscInt_FMT, P4EST_DIM, dim);
4135   forest  = (DM_Forest *)dm->data;
4136   pforest = (DM_Forest_pforest *)forest->data;
4137   PetscCall(DMForestGetBaseDM(dm, &base));
4138   if (base) PetscCall(DMGetLabel(base, "ghost", &ghostLabelBase));
4139   if (!pforest->plex) {
4140     PetscMPIInt size;
4141 
4142     PetscCallMPI(MPI_Comm_size(comm, &size));
4143     PetscCall(DMCreate(comm, &newPlex));
4144     PetscCall(DMSetType(newPlex, DMPLEX));
4145     PetscCall(DMSetMatType(newPlex, dm->mattype));
4146     /* share labels */
4147     PetscCall(DMCopyLabels(dm, newPlex, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL));
4148     PetscCall(DMForestGetAdjacencyDimension(dm, &adjDim));
4149     PetscCall(DMForestGetAdjacencyCodimension(dm, &adjCodim));
4150     PetscCall(DMGetCoordinateDim(dm, &coordDim));
4151     if (adjDim == 0) {
4152       ctype = P4EST_CONNECT_FULL;
4153     } else if (adjCodim == 1) {
4154       ctype = P4EST_CONNECT_FACE;
4155   #if defined(P4_TO_P8)
4156     } else if (adjDim == 1) {
4157       ctype = P8EST_CONNECT_EDGE;
4158   #endif
4159     } else {
4160       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid adjacency dimension %" PetscInt_FMT, adjDim);
4161     }
4162     PetscCheck(ctype == P4EST_CONNECT_FULL, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Adjacency dimension %" PetscInt_FMT " / codimension %" PetscInt_FMT " not supported yet", adjDim, adjCodim);
4163     PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
4164     PetscCall(DMPlexSetOverlap_Plex(newPlex, NULL, overlap));
4165 
4166     points_per_dim    = sc_array_new(sizeof(p4est_locidx_t));
4167     cone_sizes        = sc_array_new(sizeof(p4est_locidx_t));
4168     cones             = sc_array_new(sizeof(p4est_locidx_t));
4169     cone_orientations = sc_array_new(sizeof(p4est_locidx_t));
4170     coords            = sc_array_new(3 * sizeof(double));
4171     children          = sc_array_new(sizeof(p4est_locidx_t));
4172     parents           = sc_array_new(sizeof(p4est_locidx_t));
4173     childids          = sc_array_new(sizeof(p4est_locidx_t));
4174     leaves            = sc_array_new(sizeof(p4est_locidx_t));
4175     remotes           = sc_array_new(2 * sizeof(p4est_locidx_t));
4176 
4177     PetscCallP4est(p4est_get_plex_data_ext, (pforest->forest, &pforest->ghost, &pforest->lnodes, ctype, (int)((size > 1) ? overlap : 0), &first_local_quad, points_per_dim, cone_sizes, cones, cone_orientations, coords, children, parents, childids, leaves, remotes, 1));
4178 
4179     pforest->cLocalStart = (PetscInt)first_local_quad;
4180     pforest->cLocalEnd   = pforest->cLocalStart + (PetscInt)pforest->forest->local_num_quadrants;
4181     PetscCall(locidx_to_PetscInt(points_per_dim));
4182     PetscCall(locidx_to_PetscInt(cone_sizes));
4183     PetscCall(locidx_to_PetscInt(cones));
4184     PetscCall(locidx_to_PetscInt(cone_orientations));
4185     PetscCall(coords_double_to_PetscScalar(coords, coordDim));
4186     PetscCall(locidx_to_PetscInt(children));
4187     PetscCall(locidx_to_PetscInt(parents));
4188     PetscCall(locidx_to_PetscInt(childids));
4189     PetscCall(locidx_to_PetscInt(leaves));
4190     PetscCall(locidx_pair_to_PetscSFNode(remotes));
4191 
4192     PetscCall(DMSetDimension(newPlex, P4EST_DIM));
4193     PetscCall(DMSetCoordinateDim(newPlex, coordDim));
4194     PetscCall(DMPlexSetMaxProjectionHeight(newPlex, P4EST_DIM - 1));
4195     PetscCall(DMPlexCreateFromDAG(newPlex, P4EST_DIM, (PetscInt *)points_per_dim->array, (PetscInt *)cone_sizes->array, (PetscInt *)cones->array, (PetscInt *)cone_orientations->array, (PetscScalar *)coords->array));
4196     PetscCall(DMPlexConvertOldOrientations_Internal(newPlex));
4197     PetscCall(DMCreateReferenceTree_pforest(comm, &refTree));
4198     PetscCall(DMPlexSetReferenceTree(newPlex, refTree));
4199     PetscCall(PetscSectionCreate(comm, &parentSection));
4200     PetscCall(DMPlexGetChart(newPlex, &pStart, &pEnd));
4201     PetscCall(PetscSectionSetChart(parentSection, pStart, pEnd));
4202     count = children->elem_count;
4203     for (zz = 0; zz < count; zz++) {
4204       PetscInt child = *((PetscInt *)sc_array_index(children, zz));
4205 
4206       PetscCall(PetscSectionSetDof(parentSection, child, 1));
4207     }
4208     PetscCall(PetscSectionSetUp(parentSection));
4209     PetscCall(DMPlexSetTree(newPlex, parentSection, (PetscInt *)parents->array, (PetscInt *)childids->array));
4210     PetscCall(PetscSectionDestroy(&parentSection));
4211     PetscCall(PetscSFCreate(comm, &pointSF));
4212     /*
4213        These arrays defining the sf are from the p4est library, but the code there shows the leaves being populated in increasing order.
4214        https://gitlab.com/petsc/petsc/merge_requests/2248#note_240186391
4215     */
4216     PetscCall(PetscSFSetGraph(pointSF, pEnd - pStart, (PetscInt)leaves->elem_count, (PetscInt *)leaves->array, PETSC_COPY_VALUES, (PetscSFNode *)remotes->array, PETSC_COPY_VALUES));
4217     PetscCall(DMSetPointSF(newPlex, pointSF));
4218     PetscCall(DMSetPointSF(dm, pointSF));
4219     {
4220       DM coordDM;
4221 
4222       PetscCall(DMGetCoordinateDM(newPlex, &coordDM));
4223       PetscCall(DMSetPointSF(coordDM, pointSF));
4224     }
4225     PetscCall(PetscSFDestroy(&pointSF));
4226     sc_array_destroy(points_per_dim);
4227     sc_array_destroy(cone_sizes);
4228     sc_array_destroy(cones);
4229     sc_array_destroy(cone_orientations);
4230     sc_array_destroy(coords);
4231     sc_array_destroy(children);
4232     sc_array_destroy(parents);
4233     sc_array_destroy(childids);
4234     sc_array_destroy(leaves);
4235     sc_array_destroy(remotes);
4236 
4237     {
4238       const PetscReal *maxCell, *Lstart, *L;
4239 
4240       PetscCall(DMGetPeriodicity(dm, &maxCell, &Lstart, &L));
4241       PetscCall(DMSetPeriodicity(newPlex, maxCell, Lstart, L));
4242       PetscCall(DMPforestLocalizeCoordinates(dm, newPlex));
4243     }
4244 
4245     if (overlap > 0) { /* the p4est routine can't set all of the coordinates in its routine if there is overlap */
4246       Vec                coordsGlobal, coordsLocal;
4247       const PetscScalar *globalArray;
4248       PetscScalar       *localArray;
4249       PetscSF            coordSF;
4250       DM                 coordDM;
4251 
4252       PetscCall(DMGetCoordinateDM(newPlex, &coordDM));
4253       PetscCall(DMGetSectionSF(coordDM, &coordSF));
4254       PetscCall(DMGetCoordinates(newPlex, &coordsGlobal));
4255       PetscCall(DMGetCoordinatesLocal(newPlex, &coordsLocal));
4256       PetscCall(VecGetArrayRead(coordsGlobal, &globalArray));
4257       PetscCall(VecGetArray(coordsLocal, &localArray));
4258       PetscCall(PetscSFBcastBegin(coordSF, MPIU_SCALAR, globalArray, localArray, MPI_REPLACE));
4259       PetscCall(PetscSFBcastEnd(coordSF, MPIU_SCALAR, globalArray, localArray, MPI_REPLACE));
4260       PetscCall(VecRestoreArray(coordsLocal, &localArray));
4261       PetscCall(VecRestoreArrayRead(coordsGlobal, &globalArray));
4262       PetscCall(DMSetCoordinatesLocal(newPlex, coordsLocal));
4263     }
4264     PetscCall(DMPforestMapCoordinates(dm, newPlex));
4265 
4266     pforest->plex = newPlex;
4267 
4268     /* copy labels */
4269     PetscCall(DMPforestLabelsFinalize(dm, newPlex));
4270 
4271     if (ghostLabelBase || pforest->ghostName) { /* we have to do this after copying labels because the labels drive the construction of ghost cells */
4272       PetscInt numAdded;
4273       DM       newPlexGhosted;
4274       void    *ctx;
4275 
4276       PetscCall(DMPlexConstructGhostCells(newPlex, pforest->ghostName, &numAdded, &newPlexGhosted));
4277       PetscCall(DMGetApplicationContext(newPlex, &ctx));
4278       PetscCall(DMSetApplicationContext(newPlexGhosted, ctx));
4279       /* we want the sf for the ghost dm to be the one for the p4est dm as well */
4280       PetscCall(DMGetPointSF(newPlexGhosted, &pointSF));
4281       PetscCall(DMSetPointSF(dm, pointSF));
4282       PetscCall(DMDestroy(&newPlex));
4283       PetscCall(DMPlexSetReferenceTree(newPlexGhosted, refTree));
4284       PetscCall(DMForestClearAdaptivityForest_pforest(dm));
4285       newPlex = newPlexGhosted;
4286 
4287       /* share the labels back */
4288       PetscCall(DMDestroyLabelLinkList_Internal(dm));
4289       PetscCall(DMCopyLabels(newPlex, dm, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL));
4290       pforest->plex = newPlex;
4291     }
4292     PetscCall(DMDestroy(&refTree));
4293     if (dm->setfromoptionscalled) {
4294       PetscObjectOptionsBegin((PetscObject)newPlex);
4295       PetscCall(DMSetFromOptions_NonRefinement_Plex(newPlex, PetscOptionsObject));
4296       PetscCall(PetscObjectProcessOptionsHandlers((PetscObject)newPlex, PetscOptionsObject));
4297       PetscOptionsEnd();
4298     }
4299     PetscCall(DMViewFromOptions(newPlex, NULL, "-dm_p4est_plex_view"));
4300     {
4301       DM           cdm;
4302       PetscSection coordsSec;
4303       Vec          coords;
4304       PetscInt     cDim;
4305 
4306       PetscCall(DMGetCoordinateDim(newPlex, &cDim));
4307       PetscCall(DMGetCoordinateSection(newPlex, &coordsSec));
4308       PetscCall(DMSetCoordinateSection(dm, cDim, coordsSec));
4309       PetscCall(DMGetCoordinatesLocal(newPlex, &coords));
4310       PetscCall(DMSetCoordinatesLocal(dm, coords));
4311       PetscCall(DMGetCellCoordinateDM(newPlex, &cdm));
4312       if (cdm) PetscCall(DMSetCellCoordinateDM(dm, cdm));
4313       PetscCall(DMGetCellCoordinateSection(newPlex, &coordsSec));
4314       if (coordsSec) PetscCall(DMSetCellCoordinateSection(dm, cDim, coordsSec));
4315       PetscCall(DMGetCellCoordinatesLocal(newPlex, &coords));
4316       if (coords) PetscCall(DMSetCellCoordinatesLocal(dm, coords));
4317     }
4318   }
4319   newPlex = pforest->plex;
4320   if (plex) {
4321     PetscCall(DMClone(newPlex, plex));
4322   #if 0
4323     PetscCall(DMGetCoordinateDM(newPlex,&coordDM));
4324     PetscCall(DMSetCoordinateDM(*plex,coordDM));
4325     PetscCall(DMGetCellCoordinateDM(newPlex,&coordDM));
4326     PetscCall(DMSetCellCoordinateDM(*plex,coordDM));
4327   #endif
4328     PetscCall(DMShareDiscretization(dm, *plex));
4329   }
4330   PetscFunctionReturn(PETSC_SUCCESS);
4331 }
4332 
4333 static PetscErrorCode DMSetFromOptions_pforest(DM dm, PetscOptionItems *PetscOptionsObject)
4334 {
4335   DM_Forest_pforest *pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4336   char               stringBuffer[256];
4337   PetscBool          flg;
4338 
4339   PetscFunctionBegin;
4340   PetscCall(DMSetFromOptions_Forest(dm, PetscOptionsObject));
4341   PetscOptionsHeadBegin(PetscOptionsObject, "DM" P4EST_STRING " options");
4342   PetscCall(PetscOptionsBool("-dm_p4est_partition_for_coarsening", "partition forest to allow for coarsening", "DMP4estSetPartitionForCoarsening", pforest->partition_for_coarsening, &(pforest->partition_for_coarsening), NULL));
4343   PetscCall(PetscOptionsString("-dm_p4est_ghost_label_name", "the name of the ghost label when converting from a DMPlex", NULL, NULL, stringBuffer, sizeof(stringBuffer), &flg));
4344   PetscOptionsHeadEnd();
4345   if (flg) {
4346     PetscCall(PetscFree(pforest->ghostName));
4347     PetscCall(PetscStrallocpy(stringBuffer, &pforest->ghostName));
4348   }
4349   PetscFunctionReturn(PETSC_SUCCESS);
4350 }
4351 
4352   #if !defined(P4_TO_P8)
4353     #define DMPforestGetPartitionForCoarsening DMP4estGetPartitionForCoarsening
4354     #define DMPforestSetPartitionForCoarsening DMP4estSetPartitionForCoarsening
4355   #else
4356     #define DMPforestGetPartitionForCoarsening DMP8estGetPartitionForCoarsening
4357     #define DMPforestSetPartitionForCoarsening DMP8estSetPartitionForCoarsening
4358   #endif
4359 
4360 PETSC_EXTERN PetscErrorCode DMPforestGetPartitionForCoarsening(DM dm, PetscBool *flg)
4361 {
4362   DM_Forest_pforest *pforest;
4363 
4364   PetscFunctionBegin;
4365   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4366   pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4367   *flg    = pforest->partition_for_coarsening;
4368   PetscFunctionReturn(PETSC_SUCCESS);
4369 }
4370 
4371 PETSC_EXTERN PetscErrorCode DMPforestSetPartitionForCoarsening(DM dm, PetscBool flg)
4372 {
4373   DM_Forest_pforest *pforest;
4374 
4375   PetscFunctionBegin;
4376   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4377   pforest                           = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4378   pforest->partition_for_coarsening = flg;
4379   PetscFunctionReturn(PETSC_SUCCESS);
4380 }
4381 
4382 static PetscErrorCode DMPforestGetPlex(DM dm, DM *plex)
4383 {
4384   DM_Forest_pforest *pforest;
4385 
4386   PetscFunctionBegin;
4387   if (plex) *plex = NULL;
4388   PetscCall(DMSetUp(dm));
4389   pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4390   if (!pforest->plex) PetscCall(DMConvert_pforest_plex(dm, DMPLEX, NULL));
4391   PetscCall(DMShareDiscretization(dm, pforest->plex));
4392   if (plex) *plex = pforest->plex;
4393   PetscFunctionReturn(PETSC_SUCCESS);
4394 }
4395 
4396   #define DMCreateInterpolation_pforest _append_pforest(DMCreateInterpolation)
4397 static PetscErrorCode DMCreateInterpolation_pforest(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
4398 {
4399   PetscSection gsc, gsf;
4400   PetscInt     m, n;
4401   DM           cdm;
4402 
4403   PetscFunctionBegin;
4404   PetscCall(DMGetGlobalSection(dmFine, &gsf));
4405   PetscCall(PetscSectionGetConstrainedStorageSize(gsf, &m));
4406   PetscCall(DMGetGlobalSection(dmCoarse, &gsc));
4407   PetscCall(PetscSectionGetConstrainedStorageSize(gsc, &n));
4408 
4409   PetscCall(MatCreate(PetscObjectComm((PetscObject)dmFine), interpolation));
4410   PetscCall(MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE));
4411   PetscCall(MatSetType(*interpolation, MATAIJ));
4412 
4413   PetscCall(DMGetCoarseDM(dmFine, &cdm));
4414   PetscCheck(cdm == dmCoarse, PetscObjectComm((PetscObject)dmFine), PETSC_ERR_SUP, "Only interpolation from coarse DM for now");
4415 
4416   {
4417     DM        plexF, plexC;
4418     PetscSF   sf;
4419     PetscInt *cids;
4420     PetscInt  dofPerDim[4] = {1, 1, 1, 1};
4421 
4422     PetscCall(DMPforestGetPlex(dmCoarse, &plexC));
4423     PetscCall(DMPforestGetPlex(dmFine, &plexF));
4424     PetscCall(DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids));
4425     PetscCall(PetscSFSetUp(sf));
4426     PetscCall(DMPlexComputeInterpolatorTree(plexC, plexF, sf, cids, *interpolation));
4427     PetscCall(PetscSFDestroy(&sf));
4428     PetscCall(PetscFree(cids));
4429   }
4430   PetscCall(MatViewFromOptions(*interpolation, NULL, "-interp_mat_view"));
4431   /* Use naive scaling */
4432   PetscCall(DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling));
4433   PetscFunctionReturn(PETSC_SUCCESS);
4434 }
4435 
4436   #define DMCreateInjection_pforest _append_pforest(DMCreateInjection)
4437 static PetscErrorCode DMCreateInjection_pforest(DM dmCoarse, DM dmFine, Mat *injection)
4438 {
4439   PetscSection gsc, gsf;
4440   PetscInt     m, n;
4441   DM           cdm;
4442 
4443   PetscFunctionBegin;
4444   PetscCall(DMGetGlobalSection(dmFine, &gsf));
4445   PetscCall(PetscSectionGetConstrainedStorageSize(gsf, &n));
4446   PetscCall(DMGetGlobalSection(dmCoarse, &gsc));
4447   PetscCall(PetscSectionGetConstrainedStorageSize(gsc, &m));
4448 
4449   PetscCall(MatCreate(PetscObjectComm((PetscObject)dmFine), injection));
4450   PetscCall(MatSetSizes(*injection, m, n, PETSC_DETERMINE, PETSC_DETERMINE));
4451   PetscCall(MatSetType(*injection, MATAIJ));
4452 
4453   PetscCall(DMGetCoarseDM(dmFine, &cdm));
4454   PetscCheck(cdm == dmCoarse, PetscObjectComm((PetscObject)dmFine), PETSC_ERR_SUP, "Only injection to coarse DM for now");
4455 
4456   {
4457     DM        plexF, plexC;
4458     PetscSF   sf;
4459     PetscInt *cids;
4460     PetscInt  dofPerDim[4] = {1, 1, 1, 1};
4461 
4462     PetscCall(DMPforestGetPlex(dmCoarse, &plexC));
4463     PetscCall(DMPforestGetPlex(dmFine, &plexF));
4464     PetscCall(DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids));
4465     PetscCall(PetscSFSetUp(sf));
4466     PetscCall(DMPlexComputeInjectorTree(plexC, plexF, sf, cids, *injection));
4467     PetscCall(PetscSFDestroy(&sf));
4468     PetscCall(PetscFree(cids));
4469   }
4470   PetscCall(MatViewFromOptions(*injection, NULL, "-inject_mat_view"));
4471   /* Use naive scaling */
4472   PetscFunctionReturn(PETSC_SUCCESS);
4473 }
4474 
4475   #define DMForestTransferVecFromBase_pforest _append_pforest(DMForestTransferVecFromBase)
4476 static PetscErrorCode DMForestTransferVecFromBase_pforest(DM dm, Vec vecIn, Vec vecOut)
4477 {
4478   DM        dmIn, dmVecIn, base, basec, plex, coarseDM;
4479   DM       *hierarchy;
4480   PetscSF   sfRed = NULL;
4481   PetscDS   ds;
4482   Vec       vecInLocal, vecOutLocal;
4483   DMLabel   subpointMap;
4484   PetscInt  minLevel, mh, n_hi, i;
4485   PetscBool hiforest, *hierarchy_forest;
4486 
4487   PetscFunctionBegin;
4488   PetscCall(VecGetDM(vecIn, &dmVecIn));
4489   PetscCall(DMGetDS(dmVecIn, &ds));
4490   PetscCheck(ds, PetscObjectComm((PetscObject)dmVecIn), PETSC_ERR_SUP, "Cannot transfer without a PetscDS object");
4491   { /* we cannot stick user contexts into function callbacks for DMProjectFieldLocal! */
4492     PetscSection section;
4493     PetscInt     Nf;
4494 
4495     PetscCall(DMGetLocalSection(dmVecIn, &section));
4496     PetscCall(PetscSectionGetNumFields(section, &Nf));
4497     PetscCheck(Nf <= 3, PetscObjectComm((PetscObject)dmVecIn), PETSC_ERR_SUP, "Number of fields %" PetscInt_FMT " are currently not supported! Send an email at petsc-dev@mcs.anl.gov", Nf);
4498   }
4499   PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
4500   PetscCheck(!minLevel, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Cannot transfer with minimum refinement set to %" PetscInt_FMT ". Rerun with DMForestSetMinimumRefinement(dm,0)", minLevel);
4501   PetscCall(DMForestGetBaseDM(dm, &base));
4502   PetscCheck(base, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Missing base DM");
4503 
4504   PetscCall(VecSet(vecOut, 0.0));
4505   if (dmVecIn == base) { /* sequential runs */
4506     PetscCall(PetscObjectReference((PetscObject)vecIn));
4507   } else {
4508     PetscSection secIn, secInRed;
4509     Vec          vecInRed, vecInLocal;
4510 
4511     PetscCall(PetscObjectQuery((PetscObject)base, "_base_migration_sf", (PetscObject *)&sfRed));
4512     PetscCheck(sfRed, PETSC_COMM_SELF, PETSC_ERR_SUP, "Not the DM set with DMForestSetBaseDM()");
4513     PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dmVecIn), &secInRed));
4514     PetscCall(VecCreate(PETSC_COMM_SELF, &vecInRed));
4515     PetscCall(DMGetLocalSection(dmVecIn, &secIn));
4516     PetscCall(DMGetLocalVector(dmVecIn, &vecInLocal));
4517     PetscCall(DMGlobalToLocalBegin(dmVecIn, vecIn, INSERT_VALUES, vecInLocal));
4518     PetscCall(DMGlobalToLocalEnd(dmVecIn, vecIn, INSERT_VALUES, vecInLocal));
4519     PetscCall(DMPlexDistributeField(dmVecIn, sfRed, secIn, vecInLocal, secInRed, vecInRed));
4520     PetscCall(DMRestoreLocalVector(dmVecIn, &vecInLocal));
4521     PetscCall(PetscSectionDestroy(&secInRed));
4522     vecIn = vecInRed;
4523   }
4524 
4525   /* we first search through the AdaptivityForest hierarchy
4526      once we found the first disconnected forest, we upsweep the DM hierarchy */
4527   hiforest = PETSC_TRUE;
4528 
4529   /* upsweep to the coarsest DM */
4530   n_hi     = 0;
4531   coarseDM = dm;
4532   do {
4533     PetscBool isforest;
4534 
4535     dmIn = coarseDM;
4536     /* need to call DMSetUp to have the hierarchy recursively setup */
4537     PetscCall(DMSetUp(dmIn));
4538     PetscCall(DMIsForest(dmIn, &isforest));
4539     PetscCheck(isforest, PetscObjectComm((PetscObject)dmIn), PETSC_ERR_SUP, "Cannot currently transfer through a mixed hierarchy! Found DM type %s", ((PetscObject)dmIn)->type_name);
4540     coarseDM = NULL;
4541     if (hiforest) PetscCall(DMForestGetAdaptivityForest(dmIn, &coarseDM));
4542     if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */
4543       hiforest = PETSC_FALSE;
4544       PetscCall(DMGetCoarseDM(dmIn, &coarseDM));
4545     }
4546     n_hi++;
4547   } while (coarseDM);
4548 
4549   PetscCall(PetscMalloc2(n_hi, &hierarchy, n_hi, &hierarchy_forest));
4550 
4551   i        = 0;
4552   hiforest = PETSC_TRUE;
4553   coarseDM = dm;
4554   do {
4555     dmIn     = coarseDM;
4556     coarseDM = NULL;
4557     if (hiforest) PetscCall(DMForestGetAdaptivityForest(dmIn, &coarseDM));
4558     if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */
4559       hiforest = PETSC_FALSE;
4560       PetscCall(DMGetCoarseDM(dmIn, &coarseDM));
4561     }
4562     i++;
4563     hierarchy[n_hi - i] = dmIn;
4564   } while (coarseDM);
4565 
4566   /* project base vector on the coarsest forest (minimum refinement = 0) */
4567   PetscCall(DMPforestGetPlex(dmIn, &plex));
4568 
4569   /* Check this plex is compatible with the base */
4570   {
4571     IS       gnum[2];
4572     PetscInt ncells[2], gncells[2];
4573 
4574     PetscCall(DMPlexGetCellNumbering(base, &gnum[0]));
4575     PetscCall(DMPlexGetCellNumbering(plex, &gnum[1]));
4576     PetscCall(ISGetMinMax(gnum[0], NULL, &ncells[0]));
4577     PetscCall(ISGetMinMax(gnum[1], NULL, &ncells[1]));
4578     PetscCall(MPIU_Allreduce(ncells, gncells, 2, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm)));
4579     PetscCheck(gncells[0] == gncells[1], PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Invalid number of base cells! Expected %" PetscInt_FMT ", found %" PetscInt_FMT, gncells[0] + 1, gncells[1] + 1);
4580   }
4581 
4582   PetscCall(DMGetLabel(dmIn, "_forest_base_subpoint_map", &subpointMap));
4583   PetscCheck(subpointMap, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Missing _forest_base_subpoint_map label");
4584 
4585   PetscCall(DMPlexGetMaxProjectionHeight(base, &mh));
4586   PetscCall(DMPlexSetMaxProjectionHeight(plex, mh));
4587 
4588   PetscCall(DMClone(base, &basec));
4589   PetscCall(DMCopyDisc(dmVecIn, basec));
4590   if (sfRed) {
4591     PetscCall(PetscObjectReference((PetscObject)vecIn));
4592     vecInLocal = vecIn;
4593   } else {
4594     PetscCall(DMCreateLocalVector(basec, &vecInLocal));
4595     PetscCall(DMGlobalToLocalBegin(basec, vecIn, INSERT_VALUES, vecInLocal));
4596     PetscCall(DMGlobalToLocalEnd(basec, vecIn, INSERT_VALUES, vecInLocal));
4597   }
4598 
4599   PetscCall(DMGetLocalVector(dmIn, &vecOutLocal));
4600   { /* get degrees of freedom ordered onto dmIn */
4601     PetscSF            basetocoarse;
4602     PetscInt           bStart, bEnd, nroots;
4603     PetscInt           iStart, iEnd, nleaves, leaf;
4604     PetscMPIInt        rank;
4605     PetscSFNode       *remotes;
4606     PetscSection       secIn, secOut;
4607     PetscInt          *remoteOffsets;
4608     PetscSF            transferSF;
4609     const PetscScalar *inArray;
4610     PetscScalar       *outArray;
4611 
4612     PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)basec), &rank));
4613     PetscCall(DMPlexGetChart(basec, &bStart, &bEnd));
4614     nroots = PetscMax(bEnd - bStart, 0);
4615     PetscCall(DMPlexGetChart(plex, &iStart, &iEnd));
4616     nleaves = PetscMax(iEnd - iStart, 0);
4617 
4618     PetscCall(PetscMalloc1(nleaves, &remotes));
4619     for (leaf = iStart; leaf < iEnd; leaf++) {
4620       PetscInt index;
4621 
4622       remotes[leaf - iStart].rank = rank;
4623       PetscCall(DMLabelGetValue(subpointMap, leaf, &index));
4624       remotes[leaf - iStart].index = index;
4625     }
4626 
4627     PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)basec), &basetocoarse));
4628     PetscCall(PetscSFSetGraph(basetocoarse, nroots, nleaves, NULL, PETSC_OWN_POINTER, remotes, PETSC_OWN_POINTER));
4629     PetscCall(PetscSFSetUp(basetocoarse));
4630     PetscCall(DMGetLocalSection(basec, &secIn));
4631     PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dmIn), &secOut));
4632     PetscCall(PetscSFDistributeSection(basetocoarse, secIn, &remoteOffsets, secOut));
4633     PetscCall(PetscSFCreateSectionSF(basetocoarse, secIn, remoteOffsets, secOut, &transferSF));
4634     PetscCall(PetscFree(remoteOffsets));
4635     PetscCall(VecGetArrayWrite(vecOutLocal, &outArray));
4636     PetscCall(VecGetArrayRead(vecInLocal, &inArray));
4637     PetscCall(PetscSFBcastBegin(transferSF, MPIU_SCALAR, inArray, outArray, MPI_REPLACE));
4638     PetscCall(PetscSFBcastEnd(transferSF, MPIU_SCALAR, inArray, outArray, MPI_REPLACE));
4639     PetscCall(VecRestoreArrayRead(vecInLocal, &inArray));
4640     PetscCall(VecRestoreArrayWrite(vecOutLocal, &outArray));
4641     PetscCall(PetscSFDestroy(&transferSF));
4642     PetscCall(PetscSectionDestroy(&secOut));
4643     PetscCall(PetscSFDestroy(&basetocoarse));
4644   }
4645   PetscCall(VecDestroy(&vecInLocal));
4646   PetscCall(DMDestroy(&basec));
4647   PetscCall(VecDestroy(&vecIn));
4648 
4649   /* output */
4650   if (n_hi > 1) { /* downsweep the stored hierarchy */
4651     Vec vecOut1, vecOut2;
4652     DM  fineDM;
4653 
4654     PetscCall(DMGetGlobalVector(dmIn, &vecOut1));
4655     PetscCall(DMLocalToGlobal(dmIn, vecOutLocal, INSERT_VALUES, vecOut1));
4656     PetscCall(DMRestoreLocalVector(dmIn, &vecOutLocal));
4657     for (i = 1; i < n_hi - 1; i++) {
4658       fineDM = hierarchy[i];
4659       PetscCall(DMGetGlobalVector(fineDM, &vecOut2));
4660       PetscCall(DMForestTransferVec(dmIn, vecOut1, fineDM, vecOut2, PETSC_TRUE, 0.0));
4661       PetscCall(DMRestoreGlobalVector(dmIn, &vecOut1));
4662       vecOut1 = vecOut2;
4663       dmIn    = fineDM;
4664     }
4665     PetscCall(DMForestTransferVec(dmIn, vecOut1, dm, vecOut, PETSC_TRUE, 0.0));
4666     PetscCall(DMRestoreGlobalVector(dmIn, &vecOut1));
4667   } else {
4668     PetscCall(DMLocalToGlobal(dmIn, vecOutLocal, INSERT_VALUES, vecOut));
4669     PetscCall(DMRestoreLocalVector(dmIn, &vecOutLocal));
4670   }
4671   PetscCall(PetscFree2(hierarchy, hierarchy_forest));
4672   PetscFunctionReturn(PETSC_SUCCESS);
4673 }
4674 
4675   #define DMForestTransferVec_pforest _append_pforest(DMForestTransferVec)
4676 static PetscErrorCode DMForestTransferVec_pforest(DM dmIn, Vec vecIn, DM dmOut, Vec vecOut, PetscBool useBCs, PetscReal time)
4677 {
4678   DM          adaptIn, adaptOut, plexIn, plexOut;
4679   DM_Forest  *forestIn, *forestOut, *forestAdaptIn, *forestAdaptOut;
4680   PetscInt    dofPerDim[] = {1, 1, 1, 1};
4681   PetscSF     inSF = NULL, outSF = NULL;
4682   PetscInt   *inCids = NULL, *outCids = NULL;
4683   DMAdaptFlag purposeIn, purposeOut;
4684 
4685   PetscFunctionBegin;
4686   forestOut = (DM_Forest *)dmOut->data;
4687   forestIn  = (DM_Forest *)dmIn->data;
4688 
4689   PetscCall(DMForestGetAdaptivityForest(dmOut, &adaptOut));
4690   PetscCall(DMForestGetAdaptivityPurpose(dmOut, &purposeOut));
4691   forestAdaptOut = adaptOut ? (DM_Forest *)adaptOut->data : NULL;
4692 
4693   PetscCall(DMForestGetAdaptivityForest(dmIn, &adaptIn));
4694   PetscCall(DMForestGetAdaptivityPurpose(dmIn, &purposeIn));
4695   forestAdaptIn = adaptIn ? (DM_Forest *)adaptIn->data : NULL;
4696 
4697   if (forestAdaptOut == forestIn) {
4698     switch (purposeOut) {
4699     case DM_ADAPT_REFINE:
4700       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4701       PetscCall(PetscSFSetUp(inSF));
4702       break;
4703     case DM_ADAPT_COARSEN:
4704     case DM_ADAPT_COARSEN_LAST:
4705       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_TRUE, &outCids));
4706       PetscCall(PetscSFSetUp(outSF));
4707       break;
4708     default:
4709       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4710       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_FALSE, &outCids));
4711       PetscCall(PetscSFSetUp(inSF));
4712       PetscCall(PetscSFSetUp(outSF));
4713     }
4714   } else if (forestAdaptIn == forestOut) {
4715     switch (purposeIn) {
4716     case DM_ADAPT_REFINE:
4717       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_TRUE, &inCids));
4718       PetscCall(PetscSFSetUp(outSF));
4719       break;
4720     case DM_ADAPT_COARSEN:
4721     case DM_ADAPT_COARSEN_LAST:
4722       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4723       PetscCall(PetscSFSetUp(inSF));
4724       break;
4725     default:
4726       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4727       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_FALSE, &outCids));
4728       PetscCall(PetscSFSetUp(inSF));
4729       PetscCall(PetscSFSetUp(outSF));
4730     }
4731   } else SETERRQ(PetscObjectComm((PetscObject)dmIn), PETSC_ERR_SUP, "Only support transfer from pre-adaptivity to post-adaptivity right now");
4732   PetscCall(DMPforestGetPlex(dmIn, &plexIn));
4733   PetscCall(DMPforestGetPlex(dmOut, &plexOut));
4734 
4735   PetscCall(DMPlexTransferVecTree(plexIn, vecIn, plexOut, vecOut, inSF, outSF, inCids, outCids, useBCs, time));
4736   PetscCall(PetscFree(inCids));
4737   PetscCall(PetscFree(outCids));
4738   PetscCall(PetscSFDestroy(&inSF));
4739   PetscCall(PetscSFDestroy(&outSF));
4740   PetscCall(PetscFree(inCids));
4741   PetscCall(PetscFree(outCids));
4742   PetscFunctionReturn(PETSC_SUCCESS);
4743 }
4744 
4745   #define DMCreateCoordinateDM_pforest _append_pforest(DMCreateCoordinateDM)
4746 static PetscErrorCode DMCreateCoordinateDM_pforest(DM dm, DM *cdm)
4747 {
4748   DM plex;
4749 
4750   PetscFunctionBegin;
4751   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4752   PetscCall(DMPforestGetPlex(dm, &plex));
4753   PetscCall(DMGetCoordinateDM(plex, cdm));
4754   PetscCall(PetscObjectReference((PetscObject)*cdm));
4755   PetscFunctionReturn(PETSC_SUCCESS);
4756 }
4757 
4758   #define VecViewLocal_pforest _append_pforest(VecViewLocal)
4759 static PetscErrorCode VecViewLocal_pforest(Vec vec, PetscViewer viewer)
4760 {
4761   DM dm, plex;
4762 
4763   PetscFunctionBegin;
4764   PetscCall(VecGetDM(vec, &dm));
4765   PetscCall(DMPforestGetPlex(dm, &plex));
4766   PetscCall(VecSetDM(vec, plex));
4767   PetscCall(VecView_Plex_Local(vec, viewer));
4768   PetscCall(VecSetDM(vec, dm));
4769   PetscFunctionReturn(PETSC_SUCCESS);
4770 }
4771 
4772   #define VecView_pforest _append_pforest(VecView)
4773 static PetscErrorCode VecView_pforest(Vec vec, PetscViewer viewer)
4774 {
4775   DM dm, plex;
4776 
4777   PetscFunctionBegin;
4778   PetscCall(VecGetDM(vec, &dm));
4779   PetscCall(DMPforestGetPlex(dm, &plex));
4780   PetscCall(VecSetDM(vec, plex));
4781   PetscCall(VecView_Plex(vec, viewer));
4782   PetscCall(VecSetDM(vec, dm));
4783   PetscFunctionReturn(PETSC_SUCCESS);
4784 }
4785 
4786   #define VecView_pforest_Native _infix_pforest(VecView, _Native)
4787 static PetscErrorCode VecView_pforest_Native(Vec vec, PetscViewer viewer)
4788 {
4789   DM dm, plex;
4790 
4791   PetscFunctionBegin;
4792   PetscCall(VecGetDM(vec, &dm));
4793   PetscCall(DMPforestGetPlex(dm, &plex));
4794   PetscCall(VecSetDM(vec, plex));
4795   PetscCall(VecView_Plex_Native(vec, viewer));
4796   PetscCall(VecSetDM(vec, dm));
4797   PetscFunctionReturn(PETSC_SUCCESS);
4798 }
4799 
4800   #define VecLoad_pforest _append_pforest(VecLoad)
4801 static PetscErrorCode VecLoad_pforest(Vec vec, PetscViewer viewer)
4802 {
4803   DM dm, plex;
4804 
4805   PetscFunctionBegin;
4806   PetscCall(VecGetDM(vec, &dm));
4807   PetscCall(DMPforestGetPlex(dm, &plex));
4808   PetscCall(VecSetDM(vec, plex));
4809   PetscCall(VecLoad_Plex(vec, viewer));
4810   PetscCall(VecSetDM(vec, dm));
4811   PetscFunctionReturn(PETSC_SUCCESS);
4812 }
4813 
4814   #define VecLoad_pforest_Native _infix_pforest(VecLoad, _Native)
4815 static PetscErrorCode VecLoad_pforest_Native(Vec vec, PetscViewer viewer)
4816 {
4817   DM dm, plex;
4818 
4819   PetscFunctionBegin;
4820   PetscCall(VecGetDM(vec, &dm));
4821   PetscCall(DMPforestGetPlex(dm, &plex));
4822   PetscCall(VecSetDM(vec, plex));
4823   PetscCall(VecLoad_Plex_Native(vec, viewer));
4824   PetscCall(VecSetDM(vec, dm));
4825   PetscFunctionReturn(PETSC_SUCCESS);
4826 }
4827 
4828   #define DMCreateGlobalVector_pforest _append_pforest(DMCreateGlobalVector)
4829 static PetscErrorCode DMCreateGlobalVector_pforest(DM dm, Vec *vec)
4830 {
4831   PetscFunctionBegin;
4832   PetscCall(DMCreateGlobalVector_Section_Private(dm, vec));
4833   /* PetscCall(VecSetOperation(*vec, VECOP_DUPLICATE, (void(*)(void)) VecDuplicate_MPI_DM)); */
4834   PetscCall(VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecView_pforest));
4835   PetscCall(VecSetOperation(*vec, VECOP_VIEWNATIVE, (void (*)(void))VecView_pforest_Native));
4836   PetscCall(VecSetOperation(*vec, VECOP_LOAD, (void (*)(void))VecLoad_pforest));
4837   PetscCall(VecSetOperation(*vec, VECOP_LOADNATIVE, (void (*)(void))VecLoad_pforest_Native));
4838   PetscFunctionReturn(PETSC_SUCCESS);
4839 }
4840 
4841   #define DMCreateLocalVector_pforest _append_pforest(DMCreateLocalVector)
4842 static PetscErrorCode DMCreateLocalVector_pforest(DM dm, Vec *vec)
4843 {
4844   PetscFunctionBegin;
4845   PetscCall(DMCreateLocalVector_Section_Private(dm, vec));
4846   PetscCall(VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecViewLocal_pforest));
4847   PetscFunctionReturn(PETSC_SUCCESS);
4848 }
4849 
4850   #define DMCreateMatrix_pforest _append_pforest(DMCreateMatrix)
4851 static PetscErrorCode DMCreateMatrix_pforest(DM dm, Mat *mat)
4852 {
4853   DM plex;
4854 
4855   PetscFunctionBegin;
4856   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4857   PetscCall(DMPforestGetPlex(dm, &plex));
4858   if (plex->prealloc_only != dm->prealloc_only) plex->prealloc_only = dm->prealloc_only; /* maybe this should go into forest->plex */
4859   PetscCall(DMSetMatType(plex, dm->mattype));
4860   PetscCall(DMCreateMatrix(plex, mat));
4861   PetscCall(MatSetDM(*mat, dm));
4862   PetscFunctionReturn(PETSC_SUCCESS);
4863 }
4864 
4865   #define DMProjectFunctionLocal_pforest _append_pforest(DMProjectFunctionLocal)
4866 static PetscErrorCode DMProjectFunctionLocal_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, InsertMode mode, Vec localX)
4867 {
4868   DM plex;
4869 
4870   PetscFunctionBegin;
4871   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4872   PetscCall(DMPforestGetPlex(dm, &plex));
4873   PetscCall(DMProjectFunctionLocal(plex, time, funcs, ctxs, mode, localX));
4874   PetscFunctionReturn(PETSC_SUCCESS);
4875 }
4876 
4877   #define DMProjectFunctionLabelLocal_pforest _append_pforest(DMProjectFunctionLabelLocal)
4878 static PetscErrorCode DMProjectFunctionLabelLocal_pforest(DM dm, PetscReal time, DMLabel label, PetscInt numIds, const PetscInt ids[], PetscInt Ncc, const PetscInt comps[], PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, InsertMode mode, Vec localX)
4879 {
4880   DM plex;
4881 
4882   PetscFunctionBegin;
4883   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4884   PetscCall(DMPforestGetPlex(dm, &plex));
4885   PetscCall(DMProjectFunctionLabelLocal(plex, time, label, numIds, ids, Ncc, comps, funcs, ctxs, mode, localX));
4886   PetscFunctionReturn(PETSC_SUCCESS);
4887 }
4888 
4889   #define DMProjectFieldLocal_pforest _append_pforest(DMProjectFieldLocal)
4890 PetscErrorCode DMProjectFieldLocal_pforest(DM dm, PetscReal time, Vec localU, void (**funcs)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), InsertMode mode, Vec localX)
4891 {
4892   DM plex;
4893 
4894   PetscFunctionBegin;
4895   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4896   PetscCall(DMPforestGetPlex(dm, &plex));
4897   PetscCall(DMProjectFieldLocal(plex, time, localU, funcs, mode, localX));
4898   PetscFunctionReturn(PETSC_SUCCESS);
4899 }
4900 
4901   #define DMComputeL2Diff_pforest _append_pforest(DMComputeL2Diff)
4902 PetscErrorCode DMComputeL2Diff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
4903 {
4904   DM plex;
4905 
4906   PetscFunctionBegin;
4907   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4908   PetscCall(DMPforestGetPlex(dm, &plex));
4909   PetscCall(DMComputeL2Diff(plex, time, funcs, ctxs, X, diff));
4910   PetscFunctionReturn(PETSC_SUCCESS);
4911 }
4912 
4913   #define DMComputeL2FieldDiff_pforest _append_pforest(DMComputeL2FieldDiff)
4914 PetscErrorCode DMComputeL2FieldDiff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal diff[])
4915 {
4916   DM plex;
4917 
4918   PetscFunctionBegin;
4919   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4920   PetscCall(DMPforestGetPlex(dm, &plex));
4921   PetscCall(DMComputeL2FieldDiff(plex, time, funcs, ctxs, X, diff));
4922   PetscFunctionReturn(PETSC_SUCCESS);
4923 }
4924 
4925   #define DMCreatelocalsection_pforest _append_pforest(DMCreatelocalsection)
4926 static PetscErrorCode DMCreatelocalsection_pforest(DM dm)
4927 {
4928   DM           plex;
4929   PetscSection section;
4930 
4931   PetscFunctionBegin;
4932   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4933   PetscCall(DMPforestGetPlex(dm, &plex));
4934   PetscCall(DMGetLocalSection(plex, &section));
4935   PetscCall(DMSetLocalSection(dm, section));
4936   PetscFunctionReturn(PETSC_SUCCESS);
4937 }
4938 
4939   #define DMCreateDefaultConstraints_pforest _append_pforest(DMCreateDefaultConstraints)
4940 static PetscErrorCode DMCreateDefaultConstraints_pforest(DM dm)
4941 {
4942   DM           plex;
4943   Mat          mat;
4944   Vec          bias;
4945   PetscSection section;
4946 
4947   PetscFunctionBegin;
4948   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4949   PetscCall(DMPforestGetPlex(dm, &plex));
4950   PetscCall(DMGetDefaultConstraints(plex, &section, &mat, &bias));
4951   PetscCall(DMSetDefaultConstraints(dm, section, mat, bias));
4952   PetscFunctionReturn(PETSC_SUCCESS);
4953 }
4954 
4955   #define DMGetDimPoints_pforest _append_pforest(DMGetDimPoints)
4956 static PetscErrorCode DMGetDimPoints_pforest(DM dm, PetscInt dim, PetscInt *cStart, PetscInt *cEnd)
4957 {
4958   DM plex;
4959 
4960   PetscFunctionBegin;
4961   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4962   PetscCall(DMPforestGetPlex(dm, &plex));
4963   PetscCall(DMGetDimPoints(plex, dim, cStart, cEnd));
4964   PetscFunctionReturn(PETSC_SUCCESS);
4965 }
4966 
4967   /* Need to forward declare */
4968   #define DMInitialize_pforest _append_pforest(DMInitialize)
4969 static PetscErrorCode DMInitialize_pforest(DM dm);
4970 
4971   #define DMClone_pforest _append_pforest(DMClone)
4972 static PetscErrorCode DMClone_pforest(DM dm, DM *newdm)
4973 {
4974   PetscFunctionBegin;
4975   PetscCall(DMClone_Forest(dm, newdm));
4976   PetscCall(DMInitialize_pforest(*newdm));
4977   PetscFunctionReturn(PETSC_SUCCESS);
4978 }
4979 
4980   #define DMForestCreateCellChart_pforest _append_pforest(DMForestCreateCellChart)
4981 static PetscErrorCode DMForestCreateCellChart_pforest(DM dm, PetscInt *cStart, PetscInt *cEnd)
4982 {
4983   DM_Forest         *forest;
4984   DM_Forest_pforest *pforest;
4985   PetscInt           overlap;
4986 
4987   PetscFunctionBegin;
4988   PetscCall(DMSetUp(dm));
4989   forest  = (DM_Forest *)dm->data;
4990   pforest = (DM_Forest_pforest *)forest->data;
4991   *cStart = 0;
4992   PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
4993   if (overlap && pforest->ghost) {
4994     *cEnd = pforest->forest->local_num_quadrants + pforest->ghost->proc_offsets[pforest->forest->mpisize];
4995   } else {
4996     *cEnd = pforest->forest->local_num_quadrants;
4997   }
4998   PetscFunctionReturn(PETSC_SUCCESS);
4999 }
5000 
5001   #define DMForestCreateCellSF_pforest _append_pforest(DMForestCreateCellSF)
5002 static PetscErrorCode DMForestCreateCellSF_pforest(DM dm, PetscSF *cellSF)
5003 {
5004   DM_Forest         *forest;
5005   DM_Forest_pforest *pforest;
5006   PetscMPIInt        rank;
5007   PetscInt           overlap;
5008   PetscInt           cStart, cEnd, cLocalStart, cLocalEnd;
5009   PetscInt           nRoots, nLeaves, *mine = NULL;
5010   PetscSFNode       *remote = NULL;
5011   PetscSF            sf;
5012 
5013   PetscFunctionBegin;
5014   PetscCall(DMForestGetCellChart(dm, &cStart, &cEnd));
5015   forest      = (DM_Forest *)dm->data;
5016   pforest     = (DM_Forest_pforest *)forest->data;
5017   nRoots      = cEnd - cStart;
5018   cLocalStart = pforest->cLocalStart;
5019   cLocalEnd   = pforest->cLocalEnd;
5020   nLeaves     = 0;
5021   PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
5022   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
5023   if (overlap && pforest->ghost) {
5024     PetscSFNode      *mirror;
5025     p4est_quadrant_t *mirror_array;
5026     PetscInt          nMirror, nGhostPre, nSelf, q;
5027     void            **mirrorPtrs;
5028 
5029     nMirror   = (PetscInt)pforest->ghost->mirrors.elem_count;
5030     nSelf     = cLocalEnd - cLocalStart;
5031     nLeaves   = nRoots - nSelf;
5032     nGhostPre = (PetscInt)pforest->ghost->proc_offsets[rank];
5033     PetscCall(PetscMalloc1(nLeaves, &mine));
5034     PetscCall(PetscMalloc1(nLeaves, &remote));
5035     PetscCall(PetscMalloc2(nMirror, &mirror, nMirror, &mirrorPtrs));
5036     mirror_array = (p4est_quadrant_t *)pforest->ghost->mirrors.array;
5037     for (q = 0; q < nMirror; q++) {
5038       p4est_quadrant_t *mir = &(mirror_array[q]);
5039 
5040       mirror[q].rank  = rank;
5041       mirror[q].index = (PetscInt)mir->p.piggy3.local_num + cLocalStart;
5042       mirrorPtrs[q]   = (void *)&(mirror[q]);
5043     }
5044     PetscCallP4est(p4est_ghost_exchange_custom, (pforest->forest, pforest->ghost, sizeof(PetscSFNode), mirrorPtrs, remote));
5045     PetscCall(PetscFree2(mirror, mirrorPtrs));
5046     for (q = 0; q < nGhostPre; q++) mine[q] = q;
5047     for (; q < nLeaves; q++) mine[q] = (q - nGhostPre) + cLocalEnd;
5048   }
5049   PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &sf));
5050   PetscCall(PetscSFSetGraph(sf, nRoots, nLeaves, mine, PETSC_OWN_POINTER, remote, PETSC_OWN_POINTER));
5051   *cellSF = sf;
5052   PetscFunctionReturn(PETSC_SUCCESS);
5053 }
5054 
5055 static PetscErrorCode DMCreateNeumannOverlap_pforest(DM dm, IS *ovl, Mat *J, PetscErrorCode (**setup)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *), void **setup_ctx)
5056 {
5057   DM plex;
5058 
5059   PetscFunctionBegin;
5060   PetscCall(DMPforestGetPlex(dm, &plex));
5061   PetscCall(DMCreateNeumannOverlap_Plex(plex, ovl, J, setup, setup_ctx));
5062   if (!*setup) {
5063     PetscCall(PetscObjectQueryFunction((PetscObject)dm, "MatComputeNeumannOverlap_C", setup));
5064     if (*setup) PetscCall(PetscObjectCompose((PetscObject)*ovl, "_DM_Original_HPDDM", (PetscObject)dm));
5065   }
5066   PetscFunctionReturn(PETSC_SUCCESS);
5067 }
5068 
5069   #define DMCreateDomainDecomposition_pforest _append_pforest(DMCreateDomainDecomposition)
5070 static PetscErrorCode DMCreateDomainDecomposition_pforest(DM dm, PetscInt *nsub, char ***names, IS **innerises, IS **outerises, DM **dms)
5071 {
5072   DM plex;
5073 
5074   PetscFunctionBegin;
5075   PetscCall(DMPforestGetPlex(dm, &plex));
5076   PetscCall(DMCreateDomainDecomposition(plex, nsub, names, innerises, outerises, dms));
5077   PetscFunctionReturn(PETSC_SUCCESS);
5078 }
5079 
5080   #define DMCreateDomainDecompositionScatters_pforest _append_pforest(DMCreateDomainDecompositionScatters)
5081 static PetscErrorCode DMCreateDomainDecompositionScatters_pforest(DM dm, PetscInt n, DM *subdms, VecScatter **iscat, VecScatter **oscat, VecScatter **lscat)
5082 {
5083   DM plex;
5084 
5085   PetscFunctionBegin;
5086   PetscCall(DMPforestGetPlex(dm, &plex));
5087   PetscCall(DMCreateDomainDecompositionScatters(plex, n, subdms, iscat, oscat, lscat));
5088   PetscFunctionReturn(PETSC_SUCCESS);
5089 }
5090 
5091 static PetscErrorCode DMInitialize_pforest(DM dm)
5092 {
5093   PetscFunctionBegin;
5094   dm->ops->setup                     = DMSetUp_pforest;
5095   dm->ops->view                      = DMView_pforest;
5096   dm->ops->clone                     = DMClone_pforest;
5097   dm->ops->createinterpolation       = DMCreateInterpolation_pforest;
5098   dm->ops->createinjection           = DMCreateInjection_pforest;
5099   dm->ops->setfromoptions            = DMSetFromOptions_pforest;
5100   dm->ops->createcoordinatedm        = DMCreateCoordinateDM_pforest;
5101   dm->ops->createglobalvector        = DMCreateGlobalVector_pforest;
5102   dm->ops->createlocalvector         = DMCreateLocalVector_pforest;
5103   dm->ops->creatematrix              = DMCreateMatrix_pforest;
5104   dm->ops->projectfunctionlocal      = DMProjectFunctionLocal_pforest;
5105   dm->ops->projectfunctionlabellocal = DMProjectFunctionLabelLocal_pforest;
5106   dm->ops->projectfieldlocal         = DMProjectFieldLocal_pforest;
5107   dm->ops->createlocalsection        = DMCreatelocalsection_pforest;
5108   dm->ops->createdefaultconstraints  = DMCreateDefaultConstraints_pforest;
5109   dm->ops->computel2diff             = DMComputeL2Diff_pforest;
5110   dm->ops->computel2fielddiff        = DMComputeL2FieldDiff_pforest;
5111   dm->ops->getdimpoints              = DMGetDimPoints_pforest;
5112   dm->ops->createdomaindecomposition = DMCreateDomainDecomposition_pforest;
5113   dm->ops->createddscatters          = DMCreateDomainDecompositionScatters_pforest;
5114 
5115   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_plex_pforest) "_C", DMConvert_plex_pforest));
5116   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_pforest_plex) "_C", DMConvert_pforest_plex));
5117   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMCreateNeumannOverlap_C", DMCreateNeumannOverlap_pforest));
5118   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMPlexGetOverlap_C", DMForestGetPartitionOverlap));
5119   PetscFunctionReturn(PETSC_SUCCESS);
5120 }
5121 
5122   #define DMCreate_pforest _append_pforest(DMCreate)
5123 PETSC_EXTERN PetscErrorCode DMCreate_pforest(DM dm)
5124 {
5125   DM_Forest         *forest;
5126   DM_Forest_pforest *pforest;
5127 
5128   PetscFunctionBegin;
5129   PetscCall(PetscP4estInitialize());
5130   PetscCall(DMCreate_Forest(dm));
5131   PetscCall(DMInitialize_pforest(dm));
5132   PetscCall(DMSetDimension(dm, P4EST_DIM));
5133 
5134   /* set forest defaults */
5135   PetscCall(DMForestSetTopology(dm, "unit"));
5136   PetscCall(DMForestSetMinimumRefinement(dm, 0));
5137   PetscCall(DMForestSetInitialRefinement(dm, 0));
5138   PetscCall(DMForestSetMaximumRefinement(dm, P4EST_QMAXLEVEL));
5139   PetscCall(DMForestSetGradeFactor(dm, 2));
5140   PetscCall(DMForestSetAdjacencyDimension(dm, 0));
5141   PetscCall(DMForestSetPartitionOverlap(dm, 0));
5142 
5143   /* create p4est data */
5144   PetscCall(PetscNew(&pforest));
5145 
5146   forest                            = (DM_Forest *)dm->data;
5147   forest->data                      = pforest;
5148   forest->destroy                   = DMForestDestroy_pforest;
5149   forest->ftemplate                 = DMForestTemplate_pforest;
5150   forest->transfervec               = DMForestTransferVec_pforest;
5151   forest->transfervecfrombase       = DMForestTransferVecFromBase_pforest;
5152   forest->createcellchart           = DMForestCreateCellChart_pforest;
5153   forest->createcellsf              = DMForestCreateCellSF_pforest;
5154   forest->clearadaptivityforest     = DMForestClearAdaptivityForest_pforest;
5155   forest->getadaptivitysuccess      = DMForestGetAdaptivitySuccess_pforest;
5156   pforest->topo                     = NULL;
5157   pforest->forest                   = NULL;
5158   pforest->ghost                    = NULL;
5159   pforest->lnodes                   = NULL;
5160   pforest->partition_for_coarsening = PETSC_TRUE;
5161   pforest->coarsen_hierarchy        = PETSC_FALSE;
5162   pforest->cLocalStart              = -1;
5163   pforest->cLocalEnd                = -1;
5164   pforest->labelsFinalized          = PETSC_FALSE;
5165   pforest->ghostName                = NULL;
5166   PetscFunctionReturn(PETSC_SUCCESS);
5167 }
5168 
5169 #endif /* defined(PETSC_HAVE_P4EST) */
5170