BLOCKS: Rewrite neighbor selection for refinement.

In this patch we make a general subroutine iterating over all neighbors
iterate_over_neighbors() which takes as arguments a pointer to the block
which neighbors are evaluated and pointer to subroutine which should be
called with each neighbor. So far two such subroutines are used, one to
select the proper refinement flag, and another to select the neighbor
for update.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>

src/blocks.F90

@@ -271,6 +271,7 @@ module blocks
   public :: refine_block, derefine_block
   public :: set_last_id, get_last_id, get_mblocks, get_dblocks, get_nleafs
   public :: set_blocks_update
+  public :: set_neighbors_refine
   public :: metablock_set_id, metablock_set_process, metablock_set_level
   public :: metablock_set_configuration, metablock_set_refinement
   public :: metablock_set_position, metablock_set_coordinates
@@ -1711,7 +1712,7 @@ module blocks
 
 ! mark all neighbors to be updated as well
 !
-      call neighbors_set_update(pmeta)
+      call set_neighbors_update(pmeta)
 
 !! ASSOCIATE DATA BLOCKS IF NECESSARY
 !!
@@ -1918,7 +1919,7 @@ module blocks
 
 ! mark all neighbors to be updated as well
 !
-    call neighbors_set_update(pmeta)
+    call set_neighbors_update(pmeta)
 
 #ifdef PROFILE
 ! stop accounting time for the block derefinement
@@ -2616,6 +2617,49 @@ module blocks
   end subroutine metablock_unset_update
 !
 !===============================================================================
+!
+! subroutine SET_NEIGHBORS_REFINE:
+! -------------------------------
+!
+!   Subroutine marks all neighbors (including edge and corner ones) of
+!   the meta block pointed by the input argument to be refined if they
+!   fell under some certain conditions.
+!
+!   Arguments:
+!
+!     pmeta    - a pointer to the refined meta block;
+!
+!===============================================================================
+!
+  subroutine set_neighbors_refine(pmeta)
+
+! local variables are not implicit by default
+!
+    implicit none
+
+! subroutine arguments
+!
+    type(block_meta), pointer, intent(inout) :: pmeta
+
+! local pointers
+!
+    procedure(reset_neighbors_update), pointer :: pprocedure
+!
+!-------------------------------------------------------------------------------
+!
+! prepare the procedure pointer
+!
+    pprocedure => reset_neighbors_refinement
+
+! iterate over all neighbors and coll pprocedure
+!
+    call iterate_over_neighbors(pmeta, pprocedure)
+
+!-------------------------------------------------------------------------------
+!
+  end subroutine set_neighbors_refine
+!
+!===============================================================================
 !!
 !!***  PRIVATE SUBROUTINES  ****************************************************
 !!
@@ -2848,19 +2892,19 @@ module blocks
 !
 !===============================================================================
 !
-! subroutine NEIGHBORDS_SET_UPDATE:
+! subroutine SET_NEIGHBORS_UPDATE:
-! --------------------------------
+! -------------------------------
 !
-!   Subroutine marks all the neighbors (including edge and corner ones) of
+!   Subroutine marks all neighbors (including edge and corner ones) of
-!   the meta block pointed by the input argument to be updated.
+!   the meta block pointed by the input argument to be updated too.
 !
 !   Arguments:
 !
-!     pmeta    - a pointer to the updated meta block;
+!     pmeta    - a pointer to the refined meta block;
 !
 !===============================================================================
 !
-  subroutine neighbors_set_update(pmeta)
+  subroutine set_neighbors_update(pmeta)
 
 ! local variables are not implicit by default
 !
@@ -2870,6 +2914,156 @@ module blocks
 !
     type(block_meta), pointer, intent(inout) :: pmeta
 
