module mem_manager
  use model_info
  use datatype
  implicit none
  real(8), parameter :: no_def_value = 1.0D0

!--FOR x
  integer, save :: current_addr_x = 1
  integer, save :: max_addr_x
  real(8),dimension(:,:,:,:), allocatable, save :: work_x 
  logical, dimension(:), allocatable, save :: free_mask_x
  integer, dimension(:), allocatable, save :: linked_counter_x

!--FOR y
  integer, save :: current_addr_y = 1
  integer, save :: max_addr_y
  real(8),dimension(:,:,:,:), allocatable, save :: work_y 
  logical, dimension(:), allocatable, save :: free_mask_y
  integer, dimension(:), allocatable, save :: linked_counter_y

!--FOR z
  integer, save :: current_addr_z = 1
  integer, save :: max_addr_z
  real(8),dimension(:,:,:,:), allocatable, save :: work_z 
  logical, dimension(:), allocatable, save :: free_mask_z
  integer, dimension(:), allocatable, save :: linked_counter_z

!--FOR xy
  integer, save :: current_addr_xy = 1
  integer, save :: max_addr_xy
  real(8),dimension(:,:,:,:), allocatable, save :: work_xy 
  logical, dimension(:), allocatable, save :: free_mask_xy
  integer, dimension(:), allocatable, save :: linked_counter_xy

!--FOR xz
  integer, save :: current_addr_xz = 1
  integer, save :: max_addr_xz
  real(8),dimension(:,:,:,:), allocatable, save :: work_xz 
  logical, dimension(:), allocatable, save :: free_mask_xz
  integer, dimension(:), allocatable, save :: linked_counter_xz

!--FOR yz
  integer, save :: current_addr_yz = 1
  integer, save :: max_addr_yz
  real(8),dimension(:,:,:,:), allocatable, save :: work_yz 
  logical, dimension(:), allocatable, save :: free_mask_yz
  integer, dimension(:), allocatable, save :: linked_counter_yz

!--FOR xyz
  integer, save :: current_addr_xyz = 1
  integer, save :: max_addr_xyz
  real(8),dimension(:,:,:,:), allocatable, save :: work_xyz 
  logical, dimension(:), allocatable, save :: free_mask_xyz
  integer, dimension(:), allocatable, save :: linked_counter_xyz
contains
  
