! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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_bound_cell_lr

  use condition_ini
  use scf_negf

  implicit none
  integer :: i_do
  integer, allocatable :: num_temp(:)

  do i_do=1,num_atom_scf
     i_atom_num(i_do)=i_do
  end do
  do i_do=1,num_atom_scf
     i_atom_invnum(i_do)=i_do
  end do

  i_orb(1)=0
  do i_do=1,num_atom_scf
     i_orb(i_do+1)=i_orb(i_do)+iatom_orb_num(i_do)
  end do

  return
end subroutine set_bound_cell_lr
subroutine make_cell_lr

  use scf_negf
  use constant

  implicit none
  integer :: n1,n2,n3,ier,m1,m2
  real(8) :: temp_l,temp_r,th1,th2,h1,h2,r1,r2,al1,al2,be1,be2

  cell_dlabc(1,1)=cell_labc(1,1)/dfloat(n_a)
  cell_dlabc(1,2)=cell_labc(1,2)/dfloat(n_a)
  cell_dlabc(1,3)=cell_labc(1,3)/dfloat(n_a)
  cell_dlabc(2,1)=cell_labc(2,1)/dfloat(n_b)
  cell_dlabc(2,2)=cell_labc(2,2)/dfloat(n_b)
  cell_dlabc(2,3)=cell_labc(2,3)/dfloat(n_b)
  cell_dlabc(3,1)=cell_labc(3,1)/dfloat(n_c)
  cell_dlabc(3,2)=cell_labc(3,2)/dfloat(n_c)
  cell_dlabc(3,3)=cell_labc(3,3)/dfloat(n_c)

  del_cell_l=dsqrt(cell_dlabc(3,1)*cell_dlabc(3,1)                             &
       +cell_dlabc(3,2)*cell_dlabc(3,2)+cell_dlabc(3,3)*cell_dlabc(3,3))

  ier=0
  do n1=0,n_a-1
     do n2=0,n_b-1
        do n3=0,n_c-1
           ier=ier+1
           cell_lr(1,ier)=dfloat(n1)*cell_dlabc(1,1)+dfloat(n2)*cell_dlabc(2,1)   &
                +dfloat(n3)*cell_dlabc(3,1)
           cell_lr(2,ier)=dfloat(n1)*cell_dlabc(1,2)+dfloat(n2)*cell_dlabc(2,2)   &
                +dfloat(n3)*cell_dlabc(3,2)
           cell_lr(3,ier)=dfloat(n1)*cell_dlabc(1,3)+dfloat(n2)*cell_dlabc(2,3)   &
                +dfloat(n3)*cell_dlabc(3,3)
        end do
     end do
  end do


  do n3=0,n_c
     cell_lr_z(n3+1)=dfloat(n3)*cell_dlabc(3,1)
  end do


  pai=datan(1.d0)*4.d0

  th1=datan2(cell_labc(1,3),cell_labc(1,2))
  th2=datan2(cell_labc(2,3),cell_labc(2,2))
  al1=dcos(th1)
  al2=dsin(th1)
  be1=dcos(th2)
  be2=dsin(th2)

  r1=2.d0*pai/dsqrt(cell_labc(1,2)*cell_labc(1,2)+cell_labc(1,3)*cell_labc(1,3))
  r2=2.d0*pai/dsqrt(cell_labc(2,2)*cell_labc(2,2)+cell_labc(2,3)*cell_labc(2,3))
  r1=dsqrt(cell_dkabc(1,2)*cell_dkabc(1,2)+cell_dkabc(1,3)*cell_dkabc(1,3))
  r2=dsqrt(cell_dkabc(2,2)*cell_dkabc(2,2)+cell_dkabc(2,3)*cell_dkabc(2,3))

  do m1=0,n_a-1
     if( m1 < n_a/2 )then
        n1=m1
     else
        n1=m1-n_a
     end if
     do m2=0,n_b-1
        if( m2 < n_b/2 )then
           n2=m2
        else
           n2=m2-n_b
        end if
        h1=dfloat(n1)*r1
        h2=dfloat(n2)*r2
        g2_temp(m1*n_b+m2+1)=dsqrt((al1*al1+be1*be1)*h1*h1                       &
             +(al2*al2+be2*be2)*h2*h2                    &
             +2.d0*(al1*al2+be1*be2)*h1*h2)
     end do
  end do


  do m1=0,n_a-1
     if( m1 < n_a/2 )then
        n1=m1
     else
        n1=m1-n_a
     end if
     do m2=0,n_b-1
        if( m2 < n_b/2 )then
           n2=m2
        else
           n2=m2-n_b
        end if
        r_cell_dk(1,m1*n_b+m2+1)=dfloat(n1)*cell_dkabc(1,2)                      &
             +dfloat(n2)*cell_dkabc(2,2)
        r_cell_dk(2,m1*n_b+m2+1)=dfloat(n1)*cell_dkabc(1,3)                      &
             +dfloat(n2)*cell_dkabc(2,3)
     end do
  end do


  temp_l=dabs(cell_labc_l(3,1))/dfloat(n_c_l)
  temp_r=dabs(cell_labc_r(3,1))/dfloat(n_c_r)

  do n3=1,n_c
     if( (dfloat(l_cell_l_bound_l-1)+.5d0)*temp_l                               &
          >= cell_lr(1,n3)+del_cell_l*.5d0 ) then
        l_cell_l_bound=n3
        del_bound_l=(dfloat(l_cell_l_bound_l-1)+.5d0)*temp_l                     &
             -(cell_lr(1,n3)+del_cell_l*.5d0)
     end if
     if( (dfloat(r_cell_l_bound_r-1)+.5d0)*temp_r                               &
          -cell_labc_r(3,1)+cell_labc(3,1)                             &
          > cell_lr(1,n3)+del_cell_l*.5d0 ) then
        r_cell_l_bound=n3+1
        del_bound_r=(dfloat(r_cell_l_bound_r-1)+.5d0)*temp_r                     &
             -cell_labc_r(3,1)+cell_labc(3,1)                              &
             -(cell_lr(1,n3+1)+del_cell_l*.5d0)
     else
        exit
     end if
  end do

  r_cell_l_bound_num=n_c-r_cell_l_bound+1
  c_num_cell_l=n_c-l_cell_l_bound-r_cell_l_bound+2

  return
