reallocate_tree Subroutine

private pure subroutine reallocate_tree(tree, alloc_count)

Arguments

Type IntentOptional Attributes Name
type(tree_node_t), intent(inout), allocatable :: tree(:)
integer, intent(inout) :: alloc_count

Source Code

   pure subroutine reallocate_tree(tree, alloc_count)
      implicit none
      type(tree_node_t), allocatable, intent(inout) :: tree(:)
      integer,                    intent(inout)    :: alloc_count
      
      type(tree_node_t), allocatable  :: tmp(:)
      integer                     :: new_part_begin, new_part_end, i

      if (.not. allocated(tree)) then
         allocate(tree(TREE_NODE_BASE:TREE_NODE_UNIT))
         alloc_count = 1
         return
      end if

      new_part_begin = ubound(tree, dim=1) + 1
      new_part_end   = ubound(tree, dim=1)*2

      if (new_part_end > TREE_NODE_HARD_LIMIT) then
         error stop "Exceeded the maximum number of tree nodes can be allocated."
      end if

      call move_alloc(tree, tmp)

      allocate(tree(TREE_NODE_BASE:new_part_end))
      alloc_count = alloc_count + 1

      ! Deep copy
      tree(TREE_NODE_BASE:new_part_begin-1) = tmp(TREE_NODE_BASE:new_part_begin-1)
      
      ! Initialize new part
      tree(new_part_begin:new_part_end)%own_i = [(i, i = new_part_begin, new_part_end)]

      ! deallocate old tree
      deallocate(tmp)
   end subroutine reallocate_tree