!--FOR x (1,0,0)
  subroutine allocate_work_area_x(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_x(lb_axis1:ub_axis1, 1, 1, max_address), stat=work_i )
    allocate( free_mask_x(max_address), stat=mask_i )
    allocate( linked_counter_x(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area X is NOT allocated!!'
    end if

    free_mask_x = .true.
    linked_counter_x = 0

    work_x = no_def_value

    max_addr_x = max_address

  end subroutine allocate_work_area_x

!--FOR Y (0,1,0)
  subroutine allocate_work_area_y(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_y(1, lb_axis2:ub_axis2, 1, max_address), stat=work_i )
    allocate( free_mask_y(max_address), stat=mask_i )
    allocate( linked_counter_y(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area Y is NOT allocated!!'
    end if

    free_mask_y = .true.
    linked_counter_y = 0

    work_y = no_def_value

    max_addr_y = max_address
    
  end subroutine allocate_work_area_y

!--FOR Z (0,0,1)
  subroutine allocate_work_area_z(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_z(1, 1, lb_axis3:ub_axis3, max_address), stat=work_i )
    allocate( free_mask_z(max_address), stat=mask_i )
    allocate( linked_counter_z(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area Z is NOT allocated!!'
    end if

    free_mask_z = .true.
    linked_counter_z = 0

    work_z = no_def_value

    max_addr_z = max_address
    
  end subroutine allocate_work_area_z 

!--FOR XY(1,1,0)
  subroutine allocate_work_area_xy(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_xy(lb_axis1:ub_axis1, lb_axis2:ub_axis2, 1, max_address), stat=work_i )
    allocate( free_mask_xy(max_address), stat=mask_i )
    allocate( linked_counter_xy(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area XY is NOT allocated!!'
    end if

    free_mask_xy = .true.
    linked_counter_xy = 0

    work_xy = no_def_value

    max_addr_xy = max_address
    
  end subroutine allocate_work_area_xy

!--FOR XZ(1,0,1)
  subroutine allocate_work_area_xz(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_xz(lb_axis1:ub_axis1, 1, lb_axis3:ub_axis3, max_address), stat=work_i )
    allocate( free_mask_xz(max_address), stat=mask_i )
    allocate( linked_counter_xz(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area XZ is NOT allocated!!'
    end if

    free_mask_xz = .true.
    linked_counter_xz = 0

    work_xz = no_def_value

    max_addr_xz = max_address
    
  end subroutine allocate_work_area_xz

!--FOR YZ (0,1,1)
  subroutine allocate_work_area_yz(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_yz(1, lb_axis2:ub_axis2, lb_axis3:ub_axis3, max_address), stat=work_i )
    allocate( free_mask_yz(max_address), stat=mask_i )
    allocate( linked_counter_yz(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area YZ is NOT allocated!!'
    end if

    free_mask_yz = .true.
    linked_counter_yz = 0

    work_yz = no_def_value

    max_addr_yz = max_address
    
  end subroutine allocate_work_area_yz

!--FOR XYZ(1,1,1)
  subroutine allocate_work_area_xyz(max_address)
    integer, intent(in) :: max_address
    integer :: work_i, mask_i, counter_i

    allocate( work_xyz(lb_axis1:ub_axis1,lb_axis2:ub_axis2,lb_axis3:ub_axis3,max_address), stat=work_i )
    allocate( free_mask_xyz(max_address), stat=mask_i )
    allocate( linked_counter_xyz(max_address), stat=counter_i )

    if (work_i /= 0 .or. mask_i /= 0 .or. counter_i /=0) then 
       write(*,*)'[WARNING]work area XYZ is NOT allocated!!'
    end if

    free_mask_xyz = .true.
    linked_counter_xyz = 0

    work_xyz = no_def_value

    max_addr_xyz = max_address
    
  end subroutine allocate_work_area_xyz


!-----------------------
!
! Set_save_var
!
! work area上で計算結果に対応する値が入っているアドレスには印を付けておく。
! 一番最初はユーザーがこれを行わないといけない。
!
!-----------------------

!--- FOR X
  subroutine set_save_var_x(invar)
    type(var_x) :: invar

    do 
       if ( free_mask_x(current_addr_x) ) exit
       current_addr_x = current_addr_x + 1
       if ( current_addr_x > max_addr_x ) stop 'working area X'
    end do

    invar%id = current_addr_x

    free_mask_x(current_addr_x) = .false.

    linked_counter_x(current_addr_x) = 1 

    current_addr_x = current_addr_x + 1
  end subroutine set_save_var_x


!--- FOR Y
  subroutine set_save_var_y(invar)
    type(var_y) :: invar

    do 
       if ( free_mask_y(current_addr_y) ) exit
       current_addr_y = current_addr_y + 1
       if ( current_addr_y > max_addr_y ) stop 'working area Y'
    end do

    invar%id = current_addr_y

    free_mask_y(current_addr_y) = .false.

    linked_counter_y(current_addr_y) = 1 

    current_addr_y = current_addr_y + 1
  end subroutine set_save_var_y

!--- FOR Z
  subroutine set_save_var_z(invar)
    type(var_z) :: invar

    do 
       if ( free_mask_z(current_addr_z) ) exit
       current_addr_z = current_addr_z + 1
       if ( current_addr_z > max_addr_z ) stop 'working area Z'
    end do

    invar%id = current_addr_z

    free_mask_z(current_addr_z) = .false.

    linked_counter_z(current_addr_z) = 1 

    current_addr_z = current_addr_z + 1
  end subroutine set_save_var_z

!--- FOR XY
  subroutine set_save_var_xy(invar)
    type(var_xy) :: invar

    do 
       if ( free_mask_xy(current_addr_xy) ) exit
       current_addr_xy = current_addr_xy + 1
       if ( current_addr_xy > max_addr_xy ) stop 'working area XY'
    end do

    invar%id = current_addr_xy

    free_mask_xy(current_addr_xy) = .false.

    linked_counter_xy(current_addr_xy) = 1 

    current_addr_xy = current_addr_xy + 1
  end subroutine set_save_var_xy

!--- FOR XZ
  subroutine set_save_var_xz(invar)
    type(var_xz) :: invar

    do 
       if ( free_mask_xz(current_addr_xz) ) exit
       current_addr_xz = current_addr_xz + 1
       if ( current_addr_xz > max_addr_xz ) stop 'working area XZ'
    end do

    invar%id = current_addr_xz

    free_mask_xz(current_addr_xz) = .false.

    linked_counter_xz(current_addr_xz) = 1 

    current_addr_xz = current_addr_xz + 1
  end subroutine set_save_var_xz

!--- FOR YZ
  subroutine set_save_var_yz(invar)
    type(var_yz) :: invar

    do 
       if ( free_mask_yz(current_addr_yz) ) exit
       current_addr_yz = current_addr_yz + 1
       if ( current_addr_yz > max_addr_yz ) stop 'working area YZ'
    end do

    invar%id = current_addr_yz

    free_mask_yz(current_addr_yz) = .false.

    linked_counter_yz(current_addr_yz) = 1 

    current_addr_yz = current_addr_yz + 1
  end subroutine set_save_var_yz

!--- FOR XYZ
  subroutine set_save_var_xyz(invar)
    type(var_xyz) :: invar 

    do 
       if ( free_mask_xyz(current_addr_xyz) ) exit
       current_addr_xyz = current_addr_xyz + 1
       if ( current_addr_xyz > max_addr_xyz ) stop 'working area XYZ'
    end do

    invar%id = current_addr_xyz

    free_mask_xyz(current_addr_xyz) = .false.

    linked_counter_xyz(current_addr_xyz) = 1 

    current_addr_xyz = current_addr_xyz + 1
  end subroutine set_save_var_xyz

!------------------------------
!
! Get_new_id
!
! work area 上のあいてるアドレスを問い合わせる
!
! ０割をさけるためそのアドレスには０でない値no_def_valueを代入しておく。
!------------------------------

!-- FOR X
  subroutine get_new_id_x(new_id)
    integer :: new_id
    
    do 
       if (free_mask_x(current_addr_x)) exit
       current_addr_x = current_addr_x + 1
       if (current_addr_x > max_addr_x) stop 'working area X' 
    end do

    new_id = current_addr_x

    work_x(:,:,:,new_id) = no_def_value

    current_addr_x = current_addr_x + 1
  end subroutine get_new_id_x

!-- FOR Y
  subroutine get_new_id_y(new_id)
    integer :: new_id
    
    do 
       if (free_mask_y(current_addr_y)) exit
       current_addr_y = current_addr_y + 1
       if (current_addr_y > max_addr_y) stop 'working area Y' 
    end do

    new_id = current_addr_y

    work_y(:,:,:,new_id) = no_def_value

    current_addr_y = current_addr_y + 1
  end subroutine get_new_id_y

!-- FOR Z
  subroutine get_new_id_z(new_id)
    integer :: new_id
    do 
       if (free_mask_z(current_addr_z)) exit
       current_addr_z = current_addr_z + 1
       if (current_addr_z > max_addr_z) stop 'working area Z' 
    end do

    new_id = current_addr_z

    work_z(:,:,:,new_id) = no_def_value

    current_addr_z = current_addr_z + 1
  end subroutine get_new_id_z

!-- FOR XY
  subroutine get_new_id_xy(new_id)
    integer :: new_id
    
    do 
       if (free_mask_xy(current_addr_xy)) exit
       current_addr_xy = current_addr_xy + 1
       if (current_addr_xy > max_addr_xy) stop 'working area XY' 
    end do

    new_id = current_addr_xy

    work_xy(:,:,:,new_id) = no_def_value

    current_addr_xy = current_addr_xy + 1
  end subroutine get_new_id_xy

!-- FOR XZ
  subroutine get_new_id_xz(new_id)
    integer :: new_id
    
    do 
       if (free_mask_xz(current_addr_xz)) exit
       current_addr_xz = current_addr_xz + 1
       if (current_addr_xz > max_addr_xz) stop 'working area XZ' 
    end do

    new_id = current_addr_xz

    work_xz(:,:,:,new_id) = no_def_value

    current_addr_xz = current_addr_xz + 1
  end subroutine get_new_id_xz

!-- FOR YZ
  subroutine get_new_id_yz(new_id)
    integer :: new_id
    
    do 
       if (free_mask_yz(current_addr_yz)) exit
       current_addr_yz = current_addr_yz + 1
       if (current_addr_yz > max_addr_yz) stop 'working area YZ' 
    end do

    new_id = current_addr_yz

    work_yz(:,:,:,new_id) = no_def_value

    current_addr_yz = current_addr_yz + 1
  end subroutine get_new_id_yz

!-- FOR XYZ
  subroutine get_new_id_xyz(new_id)
    integer :: new_id
    
    do 
       if (free_mask_xyz(current_addr_xyz)) exit
       current_addr_xyz = current_addr_xyz + 1
       if (current_addr_xyz > max_addr_xyz) stop 'working area XYZ' 
    end do

    new_id = current_addr_xyz

    work_xyz(:,:,:,new_id) = no_def_value

    current_addr_xyz = current_addr_xyz + 1
  end subroutine get_new_id_xyz

!---------------------
!
! Free_mask_update
!
! work areaにつけられている計算結果の印を新しい場所に付け替える
!
!---------------------

!-- FOR X
  subroutine free_mask_update_x(old_id, new_id)
    integer old_id, new_id

    free_mask_x(old_id) = .true.
    free_mask_x(new_id) = .false.

  end subroutine free_mask_update_x

!-- FOR Y
  subroutine free_mask_update_y(old_id, new_id)
    integer old_id, new_id

    free_mask_y(old_id) = .true.
    free_mask_y(new_id) = .false.

  end subroutine free_mask_update_y

!-- FOR Z
  subroutine free_mask_update_z(old_id, new_id)
    integer old_id, new_id

    free_mask_z(old_id) = .true.
    free_mask_z(new_id) = .false.

  end subroutine free_mask_update_z

!-- FOR XY
  subroutine free_mask_update_xy(old_id, new_id)
    integer old_id, new_id

    free_mask_xy(old_id) = .true.
    free_mask_xy(new_id) = .false.

  end subroutine free_mask_update_xy

!-- FOR XZ
  subroutine free_mask_update_xz(old_id, new_id)
    integer old_id, new_id

    free_mask_xz(old_id) = .true.
    free_mask_xz(new_id) = .false.

  end subroutine free_mask_update_xz

!-- FOR YZ
  subroutine free_mask_update_yz(old_id, new_id)
    integer old_id, new_id

    free_mask_yz(old_id) = .true.
    free_mask_yz(new_id) = .false.

  end subroutine free_mask_update_yz

!-- FOR XYZ
  subroutine free_mask_update_xyz(old_id, new_id)
    integer old_id, new_id

    free_mask_xyz(old_id) = .true.
    free_mask_xyz(new_id) = .false.

  end subroutine free_mask_update_xyz

!------------------------
!
! Garbege_collect
!
! ゴミ集め。やってるのはAddress counterを1にリセットするだけ。
!
!------------------------
!
!---FOR X
  subroutine garbege_collect

    current_addr_x = 1
!---FOR Y
    current_addr_y = 1
!---FOR Z
    current_addr_z = 1
!---FOR XY
    current_addr_xy = 1
!---FOR XZ
    current_addr_xz = 1
!---FOR YZ
    current_addr_yz = 1
!---FOR XYZ
    current_addr_xyz = 1

  end subroutine garbege_collect

end module mem_manager