end subroutine make_cell_lr
subroutine bound_cell_lr_l

  use scf_negf
  use constant
  use mod_mpi

  implicit none
  integer ::n3,i1_do,i_num_temp
  real(8) :: temp_l,temp_r

  i_num_temp=0
  temp_r=0.d0
  temp_l=0.d0
  do i1_do=1,num_atom_scf
     if( atom_ro(i1_do,1)-atom_rcut(i1_do) < 0.d0 ) then
        i_num_temp=i1_do
        temp_l=atom_ro(i_num_temp,1)+atom_rcut(i_num_temp)
     end if
     if( atom_ro(i1_do,1)+atom_rcut(i1_do)-cell_labc(3,1) > temp_r ) then
        temp_r=atom_ro(i1_do,1)+atom_rcut(i1_do)-cell_labc(3,1)
     end if
  end do
  if( temp_l < temp_r ) then
     temp_l=temp_r
  end if

  if( dis_chara == 'def' ) then
     res_bound_l=temp_l
     open(unit=36,file=file_tempout,position='append')
     write(36,997) res_bound_l*dis_scale
     close(36)
  end if
  if( dis_chara == 'on' .and. res_bound_l < temp_l ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,998) res_bound_l*dis_scale,temp_l*dis_scale
     close(36)
  end if
  if( lay_chara == 'def' ) then
     atom_parlay_l=i_num_temp
  end if
  if( lay_chara == 'on' .and. atom_parlay_l > i_num_temp ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,999) res_bound_l*dis_scale                                      &
          ,(atom_ro(atom_parlay_l,1)+atom_rcut(atom_parlay_l))*dis_scale
     close(36)
  end if

997 format('                         set boundary ( left):',f11.6)
998 format('                      !!!!!! boundary ( left):',f11.6,f11.6,'?')
999 format('             !!!!!! boundary for atom ( left):',f11.6,f11.6,'?')


  temp_l=dabs(cell_labc_l(3,1))/dfloat(n_c_l)

  do n3=0,n_c_l-1
     if( res_bound_l > n3*temp_l ) then
        l_cell_l_bound_l=n3+1
     else
        exit
     end if
  end do

  return
end subroutine bound_cell_lr_l
subroutine bound_cell_lr_r

  use scf_negf
  use constant
  use mod_mpi

  implicit none
  integer :: n3,i1_do,i_num_temp
  real(8) :: temp,temp_r,temp_l

  i_num_temp=0
  temp_l=0.d0
  temp_r=0.d0
  n3=0
  do i1_do=num_atom_scf,1,-1
     n3=n3+1
     if( atom_ro(i1_do,1)+atom_rcut(i1_do) > cell_labc(3,1) ) then
        i_num_temp=n3
        temp_r=cell_labc(3,1)-(atom_ro(i1_do,1)-atom_rcut(i1_do))
     end if
     if( atom_ro(i1_do,1)-atom_rcut(i1_do) < -temp_l ) then
        temp_l=-(atom_ro(i1_do,1)-atom_rcut(i1_do))
     end if
  end do
  if( temp_r < temp_l ) then
     temp_r=temp_l
  end if

  if( dis_chara == 'def' ) then
     res_bound_r=temp_r
     open(unit=36,file=file_tempout,position='append')
     write(36,997) res_bound_r*dis_scale
     close(36)
  end if
  if( dis_chara == 'on' .and. res_bound_r < temp_r ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,998) res_bound_r*dis_scale,temp_r*dis_scale
     close(36)
  end if
  if( lay_chara == 'def' ) then
     atom_parlay_r=i_num_temp
  end if
  if( lay_chara == 'on' .and. atom_parlay_r > i_num_temp ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,999) res_bound_r*dis_scale                                      &
          ,(cell_labc(3,1)-(atom_ro(num_atom_scf-atom_parlay_r+1,1)   &
          -atom_rcut(atom_parlay_r-atom_parlay_r+1)))*dis_scale
     close(36)
  end if

997 format('                         set boundary (right):',f11.6)
998 format('                      !!!!!! boundary (right):',f11.6,f11.6,'?')
999 format('             !!!!!! boundary for atom (right):',f11.6,f11.6,'?')


  temp_r=dabs(cell_labc_r(3,1))/dfloat(n_c_r)
  temp=dsqrt(cell_labc_r(3,1)*cell_labc_r(3,1)                                 &
       +cell_labc_r(3,2)*cell_labc_r(3,2)                           &
       +cell_labc_r(3,3)*cell_labc_r(3,3))                          &
       -res_bound_r

  do n3=0,n_c_r-1
     if( temp > n3*temp_r ) then
        r_cell_l_bound_r=n3+2
     else
        exit
     end if
  end do

  return
end subroutine bound_cell_lr_r
