amr_neighbors.t

Go to the documentation of this file.

!> find neighors of level-one root blocks
subroutine find_root_neighbor(tree_neighbor,tree,i^D)
  use mod_forest
  use mod_global_parameters
  use mod_geometry
 
  type(tree_node_ptr) :: tree_neighbor, tree
  integer, intent(in) :: i^D
 
  integer :: jg^D
 
  jg^d=tree%node%ig^d+i^d;
 
  ! find the periodic grid indices, modulo(-1,10)=9
  {if (periodb(^d)) jg^d=1+modulo(jg^d-1,ng^d(1))\}
 
  ! pi-periodicity at pole
  select case (coordinate)
  case (spherical) {^ifthreed
     if (poleb(1,2).and.jg2==0) then ! northpole (theta=0)
        jg2=1; jg3=1+modulo(jg3+ng3(1)/2-1,ng3(1))
     end if
     if (poleb(2,2).and.jg2==ng2(1)+1) then ! southpole (theta=pi)
        jg2=ng2(1); jg3=1+modulo(jg3+ng3(1)/2-1,ng3(1))
     end if}
  case (cylindrical)
     if (poleb(1,1).and.jg1==0) then ! cylindrical axis
        jg1=1
        {if (^d==phi_) jg^d=1+modulo(jg^d+ng^d(1)/2-1,ng^d(1))\}
     end if
  end select
 
  if (jg^d>=1.and.jg^d<=ng^d(1)|.and.) then
     tree_neighbor%node => tree_root(jg^d)%node
  else
     nullify(tree_neighbor%node)
  end if
 
end subroutine find_root_neighbor
 
!> find neighors of all blocks
subroutine find_neighbor(my_neighbor,my_neighbor_type,tree,i^D,pole)
  use mod_forest
  use mod_global_parameters
 
  type(tree_node_ptr) :: tree, my_neighbor
  integer, intent(in) :: i^D
  integer, intent(out) :: my_neighbor_type
  logical, dimension(ndim), intent(out) :: pole
 
  integer :: level, ig^D, ic^D, n_ic^D, inp^D
 
  pole=.false.
  level=tree%node%level
  if (level==1) then
     call find_root_neighbor(my_neighbor,tree,i^d)
     if (associated(my_neighbor%node)) then
       if (phi_ > 0) then
         ig^d=tree%node%ig^d;
         {if ((poleb(2,^d).and.ig^d==ng^d(1).and.i^d==1) .or. &
              (poleb(1,^d).and.ig^d==1.and.i^d==-1)) pole(^d)=.true.\}
       end if
        if (my_neighbor%node%leaf) then
           my_neighbor_type=3
        else
           my_neighbor_type=4
        end if
     else
        my_neighbor_type=1
        return
     end if
  else
     ig^d=tree%node%ig^d;
 
     if (phi_ > 0) then
       {if ((poleb(2,^d).and.ig^d==ng^d(level).and.i^d==1) .or. &
            (poleb(1,^d).and.ig^d==1.and.i^d==-1)) pole(^d)=.true.\}
     end if
 
     ! ic^D is 1 when ig^D is odd, is 2 when ig^D is even
     ic^d=1+modulo(ig^d-1,2);
     inp^d=int((ic^d+i^d+1)/2)-1;
     my_neighbor%node => tree%node%parent%node
     {if (inp^d/=0) then
        my_neighbor%node => my_neighbor%node%neighbor(ic^d,^d)%node
        if (.not.associated(my_neighbor%node)) then
           my_neighbor_type=1
           return
        end if
     end if\}
     if (my_neighbor%node%leaf) then
        my_neighbor_type=2
     else
        {if (i^d==0 .or. pole(^d)) then
           n_ic^d=ic^d
        else
           n_ic^d=3-ic^d ! switch 1 <--> 2
        end if\}
        my_neighbor%node => my_neighbor%node%child(n_ic^d)%node
        if (associated(my_neighbor%node)) then
           if (my_neighbor%node%leaf) then
              my_neighbor_type=3
           else
              my_neighbor_type=4
           end if
        else
           my_neighbor_type=0
        end if
     end if
  end if
 
end subroutine find_neighbor
 
!> asign tree node neighor
subroutine asign_tree_neighbor(tree)
  use mod_forest
  use mod_global_parameters
 
  type(tree_node_ptr) :: tree
 
  logical, dimension(ndim) :: pole
  integer :: my_neighbor_type, i^D, iside
  type(tree_node_ptr) :: my_neighbor
 
  {do iside=1,2
     i^dd=kr(^dd,^d)*(2*iside-3);
     call find_neighbor(my_neighbor,my_neighbor_type,tree,i^dd,pole)
     select case (my_neighbor_type)
     case (neighbor_sibling, neighbor_fine)
        tree%node%neighbor(iside,^d)%node => my_neighbor%node
        if (associated(my_neighbor%node)) then
           if (pole(^d)) then
              my_neighbor%node%neighbor(iside,^d)%node => tree%node
           else
              my_neighbor%node%neighbor(3-iside,^d)%node => tree%node
           end if
        end if
     case default
        nullify(tree%node%neighbor(iside,^d)%node)
     end select
  end do\}
 
end subroutine asign_tree_neighbor