+! local pointers
+!
+    procedure(reset_neighbors_update), pointer :: pprocedure
+!
+!-------------------------------------------------------------------------------
+!
+! prepare the procedure pointer
+!
+    pprocedure => reset_neighbors_update
+
+! iterate over all neighbors and coll pprocedure
+!
+    call iterate_over_neighbors(pmeta, pprocedure)
+
+!-------------------------------------------------------------------------------
+!
+  end subroutine set_neighbors_update
+!
+!===============================================================================
+!
+! subroutine RESET_NEIGHBORS_UPDATE:
+! ---------------------------------
+!
+!   Subroutine set the neighbor to be updated as well.
+!
+!   Arguments:
+!
+!     pmeta    - a pointer to the refined meta block;
+!     pneigh   - a pointer to the neighbor meta block;
+!
+!===============================================================================
+!
+  subroutine reset_neighbors_update(pmeta, pneigh)
+
+! local variables are not implicit by default
+!
+    implicit none
+
+! subroutine arguments
+!
+    type(block_meta), pointer, intent(inout) :: pmeta, pneigh
+!
+!-------------------------------------------------------------------------------
+!
+! set the neighbor to be updated
+!
+    call metablock_set_update(pneigh)
+
+!-------------------------------------------------------------------------------
+!
+  end subroutine reset_neighbors_update
+!
+!===============================================================================
+!
+! subroutine RESET_NEIGHBORS_REFINEMENT:
+! -------------------------------------
+!
+!   Subroutine checks the level of the neighbor block and depending on
+!   the refinement flags of both block resets it to the correct value.
+!
+!   Arguments:
+!
+!     pmeta    - a pointer to the refined meta block;
+!     pneigh   - a pointer to the neighbor meta block;
+!
+!===============================================================================
+!
+  subroutine reset_neighbors_refinement(pmeta, pneigh)
+
+! local variables are not implicit by default
+!
+    implicit none
+
+! subroutine arguments
+!
+    type(block_meta), pointer, intent(inout) :: pmeta, pneigh
+!
+!-------------------------------------------------------------------------------
+!
+!=== conditions for blocks selected to be refined
+!
+    if (pmeta%refine == 1) then
+
+! if the neighbor is set to be derefined, reset its flag (this applies to
+! blocks at the current or lower level)
+!
+      pneigh%refine = max(0, pneigh%refine)
+
+! if the neighbor is at lower level, always set it to be refined
+!
+      if (pneigh%level < pmeta%level) pneigh%refine = 1
+
+    end if ! refine = 1
+
+!=== conditions for blocks which stay at the same level
+!
+    if (pmeta%refine == 0) then
+
+! if the neighbor lays at lower level and is set to be derefined, cancel its
+! derefinement
+!
+      if (pneigh%level < pmeta%level) pneigh%refine = max(0, pneigh%refine)
+
+    end if ! refine = 0
+
+!=== conditions for blocks which are selected to be derefined
+!
+    if (pmeta%refine == -1) then
+
+! if the neighbor is at lower level and is set to be derefined, cancel its
+! derefinement
+!
+      if (pneigh%level < pmeta%level) pneigh%refine = max(0, pneigh%refine)
+
+! if a neighbor is set to be refined, cancel the derefinement of current block
+!
+      if (pneigh%refine == 1) pmeta%refine = 0
+
+    end if ! refine = -1
+
+!-------------------------------------------------------------------------------
+!
+  end subroutine reset_neighbors_refinement
+!
+!===============================================================================
+!
+! subroutine ITERATE_OVER_NEIGHBORS:
+! ---------------------------------
+!
+!   Subroutine iterates over all neighbors of the meta block (including edge
+!   and corner ones) and executes a subroutine provided by the pointer.
+!
+!   Arguments:
+!
+!     pmeta - a pointer to the meta block which neighbors are iterated over;
+!     pproc - a pointer to the subroutine called with each pair (pmeta, pneigh);
+!
+!===============================================================================
+!
+  subroutine iterate_over_neighbors(pmeta, pprocedure)
+
+! local variables are not implicit by default
+!
+    implicit none
+
+! subroutine arguments
+!
+    type(block_meta)                 , pointer, intent(inout) :: pmeta
+    procedure(reset_neighbors_update), pointer, intent(in)    :: pprocedure
+
 ! local pointers
 !
     type(block_meta), pointer :: pneigh
