! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine set_locate_atom

  use condition_ini
  use locate_atom

  implicit none
  integer :: kx,ky,i1_do,i2_do,i1_count,i2_count,num_unit_temp1,num_unit_temp2
  integer :: jr_do
  real(8) :: rz_temp

  if( p_or_f_l == 'free' ) then
     num_atom_lt=num_atom_l*neighbor_x_max_l*neighbor_y_max_l
  else
     if( p_or_f_l == 'periodic' ) then
        num_atom_lt=num_atom_l
     else
        write(6,*) 'error_locate: set_locate_atom 1'
        stop
     end if
  end if
  if( p_or_f_r == 'free' ) then
     num_atom_rt=num_atom_r*neighbor_x_max_r*neighbor_y_max_r
  else
     if( p_or_f_r == 'periodic' ) then
        num_atom_rt=num_atom_r
     else
        write(6,*) 'error_locate: set_locate_atom 2'
        stop
     end if
  end if

  num_atom_ctotal=m_num_block_l*num_atom_lt+m_num_block_m*num_atom_c           &
       +m_num_block_r*num_atom_rt

  call alo_locate_atom


  i1_count=0
  if( p_or_f_l == 'free' ) then
     num_unit_temp1=num_unit_l(1)
     num_unit_temp2=num_unit_l(2)
  else
     if( p_or_f_l == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
     else
        write(6,*) 'error_locate: set_locate_atom 3'
        stop
     end if
  end if
  do kx=1,num_unit_temp1
     do ky=1,num_unit_temp2
        do i1_do=1,num_atom_l
           i1_count=i1_count+1
           do jr_do=1,3
              r_l(i1_count,jr_do)=ra_l(i1_do,jr_do)                                &
                   +dfloat(kx-1)*unit_block_l(1,jr_do)              &
                   +dfloat(ky-1)*unit_block_l(2,jr_do)
           end do
        end do
     end do
  end do


  rz_temp=0.d0
  i1_count=0
  i2_count=0

  if( p_or_f_l == 'free' ) then
     num_unit_temp1=num_unit_l(1)
     num_unit_temp2=num_unit_l(2)
  else
     if( p_or_f_l == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
     else
        write(6,*) 'error_locate: set_locate_atom 4'
        stop
     end if
  end if
  do i1_do=1,m_num_block_l
     i2_count=i2_count+1
     rz_temp=rz_temp+unit_block_l(3,3)
     do kx=1,num_unit_temp1
        do ky=1,num_unit_temp2
           do i2_do=1,num_atom_l
              i1_count=i1_count+1
              do jr_do=1,3
                 r_c(i1_count,jr_do)=ra_l(i2_do,jr_do)                              &
                      +dfloat(kx-1)*unit_block_l(1,jr_do)             &
                      +dfloat(ky-1)*unit_block_l(2,jr_do)
              end do
              r_c(i1_count,3)=r_c(i1_count,3)+rz_temp
              atom_kindn_ccal(i1_count)=atom_kindn_l(i2_do)
              i_lmr(i1_count)=-1
              i_locate(i1_count)=i2_count
           end do
        end do
     end do
  end do

  rz_temp=rz_temp+r_dis_l
  do i2_do=1,m_num_block_m
     i2_count=i2_count+1
     do i1_do=1,num_atom_c
        i1_count=i1_count+1
        r_c(i1_count,1)=ra_c(i1_do,1)
        r_c(i1_count,2)=ra_c(i1_do,2)
        r_c(i1_count,3)=ra_c(i1_do,3)+rz_temp
        atom_kindn_ccal(i1_count)=atom_kindn_c(i1_do)
        i_lmr(i1_count)=0
        i_locate(i1_count)=i2_count
     end do
     rz_temp=rz_temp+unit_block_c(3,3)
  end do

  if( p_or_f_r == 'free' ) then
     num_unit_temp1=num_unit_r(1)
     num_unit_temp2=num_unit_r(2)
  else
     if( p_or_f_r == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
     else
        write(6,*) 'error_locate: set_locate_atom 5'
        stop
     end if
  end if
  rz_temp=rz_temp+r_dis_r
  do i1_do=1,m_num_block_r
     i2_count=i2_count+1
     do kx=1,num_unit_temp1
        do ky=1,num_unit_temp2
           do i2_do=1,num_atom_r
              i1_count=i1_count+1
              do jr_do=1,3
                 r_c(i1_count,jr_do)=ra_r(i2_do,jr_do)                              &
                      +dfloat(kx-1)*unit_block_r(1,jr_do)            &
                      +dfloat(ky-1)*unit_block_r(2,jr_do)
              end do
              r_c(i1_count,3)=r_c(i1_count,3)+rz_temp
              atom_kindn_ccal(i1_count)=atom_kindn_r(i2_do)
              i_lmr(i1_count)=1
              i_locate(i1_count)=i2_count
           end do
        end do
     end do
     rz_temp=rz_temp+unit_block_r(3,3)
  end do


  rz_temp=dfloat(m_num_block_l)*unit_block_l(3,3)                              &
       +r_dis_l+dfloat(m_num_block_m)*unit_block_c(3,3)+r_dis_r              &
       +dfloat(m_num_block_r)*unit_block_r(3,3)
  i1_count=0

  if( p_or_f_r == 'free' ) then
     num_unit_temp1=num_unit_r(1)
     num_unit_temp2=num_unit_r(2)
  else
     if( p_or_f_r == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
     else
        write(6,*) 'error_locate: set_locate_atom 6'
        stop
     end if
  end if
  do kx=1,num_unit_temp1
     do ky=1,num_unit_temp2
        do i1_do=1,num_atom_r
           i1_count=i1_count+1
           do jr_do=1,3
              r_r(i1_count,jr_do)=ra_r(i1_do,jr_do)                                &
                   +dfloat(kx-1)*unit_block_r(1,jr_do)              &
                   +dfloat(ky-1)*unit_block_r(2,jr_do)
           end do
           r_r(i1_count,3)=r_r(i1_count,3)+rz_temp
        end do
     end do
  end do


  if( ham_model_ini .eq. 'gsp' ) then
     call set_locate_atom_pair
  end if

  return
end subroutine set_locate_atom

subroutine set_locate_atom_pair                                     ! for GSP model

  use condition_ini
  use locate_atom
  use gsp_parameter

  implicit none
  integer :: i1_do,i2_do,i3_do

  call alo_locate_atom_pair


  do i1_do=1,num_atom_ctotal
     do i2_do=1,num_atom_ctotal
        do i3_do=1,num_atom_kind_ini*num_atom_kind_ini
           if( atom_sign_ini(atom_kindn_ccal(i1_do))                              &
                == atom_parameter(i3_do,1)                      &
                .and. atom_sign_ini(atom_kindn_ccal(i2_do))                       &
                == atom_parameter(i3_do,2) ) then
              pair_num_ccal(i1_do,i2_do)=i3_do
              go to 10
           end if
        end do
        write(6,*) 'error - set_pair (lo_mm)'
        stop
10      continue
     end do
  end do

  return
end subroutine set_locate_atom_pair
