! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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_cc(px,py,qx,qy)

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

  !                                                ==================================
  !                                          set Hamiltonian Hcc, Hcl, Hcr
  !                                       set overlap matrix Scc, Scl, Scr
  !                                                  for tight-binding method
  !                                                ==================================

  call set_hami_c_cc_cc
  call set_hami_c_cc_lc(px,py)
  call set_hami_c_cc_rc(qx,qy)

  return
end subroutine set_hami_c_cc

subroutine set_hami_c_cc_cc

  use condition_ini
  use hamiltonian_sgf
  use locate_atom
  use hamiltonian_c

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

  integer :: i1_do,ier
  integer :: i3_do,i4_do
  integer :: i1_count,i2_count,j1_count,j2_count
  real(8) :: r_per_temp(3)
  real(8) :: cs,sn,v

  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_cc_cc'
     stop
  end if

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


  do j1_count=1,num_atom_ctotal
     i1_count=itemp_c(j1_count)
     do j2_count=1,num_atom_ctotal
        i2_count=itemp_c(j2_count)
        if( i_lmr(j1_count) == 0 .and. i_lmr(j2_count) == 0 ) then
           r_per_temp=0.d0
           cs=1.d0
           sn=0.d0
           v=v_c
           if( j1_count /= j2_count ) then
              if( ham_model_ini .eq. 'gsp' ) then
                 call off_gsp_hami_cc(j1_count,j2_count,max_atom_orbital            &
                      ,h_ijmn,s_ijmn,r_per_temp)
              else
                 if( ham_model_ini .eq. 'rtb_h' ) then
                    call off_ham_hami_cc(j1_count,j2_count,max_atom_orbital          &
                         ,h_ijmn,s_ijmn,r_per_temp)
                 else
                    write(6,*) 'error - ham_model: set_hami_c_cc_cc 1'
                    stop
                 end if
              end if
           else
              if( ham_model_ini .eq. 'gsp' ) then
                 call onsite_gsp_hami_cc(j1_count,j2_count,max_atom_orbital         &
                      ,h_ijmn,s_ijmn,v)
              else
                 if( ham_model_ini .eq. 'rtb_h' ) then
                    call onsite_ham_hami_cc(j1_count,max_atom_orbital                &
                         ,h_ijmn,s_ijmn,v)
                 else
                    write(6,*) 'error - ham_model: set_hami_c_cc_cc 2'
                    stop
                 end if
              end if
           end if
           do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
              do i3_do=1,atom_orbital_ini(atom_kindn_ccal(j1_count))
                 hcc_mat(i1_count+i3_do,i2_count+i4_do)                             &
                      =hcc_mat(i1_count+i3_do,i2_count+i4_do)                          &
                      +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                 scc_mat(i1_count+i3_do,i2_count+i4_do)                             &
                      =scc_mat(i1_count+i3_do,i2_count+i4_do)                          &
                      +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
              end do
           end do
        end if
     end do
  end do

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

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

  return
end subroutine set_hami_c_cc_cc