@@ -2885,11 +3079,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2897,11 +3091,11 @@ module blocks
 !
     pneigh => pmeta%neigh(3,1,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,1,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2909,15 +3103,15 @@ module blocks
 !
     pneigh => pmeta%neigh(2,1,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,1,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(1,1,4)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -2928,11 +3122,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,2,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,1,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2940,11 +3134,11 @@ module blocks
 !
     pneigh => pmeta%neigh(3,1,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2952,15 +3146,15 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,1,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(2,2,4)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -2971,11 +3165,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2983,11 +3177,11 @@ module blocks
 !
     pneigh => pmeta%neigh(3,1,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,2,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -2995,15 +3189,15 @@ module blocks
 !
     pneigh => pmeta%neigh(2,2,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,1,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(1,2,3)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3014,11 +3208,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,1,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,2,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3026,11 +3220,11 @@ module blocks
 !
     pneigh => pmeta%neigh(3,1,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3038,15 +3232,15 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,1,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(2,1,3)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3057,11 +3251,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,2,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3069,11 +3263,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,1,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,1,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3081,15 +3275,15 @@ module blocks
 !
     pneigh => pmeta%neigh(3,2,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(1,1,2)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3100,11 +3294,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,2,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,2,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3112,11 +3306,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3124,15 +3318,15 @@ module blocks
 !
     pneigh => pmeta%neigh(3,2,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,1,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(2,2,2)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3143,11 +3337,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,2,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3155,11 +3349,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,2,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,2,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3167,15 +3361,15 @@ module blocks
 !
     pneigh => pmeta%neigh(3,2,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(1,2,1)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3186,11 +3380,11 @@ module blocks
 !
     pneigh => pmeta%neigh(2,1,4)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(3,2,4)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3198,11 +3392,11 @@ module blocks
 !
     pneigh => pmeta%neigh(3,2,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(1,2,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3210,15 +3404,15 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,3)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,3)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
 
         pneigh => pneigh%neigh(3,2,3)%ptr
         if (associated(pneigh)) then
-          call metablock_set_update(pneigh)
+          call pprocedure(pmeta, pneigh)
         end if
       end if
     end if
@@ -3230,11 +3424,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3242,11 +3436,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,1,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,2)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3254,11 +3448,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,1,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3266,11 +3460,11 @@ module blocks
 !
     pneigh => pmeta%neigh(1,2,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
 
       pneigh => pneigh%neigh(2,2,1)%ptr
       if (associated(pneigh)) then
-        call metablock_set_update(pneigh)
+        call pprocedure(pmeta, pneigh)
       end if
     end if
 
@@ -3278,34 +3472,34 @@ module blocks
 !
     pneigh => pmeta%neigh(2,1,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
     end if
 
 ! (½,0)-(1,0) edge
 !
     pneigh => pmeta%neigh(2,1,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
     end if
 
 ! (0,1)-(½,1) edge
 !
     pneigh => pmeta%neigh(2,2,1)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
     end if
 
 ! (½,1)-(1,1) edge
 !
     pneigh => pmeta%neigh(2,2,2)%ptr
     if (associated(pneigh)) then
-      call metablock_set_update(pneigh)
+      call pprocedure(pmeta, pneigh)
     end if
 #endif /* NDIMS == 3 */
 
 !-------------------------------------------------------------------------------
 !
-  end subroutine neighbors_set_update
+  end subroutine iterate_over_neighbors
 
 !===============================================================================
 !

src/mesh.F90

@@ -461,6 +461,7 @@ module mesh
     use blocks         , only : append_datablock, remove_datablock
     use blocks         , only : link_blocks, unlink_blocks, refine_block
     use blocks         , only : get_mblocks, get_nleafs
+    use blocks         , only : set_neighbors_refine
     use coordinates    , only : minlev, maxlev
     use domains        , only : setup_domain
     use error          , only : print_error
@@ -597,29 +598,9 @@ module mesh
 !
           if (pmeta%leaf .and. pmeta%level == lev .and. pmeta%refine == 1) then
 
-! iterate over all neighbors
+! select all neighbors which lay on lower levels to be refined as well
 !
-            do idir = 1, ndims
+            call set_neighbors_refine(pmeta)
-              do iside = 1, nsides
-                do iface = 1, nfaces
-
-! assign pointer to the neighbor
-!
-                  pneigh => pmeta%neigh(idir,iside,iface)%ptr
-
-! check if the neighbor is associated
-!
-                  if (associated(pneigh)) then
-
-! if the neighbor has lower level, select it to be refined too
-!
-                    if (pneigh%level < pmeta%level) pneigh%refine = 1
-
-                  end if ! neighbor's pointer is associated
-
-                end do ! iface
-              end do ! iside
-            end do ! idir
 
           end if ! leaf at level n and marked for refinement
 
@@ -786,6 +767,7 @@ module mesh
     use blocks         , only : get_nleafs
     use blocks         , only : refine_block, derefine_block
     use blocks         , only : append_datablock, remove_datablock, link_blocks
+    use blocks         , only : set_neighbors_refine
     use coordinates    , only : minlev, maxlev, toplev, im, jm, km
     use equations      , only : nv
     use error          , only : print_error
@@ -994,68 +976,9 @@ module mesh
 !
         if (pmeta%leaf .and. pmeta%level == l) then
 
-! iterte over all neighbors of the current leaf
+! select all neighbors which lay on lower levels to be refined as well
 !
-          do i = 1, ndims
+          call set_neighbors_refine(pmeta)
-            do j = 1, nsides
-              do k = 1, nfaces
-
-! assign a pointer to the current neighbor
-!
-                pneigh => pmeta%neigh(i,j,k)%ptr
-
-! check if the pointer is associated with any block
-!
-                if (associated(pneigh)) then
-
-!=== conditions for blocks selected to be refined
-!
-                  if (pmeta%refine == 1) then
-
-! if the neighbor is set to be derefined, reset its flag (this applies to
-! blocks at the current or lower level)
-!
-                    pneigh%refine = max(0, pneigh%refine)
-
-! if the neighbor is at lower level, always set it to be refined
-!
-                    if (pneigh%level < pmeta%level) pneigh%refine = 1
-
-                  end if ! refine = 1
-
-!=== conditions for blocks which stay at the same level
-!
-                  if (pmeta%refine == 0) then
-
-! if the neighbor lays at lower level and is set to be derefined, cancel its
-! derefinement
-!
-                    if (pneigh%level < pmeta%level)                            &
-                                         pneigh%refine = max(0, pneigh%refine)
-
-                  end if ! refine = 0
-
-!=== conditions for blocks which are selected to be derefined
-!
-                  if (pmeta%refine == -1) then
-
-! if the neighbor is at lower level and is set to be derefined, cancel its
-! derefinement
-!
-                    if (pneigh%level < pmeta%level)                            &
-                                         pneigh%refine = max(0, pneigh%refine)
-
-! if a neighbor is set to be refined, cancel the derefinement of current block
-!
-                    if (pneigh%refine == 1) pmeta%refine = 0
-
-                  end if ! refine = -1
-
-                end if ! associated(pneigh)
-
-              end do ! nfaces
-            end do ! nsides
-          end do ! ndims
 
         end if ! the leaf at level l