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

subroutine set_hami_c_ll(px,py)

  use condition_ini
  use hamiltonian_sgf
  use locate_atom
  use hamiltonian_c

  implicit none
  integer, intent(in) :: px,py

  integer :: max_atom_orbital
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)

  integer :: kx,ky,lx,ly
  integer :: ier
  integer :: i1_do,i3_do,i4_do,i5_do
  integer :: i1_count,i2_count,j2_count,num_unit_temp1,num_unit_temp2
  integer :: num_unit_temp11,num_unit_temp12,num_unit_temp21,num_unit_temp22
  integer :: jr_do
  real(8) :: r_per_temp(3)
  real(8) :: cs,sn
  real(8) :: pai

  max_atom_orbital=0
  do i1_do=1,num_atom_kind_ini
     if( max_atom_orbital < atom_orbital_ini(i1_do) ) then
        max_atom_orbital=atom_orbital_ini(i1_do)
     end if
  end do

  allocate(h_ijmn(max_atom_orbital,max_atom_orbital)                           &
       ,s_ijmn(max_atom_orbital,max_atom_orbital),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_hami_c_ll'
     stop
  end if

  !                       ------------------------------------                       !

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

  !                       ------------------------------------                       !

  if( p_or_f_l == 'free' ) then
     num_unit_temp1=num_unit_r(1)
     num_unit_temp2=num_unit_r(2)
     num_unit_temp11=0
     num_unit_temp12=0
     num_unit_temp21=num_unit_l(1)-1
     num_unit_temp22=num_unit_l(2)-1
  else
     if( p_or_f_l == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
        num_unit_temp11=-neighbor_x_max_l
        num_unit_temp12=-neighbor_y_max_l
        num_unit_temp21=neighbor_x_max_l
        num_unit_temp22=neighbor_y_max_l
     else
        write(6,*) 'error_locate: set_hami_c_ll'
        stop
     end if
  end if

  j2_count=0
  do lx=1,num_unit_temp1
     do ly=1,num_unit_temp2
        do i5_do=1,num_atom_l
           j2_count=j2_count+1
           i2_count=itemp_c(j2_count)
           do kx=num_unit_temp11,num_unit_temp21
              do ky=num_unit_temp12,num_unit_temp22
                 do i1_do=1,num_atom_l
                    if( p_or_f_l == 'free' ) then
                       i1_count=itemp_l(kx+1,ky+1,i1_do)
                       r_per_temp=0.d0
                       cs=1.d0
                       sn=0.d0
                    else
                       if( p_or_f_l == 'periodic' ) then
                          i1_count=itemp_l(1,1,i1_do)
                          do jr_do=1,3
                             r_per_temp(jr_do)=dfloat(kx)*unit_block_l(1,jr_do)       &
                                  +dfloat(ky)*unit_block_l(2,jr_do)
                          end do
                          cs=dcos(2.d0*pai*(dfloat((px-1)*kx)/dfloat(kx_max_l)       &
                               +dfloat((py-1)*ky)/dfloat(ky_max_l)))
                          sn=dsin(2.d0*pai*(dfloat((px-1)*kx)/dfloat(kx_max_l)       &
                               +dfloat((py-1)*ky)/dfloat(ky_max_l)))
                       end if
                    end if
                    if( ham_model_ini .eq. 'gsp' ) then
                       call off_gsp_hami_lc(i1_do,i5_do,j2_count                    &
                            ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                    else
                       if( ham_model_ini .eq. 'rtb_h' ) then
                          call off_rtbh_hami_lc(i1_do,j2_count,max_atom_orbital      &
                               ,h_ijmn,s_ijmn,r_per_temp)
                       else
                          write(6,*) 'error - ham_model: set_hami_c_ll 1'
                          stop
                       end if
                    end if
                    do i3_do=1,atom_orbital_ini(atom_kindn_l(i1_do))
                       do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                          hcl_mat(i2_count+i4_do,i1_count+i3_do)                     &
                               =hcl_mat(i2_count+i4_do,i1_count+i3_do)               &
                               +dconjg(h_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                          scl_mat(i2_count+i4_do,i1_count+i3_do)                     &
                               =scl_mat(i2_count+i4_do,i1_count+i3_do)               &
                               +dconjg(s_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                       end do
                    end do
                 end do
              end do
           end do
        end do
     end do
  end do

  !                       ------------------------------------                       !

  deallocate(h_ijmn,s_ijmn,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: set_hami_c_ll'
     stop
  end if

  return
end subroutine set_hami_c_ll

subroutine set_hami_c_rr(px,py)

  use condition_ini
  use hamiltonian_sgf
  use locate_atom
  use hamiltonian_c

  implicit none
  integer, intent(in) :: px,py

  integer :: max_atom_orbital
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)

  integer :: kx,ky,lx,ly
  integer :: ier
  integer :: i1_do,i3_do,i4_do,i5_do
  integer :: i1_count,i2_count,j2_count,num_unit_temp1,num_unit_temp2
  integer :: num_unit_temp11,num_unit_temp12,num_unit_temp21,num_unit_temp22
  integer :: num_unit_temp_l,num_unit_temp_r
  integer :: jr_do
  real(8) :: r_per_temp(3)
  real(8) :: cs,sn
  real(8) :: pai

  max_atom_orbital=0
  do i1_do=1,num_atom_kind_ini
     if( max_atom_orbital < atom_orbital_ini(i1_do) ) then
        max_atom_orbital=atom_orbital_ini(i1_do)
     end if
  end do

  allocate(h_ijmn(max_atom_orbital,max_atom_orbital)                           &
       ,s_ijmn(max_atom_orbital,max_atom_orbital),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_hami_c_rr'
     stop
  end if

  !                       ------------------------------------                       !

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

  !                       ------------------------------------                       !

  if( p_or_f_r == 'free' ) then
     num_unit_temp1=num_unit_r(1)
     num_unit_temp2=num_unit_r(2)
     num_unit_temp11=0
     num_unit_temp12=0
     num_unit_temp21=num_unit_r(1)-1
     num_unit_temp22=num_unit_r(2)-1
     num_unit_temp_l=num_unit_l(1)*num_unit_l(2)
     num_unit_temp_r=num_unit_r(1)*num_unit_r(2)
  else
     if( p_or_f_r == 'periodic' ) then
        num_unit_temp1=1
        num_unit_temp2=1
        num_unit_temp11=-neighbor_x_max_r
        num_unit_temp12=-neighbor_y_max_r
        num_unit_temp21=neighbor_x_max_r
        num_unit_temp22=neighbor_y_max_r
        num_unit_temp_l=1
        num_unit_temp_r=1
     else
        write(6,*) 'error_locate: set_hami_c_rr'
        stop
     end if
  end if

  j2_count=num_atom_l*num_unit_temp_l*m_num_block_l                            &
       +num_atom_c*m_num_block_m                                            &
       +num_atom_r*num_unit_temp_r*(m_num_block_r-1)
  do lx=1,num_unit_temp1
     do ly=1,num_unit_temp2
        do i5_do=1,num_atom_r
           j2_count=j2_count+1
           i2_count=itemp_c(j2_count)
           do kx=num_unit_temp11,num_unit_temp21
              do ky=num_unit_temp12,num_unit_temp22
                 do i1_do=1,num_atom_r
                    if( p_or_f_r == 'free' ) then
                       i1_count=itemp_r(kx+1,ky+1,i1_do)
                       r_per_temp=0.d0
                       cs=1.d0
                       sn=0.d0
                    else
                       if( p_or_f_r == 'periodic' ) then
                          i1_count=itemp_r(1,1,i1_do)
                          do jr_do=1,3
                             r_per_temp(jr_do)=dfloat(kx)*unit_block_r(1,jr_do)       &
                                  +dfloat(ky)*unit_block_r(2,jr_do)
                          end do
                          cs=dcos(2.d0*pai*(dfloat((px-1)*kx)/dfloat(kx_max_r)       &
                               +dfloat((py-1)*ky)/dfloat(ky_max_r)))
                          sn=dsin(2.d0*pai*(dfloat((px-1)*kx)/dfloat(kx_max_r)       &
                               +dfloat((py-1)*ky)/dfloat(ky_max_r)))
                       end if
                    end if
                    if( ham_model_ini .eq. 'gsp' ) then
                       call off_gsp_hami_rc(i1_do,i5_do,j2_count                    &
                            ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                    else
                       if( ham_model_ini .eq. 'rtb_h' ) then
                          call off_rtbh_hami_rc(i1_do,j2_count,max_atom_orbital      &
                               ,h_ijmn,s_ijmn,r_per_temp)
                       else
                          write(6,*) 'error - ham_model: set_hami_c_ll 1'
                          stop
                       end if
                    end if
                    do i3_do=1,atom_orbital_ini(atom_kindn_r(i1_do))
                       do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                          hcr_mat(i2_count+i4_do,i1_count+i3_do)                     &
                               =hcr_mat(i2_count+i4_do,i1_count+i3_do)               &
                               +dconjg(h_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                          scr_mat(i2_count+i4_do,i1_count+i3_do)                     &
                               =scr_mat(i2_count+i4_do,i1_count+i3_do)               &
                               +dconjg(s_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                       end do
                    end do
                 end do
              end do
           end do
        end do
     end do
  end do

  !                       ------------------------------------                       !

  deallocate(h_ijmn,s_ijmn,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: set_hami_c_rr'
     stop
  end if

  return
end subroutine set_hami_c_rr
