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