














































module carpet_region 
  
  implicit none

  integer, parameter :: wp = selected_real_kind(12,99)
  
  
  
  real(wp), dimension(2:1) :: empty
  integer, dimension(2:1) :: iempty
  
  
  
  
  
  
  
  type range
     integer :: lower, upper, stride
  end type range
  
  
  type bbox
     type(range), dimension(3) :: dim
  end type bbox
  
  
  type boundary
     integer, dimension(3,2) :: obound
  end type boundary
  

  type ptr
    type(superregion2), pointer :: point
  end type ptr
  type superregion2
    type(bbox) :: extent
    type(boundary) :: outer_boundaries
    integer :: map
    integer :: processor
    real(wp) :: frac
    type(ptr), pointer :: children(:)
  end type superregion2
  type superregion2slim
    type(bbox) :: extent
    type(boundary) :: outer_boundaries
    integer :: map
    integer :: processor
  end type superregion2slim
 
  contains





    subroutine create_sregion ( box, outerbound, map, sregion )
      type(bbox), intent(in) :: box
      type(boundary), intent(in) :: outerbound
      integer, intent(in) :: map


      type(superregion2), pointer :: sregion



      allocate ( sregion )
      sregion%extent = box
      sregion%outer_boundaries = outerbound
      sregion%map = map
      sregion%processor = -1
      sregion%frac = 0.0_wp
      nullify(sregion%children)

    end subroutine create_sregion
 






    subroutine disassociate ( sregion )


      type(superregion2), pointer :: sregion
      integer :: n, i


      if ( associated(sregion%children) ) then
        n = size(sregion%children)
        do i = 1, n
          nullify ( sregion%children(i)%point )
        end do
      end if
    end subroutine disassociate




    subroutine point_to_children ( sregion1, sregion2 )



      type(superregion2), pointer :: sregion1
      type(superregion2), pointer :: sregion2
      integer :: n1, n2, i


      if ( associated(sregion2%children) ) then
        n2 = size(sregion2%children)



        if ( associated(sregion1%children) ) then
          n1 = size(sregion1%children)
          do i = 1, n1
            call destroy_sregion ( sregion1%children(i)%point )
          end do
        end if


        allocate ( sregion1%children(n2) )
        do i = 1, n2
          sregion1%children(i)%point => sregion2%children(i)%point
        end do


      else
        print*, 'Warning sregion2 has no children'
      end if  
    end subroutine point_to_children
      


    recursive subroutine destroy_sregion ( sregion )


      type(superregion2), pointer :: sregion
      integer :: n, i


      if ( associated(sregion%children) ) then


        n = size(sregion%children)


        do i = 1, n


          if ( associated ( sregion%children(i)%point ) ) then
            call destroy_sregion ( sregion%children(i)%point )
          end if
        end do


        if ( n > 0 ) then
          deallocate ( sregion%children )
        end if
      end if


      deallocate (sregion)

    end subroutine destroy_sregion




    recursive subroutine print_tree ( sregion )


      type(superregion2), pointer :: sregion
      integer :: n, i
      


      if ( associated(sregion) ) then
        print*, 'bbox = ', sregion%extent
        print*, 'outer_boundaries = ', sregion%outer_boundaries
        print*, 'map = ', sregion%map
        print*, 'processor = ', sregion%processor
        print*, 'fraction = ', sregion%frac


        if ( .not. associated(sregion%children) ) then
          print*, 'No children '
          print*


        else
          n = size(sregion%children)
          print*, 'Number of children = ', n
          print*
          print*
          do i = 1, n
            call print_tree ( sregion%children(i)%point )
            print*
          end do
        end if
      else
        print*, "Pointer to super region not associated"
        print*
      end if

    end subroutine print_tree







    subroutine split_sregion ( sregion, dir, frac )


      type(superregion2), pointer :: sregion
      integer, intent(in) :: dir
      integer, dimension(:), intent(in) :: frac
      type(bbox), dimension(size(frac)+1) :: newboxes
      type(boundary), dimension(size(frac)+1) :: newboundaries
      integer :: n, i, lo, up, str


      n = size(frac)


      if (n>0) then


        allocate(sregion%children(n+1))



        lo = sregion%extent%dim(dir)%lower
        up = sregion%extent%dim(dir)%upper
        str = sregion%extent%dim(dir)%stride


        do i = 1, n+1
          newboxes(i) = sregion%extent
          newboundaries(i) = sregion%outer_boundaries
        end do




        do i = 1, n
          newboxes(i)%dim(dir)%upper = lo + ( frac(i) - 1 ) * str
          newboxes(i+1)%dim(dir)%lower = newboxes(i)%dim(dir)%upper + str
          newboundaries(i)%obound(dir,2) = 0
          newboundaries(i+1)%obound(dir,1) = 0
        end do




        do i = 1, n+1
          allocate ( sregion%children(i)%point )
          sregion%children(i)%point%extent = newboxes(i)
          sregion%children(i)%point%outer_boundaries = newboundaries(i)
          sregion%children(i)%point%map = sregion%map
          sregion%children(i)%point%processor = sregion%processor
          sregion%children(i)%point%frac = 0.0_wp
          nullify(sregion%children(i)%point%children)
        end do
      end if

    end subroutine split_sregion
          
end module carpet_region