subroutine set_hami_c_cc_lc(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
  integer :: i1_do,ier
  integer :: i3_do,i4_do
  integer :: i1_count,i2_count,j1_count,j2_count
  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,v
  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_cc_lc'
     stop
  end if

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

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

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

  do j1_count=1,num_atom_ctotal
     i1_count=itemp_c(j1_count)
     if( i_lmr(j1_count) == -1 ) then
        do j2_count=1,num_atom_ctotal
           i2_count=itemp_c(j2_count)
           if( iabs(i_lmr(j1_count)-i_lmr(j2_count)) == 2 ) then
              cycle
           else
              if( i_lmr(j2_count) == -1 ) then
                 if( p_or_f_l == 'free' ) then
                    num_unit_temp11=0
                    num_unit_temp12=0
                    num_unit_temp21=0
                    num_unit_temp22=0
                 else
                    if( p_or_f_l == 'periodic' ) then
                       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_cc_lc'
                       stop
                    end if
                 end if
                 do kx=num_unit_temp11,num_unit_temp21
                    do ky=num_unit_temp12,num_unit_temp22
                       if( j1_count == j2_count .and. kx == 0 .and. ky == 0  ) then
                          cs=1.d0
                          sn=0.d0
                          v=v_l
                          if( ham_model_ini .eq. 'gsp' ) then
                             call onsite_gsp_hami_cc(j1_count,j2_count                  &
                                  ,max_atom_orbital,h_ijmn,s_ijmn,v)
                          else
                             if( ham_model_ini .eq. 'rtb_h' ) then
                                call onsite_ham_hami_cc(j1_count                         &
                                     ,max_atom_orbital,h_ijmn,s_ijmn,v)
                             else
                                write(6,*) 'error - ham_model: set_hami_c_cc_lc 2'
                                stop
                             end if
                          end if
                       else
                          if( p_or_f_l == 'free' ) then
                             r_per_temp=0.d0
                             cs=1.d0
                             sn=0.d0
                          else
                             if( p_or_f_l == 'periodic' ) then
                                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_cc(j1_count,j2_count                     &
                                  ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                          else
                             if( ham_model_ini .eq. 'rtb_h' ) then
                                call off_ham_hami_cc(j1_count,j2_count                   &
                                     ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                             else
                                write(6,*) 'error - ham_model: set_hami_c_cc_lc 3'
                                stop
                             end if
                          end if
                       end if
                       do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                          do i3_do=1,atom_orbital_ini(atom_kindn_ccal(j1_count))
                             hcc_mat(i1_count+i3_do,i2_count+i4_do)                     &
                                  =hcc_mat(i1_count+i3_do,i2_count+i4_do)                  &
                                  +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                             scc_mat(i1_count+i3_do,i2_count+i4_do)                     &
                                  =scc_mat(i1_count+i3_do,i2_count+i4_do)                  &
                                  +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                          end do
                       end do
                    end do
                 end do
              else
                 if( p_or_f_l == 'free' ) then
                    r_per_temp=0.d0
                    cs=1.d0
                    sn=0.d0
                 else
                    if( p_or_f_l == 'periodic' ) then
                       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_cc(j1_count,j2_count,max_atom_orbital          &
                         ,h_ijmn,s_ijmn,r_per_temp)
                 else
                    if( ham_model_ini .eq. 'rtb_h' ) then
                       call off_ham_hami_cc(j1_count,j2_count,max_atom_orbital        &
                            ,h_ijmn,s_ijmn,r_per_temp)
                    else
                       write(6,*) 'error - ham_model: set_hami_c_cc_lc 4'
                       stop
                    end if
                 end if
                 do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                    do i3_do=1,atom_orbital_ini(atom_kindn_ccal(j1_count))
                       hcc_mat(i1_count+i3_do,i2_count+i4_do)                         &
                            =hcc_mat(i1_count+i3_do,i2_count+i4_do)                      &
                            +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                       scc_mat(i1_count+i3_do,i2_count+i4_do)                         &
                            =scc_mat(i1_count+i3_do,i2_count+i4_do)                      &
                            +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                       hcc_mat(i2_count+i4_do,i1_count+i3_do)                         &
                            =hcc_mat(i2_count+i4_do,i1_count+i3_do)                      &
                            +dconjg(h_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                       scc_mat(i2_count+i4_do,i1_count+i3_do)                         &
                            =scc_mat(i2_count+i4_do,i1_count+i3_do)                      &
                            +dconjg(s_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                    end do
                 end do
              end if
           end if
        end do
     end if
  end do

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

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

  return
end subroutine set_hami_c_cc_lc

subroutine set_hami_c_cc_rc(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
  integer :: i1_do,ier
  integer :: i3_do,i4_do
  integer :: i1_count,i2_count,j1_count,j2_count
  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,v
  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_cc_rc'
     stop
  end if

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

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

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

  do j1_count=1,num_atom_ctotal
     i1_count=itemp_c(j1_count)
     if( i_lmr(j1_count) == 1 ) then
        do j2_count=1,num_atom_ctotal
           i2_count=itemp_c(j2_count)
           if( iabs(i_lmr(j1_count)-i_lmr(j2_count)) == 2 ) then
              cycle
           else
              if( i_lmr(j2_count) == 1 ) then
                 if( p_or_f_r == 'free' ) then
                    num_unit_temp11=0
                    num_unit_temp12=0
                    num_unit_temp21=0
                    num_unit_temp22=0
                 else
                    if( p_or_f_r == 'periodic' ) then
                       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
                    else
                       write(6,*) 'error_locate: set_hami_c_cc_rc'
                       stop
                    end if
                 end if
                 do kx=num_unit_temp11,num_unit_temp21
                    do ky=num_unit_temp12,num_unit_temp22
                       if( j1_count == j2_count .and. kx == 0 .and. ky == 0 ) then
                          cs=1.d0
                          sn=0.d0
                          v=v_r
                          if( ham_model_ini .eq. 'gsp' ) then
                             call onsite_gsp_hami_cc(j1_count,j2_count                  &
                                  ,max_atom_orbital,h_ijmn,s_ijmn,v)
                          else
                             if( ham_model_ini .eq. 'rtb_h' ) then
                                call onsite_ham_hami_cc(j1_count                         &
                                     ,max_atom_orbital,h_ijmn,s_ijmn,v)
                             else
                                write(6,*) 'error - ham_model: set_hami_c_cc_rc 1'
                                stop
                             end if
                          end if
                       else
                          if( p_or_f_r == 'free' ) then
                             r_per_temp=0.d0
                             cs=1.d0
                             sn=0.d0
                          else
                             if( p_or_f_r == 'periodic' ) then
                                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_cc(j1_count,j2_count                     &
                                  ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                          else
                             if( ham_model_ini .eq. 'rtb_h' ) then
                                call off_ham_hami_cc(j1_count,j2_count                   &
                                     ,max_atom_orbital,h_ijmn,s_ijmn,r_per_temp)
                             else
                                write(6,*) 'error - ham_model: set_hami_c_cc_rc 2'
                                stop
                             end if
                          end if
                       end if
                       do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                          do i3_do=1,atom_orbital_ini(atom_kindn_ccal(j1_count))
                             hcc_mat(i1_count+i3_do,i2_count+i4_do)                     &
                                  =hcc_mat(i1_count+i3_do,i2_count+i4_do)                  &
                                  +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                             scc_mat(i1_count+i3_do,i2_count+i4_do)                     &
                                  =scc_mat(i1_count+i3_do,i2_count+i4_do)                  &
                                  +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                          end do
                       end do
                    end do
                 end do
              else
                 if( p_or_f_r == 'free' ) then
                    r_per_temp=0.d0
                    cs=1.d0
                    sn=0.d0
                 else
                    if( p_or_f_r == 'periodic' ) then
                       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
                 r_per_temp=0.d0
                 if( ham_model_ini .eq. 'gsp' ) then
                    call off_gsp_hami_cc(j1_count,j2_count,max_atom_orbital          &
                         ,h_ijmn,s_ijmn,r_per_temp)
                 else
                    if( ham_model_ini .eq. 'rtb_h' ) then
                       call off_ham_hami_cc(j1_count,j2_count,max_atom_orbital        &
                            ,h_ijmn,s_ijmn,r_per_temp)
                    else
                       write(6,*) 'error - ham_model: set_hami_c_cc_rc 3'
                       stop
                    end if
                 end if
                 do i4_do=1,atom_orbital_ini(atom_kindn_ccal(j2_count))
                    do i3_do=1,atom_orbital_ini(atom_kindn_ccal(j1_count))
                       hcc_mat(i1_count+i3_do,i2_count+i4_do)                         &
                            =hcc_mat(i1_count+i3_do,i2_count+i4_do)                      &
                            +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                       scc_mat(i1_count+i3_do,i2_count+i4_do)                         &
                            =scc_mat(i1_count+i3_do,i2_count+i4_do)                      &
                            +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                       hcc_mat(i2_count+i4_do,i1_count+i3_do)                         &
                            =hcc_mat(i2_count+i4_do,i1_count+i3_do)                      &
                            +dconjg(h_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                       scc_mat(i2_count+i4_do,i1_count+i3_do)                         &
                            =scc_mat(i2_count+i4_do,i1_count+i3_do)                      &
                            +dconjg(s_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                    end do
                 end do
              end if
           end if
        end do
     end if
  end do

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

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

  return
end subroutine set_hami_c_cc_rc
