! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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_hamiltonian_l(qx,qy,ispin)

  use condition
  use hamiltonian_e
  use hamiltonian_sgf

  implicit none
  integer, intent(in) :: qx,qy,ispin
  integer :: i1_do,i2_do,ier
  complex(8), allocatable :: temp(:,:)

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     call set_hamiltonian_input_l(ispin)
     return
  end if

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

  if( p_or_f == 'free' ) then
     call set_hamiltonian_free
  else
     if( p_or_f == 'periodic' ) then
        call set_hamiltonian_periodic(qx,qy)
     else
        write(6,*) 'error: set_hamiltonian_l'
        stop
     end if
  end if

  allocate(temp(mat_max,mat_max),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: set_hamiltonian_l'
     stop
  end if

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        temp(i1_do,i2_do)=h01_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        h01_mat(i1_do,i2_do)=h10_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        h10_mat(i1_do,i2_do)=temp(i1_do,i2_do)
     end do
  end do

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        temp(i1_do,i2_do)=s01_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        s01_mat(i1_do,i2_do)=s10_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        s10_mat(i1_do,i2_do)=temp(i1_do,i2_do)
     end do
  end do

  deallocate(temp,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: set_hamiltonian_l'
     stop
  end if

  return
end subroutine set_hamiltonian_l

subroutine set_hamiltonian_r(qx,qy,ispin)

  use condition
  use hamiltonian_e
  use hamiltonian_sgf

  implicit none
  integer, intent(in) :: qx,qy,ispin

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     call set_hamiltonian_input_r(ispin)
  else
     if( p_or_f == 'free' ) then
        call set_hamiltonian_free
     else
        if( p_or_f == 'periodic' ) then
           call set_hamiltonian_periodic(qx,qy)
        else
           write(6,*) 'error: set_hamiltonian_r'
           stop
        end if
     end if
  end if

  return
end subroutine set_hamiltonian_r

subroutine unset_hamiltonian

  use condition
  use hamiltonian_e

  implicit none

  if( ham_model == 'input' .or. ham_model == 'scf_accel' ) then
     call unset_hamiltonian_input
  else
     if( p_or_f == 'free' ) then
        call unset_hamiltonian_free
     end if
     if( p_or_f == 'periodic' .or.  p_or_f == 'periodic-1d' ) then
        call unset_hamiltonian_periodic
     end if
  end if

  return
end subroutine unset_hamiltonian

subroutine set_hamiltonian_input_l(ispin)

  use condition
  use hamiltonian_e
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use scf_negf
  use constant
  use mod_mpi

  implicit none
  include 'mpif.h'
  integer, intent(in) :: ispin
  integer :: i2_do,i3_do

  call alo_hamiltonian_input


  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        h00_mat(i3_do,i2_do)=h00_l_t(ispin,i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        h01_mat(i3_do,i2_do)=h01_l_t(ispin,i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        h10_mat(i3_do,i2_do)=h10_l_t(ispin,i3_do,i2_do)
     end do
  end do

  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        s00_mat(i3_do,i2_do)=s00_l_t(i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        s01_mat(i3_do,i2_do)=s01_l_t(i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_ll
     do i3_do=1,mat_max_ll
        s10_mat(i3_do,i2_do)=s10_l_t(i3_do,i2_do)
     end do
  end do

  return
end subroutine set_hamiltonian_input_l

subroutine set_hamiltonian_input_r(ispin)

  use condition
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_e
  use hamiltonian_temp
  use scf_negf
  use constant
  use mod_mpi

  implicit none
  include 'mpif.h'
  integer, intent(in) :: ispin
  integer :: i2_do,i3_do

  call alo_hamiltonian_input

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

  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        h00_mat(i3_do,i2_do)=h00_r_t(ispin,i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        h01_mat(i3_do,i2_do)=h01_r_t(ispin,i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        h10_mat(i3_do,i2_do)=h10_r_t(ispin,i3_do,i2_do)
     end do
  end do

  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        s00_mat(i3_do,i2_do)=s00_r_t(i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        s01_mat(i3_do,i2_do)=s01_r_t(i3_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max_rr
     do i3_do=1,mat_max_rr
        s10_mat(i3_do,i2_do)=s10_r_t(i3_do,i2_do)
     end do
  end do

  return
end subroutine set_hamiltonian_input_r

subroutine set_hamiltonian_free

  use condition
  use hamiltonian_e

  implicit none
  integer :: max_atom_orbital
  integer :: kx,ky,lx,ly,iz
  integer :: i1_do,i2_do,i3_do,i4_do,i1_count,i2_count,ier
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)

  max_atom_orbital=0
  do i1_do=1,num_atom_kind
     if( max_atom_orbital < atom_orbital(i1_do) ) then
        max_atom_orbital=atom_orbital(i1_do)
     end if
  end do

  call alo_hamiltonian_free(num_atom,num_unit)

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

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

  i1_count=0
  do kx=1,num_unit(1)
     do ky=1,num_unit(2)
        do i1_do=1,num_atom
           itemp(kx,ky,i1_do)=i1_count
           i1_count=i1_count+atom_orbital(atom_kindn(i1_do))
        end do
     end do
  end do

  do kx=0,num_unit(1)-1
     do ky=0,num_unit(2)-1
        do i1_do=1,num_atom
           i1_count=itemp(kx+1,ky+1,i1_do)
           do lx=0,num_unit(1)-1
              do ly=0,num_unit(2)-1
                 do i2_do=1,num_atom
                    i2_count=itemp(lx+1,ly+1,i2_do)
                    if( i1_count == i2_count ) then
                       if( ham_model .eq. 'gsp' ) then
                          call onsite_gsp_hamiltonian(max_atom_orbital,i1_do,i2_do     &
                               ,h_ijmn,s_ijmn)
                       else
                          if( ham_model .eq. 'rtb_h' ) then
                             call onsite_rtbh_hamiltonian(max_atom_orbital,i1_do        &
                                  ,h_ijmn,s_ijmn)
                          else
                             write(6,*) 'error - ham_model: set_hamiltonian_free 1'
                             stop
                          end if
                       end if
                    else
                       iz=0
                       if( ham_model .eq. 'gsp' ) then
                          call off_gsp_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do          &
                               ,max_atom_orbital,h_ijmn,s_ijmn)
                       else
                          if( ham_model .eq. 'rtb_h' ) then
                             call off_rtbh_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do       &
                                  ,max_atom_orbital,h_ijmn,s_ijmn)
                          else
                             write(6,*) 'error - ham_model: set_hamiltonian_free 2'
                             stop
                          end if
                       end if
                    end if
                    do i3_do=1,atom_orbital(atom_kindn(i1_do))
                       do i4_do=1,atom_orbital(atom_kindn(i2_do))
                          h00_mat(i1_count+i3_do,i2_count+i4_do)=h_ijmn(i3_do,i4_do)
                          s00_mat(i1_count+i3_do,i2_count+i4_do)=s_ijmn(i3_do,i4_do)
                       end do
                    end do
                    iz=l_or_r
                    if( ham_model .eq. 'gsp' ) then
                       call off_gsp_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do            &
                            ,max_atom_orbital,h_ijmn,s_ijmn)
                    else
                       if( ham_model .eq. 'rtb_h' ) then
                          call off_rtbh_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do         &
                               ,max_atom_orbital,h_ijmn,s_ijmn)
                       else
                          write(6,*) 'error - ham_model: set_hamiltonian_free 3'
                          stop
                       end if
                    end if
                    do i3_do=1,atom_orbital(atom_kindn(i1_do))
                       do i4_do=1,atom_orbital(atom_kindn(i2_do))
                          h10_mat(i1_count+i3_do,i2_count+i4_do)=h_ijmn(i3_do,i4_do)
                          h01_mat(i2_count+i4_do,i1_count+i3_do)                       &
                               =dconjg(h_ijmn(i3_do,i4_do))
                          s10_mat(i1_count+i3_do,i2_count+i4_do)=s_ijmn(i3_do,i4_do)
                          s01_mat(i2_count+i4_do,i1_count+i3_do)                       &
                               =dconjg(s_ijmn(i3_do,i4_do))
                       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_hamiltonian_free'
     stop
  end if

  return
end subroutine set_hamiltonian_free

subroutine set_hamiltonian_periodic(qx,qy)

  use condition
  use hamiltonian_e

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

  integer :: max_atom_orbital
  integer :: kx,ky,lx,ly,iz
  integer :: i1_do,i2_do,i3_do,i4_do,i1_count,i2_count,ier
  real(8) :: pai,cs,sn
  complex(8), allocatable :: h_ijmn(:,:),s_ijmn(:,:)

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

  max_atom_orbital=0
  do i1_do=1,num_atom_kind
     if( max_atom_orbital < atom_orbital(i1_do) ) then
        max_atom_orbital=atom_orbital(i1_do)
     end if
  end do

  call alo_hamiltonian_periodic(num_atom)

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

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

  i1_count=0
  do i1_do=1,num_atom
     jtemp(i1_do)=i1_count
     i1_count=i1_count+atom_orbital(atom_kindn(i1_do))
  end do

  kx=qx
  ky=qy
  do i1_do=1,num_atom
     i1_count=jtemp(i1_do)
     do i2_do=1,num_atom
        i2_count=jtemp(i2_do)
        do lx=-neighbor_x_max,neighbor_x_max
           do ly=-neighbor_y_max,neighbor_y_max
              if( i1_do == i2_do .and. lx == 0 .and. ly == 0 ) then
                 if( ham_model .eq. 'gsp' ) then
                    call onsite_gsp_hamiltonian(max_atom_orbital,i1_do,i2_do         &
                         ,h_ijmn,s_ijmn)
                 else
                    if( ham_model .eq. 'rtb_h' ) then
                       call onsite_rtbh_hamiltonian(max_atom_orbital,i1_do            &
                            ,h_ijmn,s_ijmn)
                    else
                       write(6,*) 'error - ham_model: set_hamiltonian_periodic 1'
                       stop
                    end if
                 end if
                 cs=1.d0
                 sn=0.d0
              else
                 iz=0
                 if( ham_model .eq. 'gsp' ) then
                    call off_gsp_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do                &
                         ,max_atom_orbital,h_ijmn,s_ijmn)
                 else
                    if( ham_model .eq. 'rtb_h' ) then
                       call off_rtbh_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do             &
                            ,max_atom_orbital,h_ijmn,s_ijmn)
                    else
                       write(6,*) 'error - ham_model: set_hamiltonian_periodic 2'
                       stop
                    end if
                 end if
                 cs=dcos(2.d0*pai*(dfloat((kx-1)*lx)/dfloat(kx_max)                 &
                      +dfloat((ky-1)*ly)/dfloat(ky_max)))
                 sn=dsin(2.d0*pai*(dfloat((kx-1)*lx)/dfloat(kx_max)                 &
                      +dfloat((ky-1)*ly)/dfloat(ky_max)))
              end if
              do i3_do=1,atom_orbital(atom_kindn(i1_do))
                 do i4_do=1,atom_orbital(atom_kindn(i2_do))
                    h00_mat(i1_count+i3_do,i2_count+i4_do)                           &
                         =h00_mat(i1_count+i3_do,i2_count+i4_do)               &
                         +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                    s00_mat(i1_count+i3_do,i2_count+i4_do)                           &
                         =s00_mat(i1_count+i3_do,i2_count+i4_do)               &
                         +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                 end do
              end do
              iz=l_or_r
              if( ham_model .eq. 'gsp' ) then
                 call off_gsp_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do                  &
                      ,max_atom_orbital,h_ijmn,s_ijmn)
              else
                 if( ham_model .eq. 'rtb_h' ) then
                    call off_rtbh_hamiltonian(iz,lx,ly,0,0,i1_do,i2_do               &
                         ,max_atom_orbital,h_ijmn,s_ijmn)
                 else
                    write(6,*) 'error - ham_model: set_hamiltonian_periodic 3'
                    stop
                 end if
              end if
              do i3_do=1,atom_orbital(atom_kindn(i1_do))
                 do i4_do=1,atom_orbital(atom_kindn(i2_do))
                    h10_mat(i1_count+i3_do,i2_count+i4_do)                           &
                         =h10_mat(i1_count+i3_do,i2_count+i4_do)                 &
                         +h_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                    h01_mat(i2_count+i4_do,i1_count+i3_do)                           &
                         =h01_mat(i2_count+i4_do,i1_count+i3_do)                 &
                         +dconjg(h_ijmn(i3_do,i4_do)*dcmplx(cs,sn))
                    s10_mat(i1_count+i3_do,i2_count+i4_do)                           &
                         =s10_mat(i1_count+i3_do,i2_count+i4_do)                 &
                         +s_ijmn(i3_do,i4_do)*dcmplx(cs,sn)
                    s01_mat(i2_count+i4_do,i1_count+i3_do)                           &
                         =s01_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

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

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

  return
end subroutine set_hamiltonian_periodic
