! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 onsite_gsp_hamiltonian(max_atom_orbital,i1_do,i2_do,h_ijmn,s_ijmn)

  use condition
  use gsp_parameter

  implicit none
  integer, intent(in) :: max_atom_orbital,i1_do,i2_do
  complex(8), intent(out) :: h_ijmn(max_atom_orbital,max_atom_orbital)
  complex(8), intent(out) :: s_ijmn(max_atom_orbital,max_atom_orbital)
  integer :: id

  id=pair_num(i1_do,i2_do)

  h_ijmn=dcmplx(0.d0,0.d0)
  s_ijmn=dcmplx(0.d0,0.d0)

  h_ijmn(1,1)=dcmplx(hs(id)+v_lr,0.d0)
  h_ijmn(2,2)=dcmplx(hp(id)+v_lr,0.d0)
  h_ijmn(3,3)=dcmplx(hp(id)+v_lr,0.d0)
  h_ijmn(4,4)=dcmplx(hp(id)+v_lr,0.d0)

  s_ijmn(1,1)=dcmplx(1.d0,0.d0)
  s_ijmn(2,2)=dcmplx(1.d0,0.d0)
  s_ijmn(3,3)=dcmplx(1.d0,0.d0)
  s_ijmn(4,4)=dcmplx(1.d0,0.d0)

  return
end subroutine onsite_gsp_hamiltonian

subroutine off_gsp_hamiltonian(iz,kx,ky,lx,ly,i1_do,i2_do,max_atom_orbital         &
     ,h_ijmn,s_ijmn)

  use condition
  use gsp_parameter

  implicit none
  integer, intent(in) :: max_atom_orbital,kx,ky,lx,ly,iz,i1_do,i2_do
  complex(8), intent(out) :: h_ijmn(max_atom_orbital,max_atom_orbital)
  complex(8), intent(out) :: s_ijmn(max_atom_orbital,max_atom_orbital)

  integer :: id,j_do,jr_do
  real(8) :: r_distance,rab_distance(3),r_temp_a(3),r_temp_b(3)

  id=pair_num(i1_do,i2_do)

  do jr_do=1,3
     r_temp_a(jr_do)=dfloat(kx)*unit_block(1,jr_do)                             &
          +dfloat(ky)*unit_block(2,jr_do)                             &
          +dfloat(iz)*unit_block(3,jr_do)+ra(i1_do,jr_do)
     r_temp_b(jr_do)=dfloat(lx)*unit_block(1,jr_do)                             &
          +dfloat(ly)*unit_block(2,jr_do)+ra(i2_do,jr_do)
  end do

  do jr_do=1,3
     rab_distance(jr_do)=r_temp_b(jr_do)-r_temp_a(jr_do)
  end do

  r_distance=0.d0
  do j_do=1,3
     r_distance=r_distance+rab_distance(j_do)**2
  end do
  r_distance=dsqrt(r_distance)

  rab_distance=rab_distance/r_distance

  call set_off_gsp(r_distance,rab_distance,id,max_atom_orbital,h_ijmn,s_ijmn)

  return
end subroutine off_gsp_hamiltonian

subroutine set_off_gsp(r_distance,rab_distance,id,max_atom_orbital,h_ijmn,s_ijmn)

  use condition
  use gsp_parameter

  implicit none
  integer, intent(in) :: max_atom_orbital
  integer, intent(in) :: id
  real(8), intent(in) :: r_distance,rab_distance(3)
  complex(8), intent(out) :: h_ijmn(max_atom_orbital,max_atom_orbital)
  complex(8), intent(out) :: s_ijmn(max_atom_orbital,max_atom_orbital)

  integer :: j_do

  real(8) :: hsss,hsps,hpps,hppp
  real(8) :: hsss_b,hsps_b,hpps_b,hppp_b
  real(8) :: h_r0(2)

  if( r_distance > cutoff_r(id) ) then
     h_ijmn=dcmplx(0.d0,0.d0)
     s_ijmn=dcmplx(0.d0,0.d0)
     return
  end if

  h_ijmn=dcmplx(0.d0,0.d0)

  call h_ss_sigma_gsp(id,r_distance,hsss)
  call h_ss_sigma_gsp(id,r_distance,hsss_b)

  call h_sp_sigma_gsp(id,r_distance,hsps)
  call h_sp_sigma_gsp(id,r_distance,hsps_b)

  call h_pp_sigma_gsp(id,r_distance,hpps)
  call h_pp_sigma_gsp(id,r_distance,hpps_b)
  call h_pp_pi_gsp(id,r_distance,hppp)
  call h_pp_pi_gsp(id,r_distance,hppp_b)

  h_ijmn(1,1)=hsss

  do j_do=1,3
     h_ijmn(1,j_do+1)=hsps*rab_distance(j_do)
     h_ijmn(j_do+1,1)=-1.d0*hsps_b*rab_distance(j_do)
  end do

  do j_do= 1 , 3
     h_r0(1)=hpps*rab_distance(j_do)**2
     h_r0(2)=hppp*(1.d0-rab_distance(j_do)**2)
     h_ijmn(j_do+1,j_do+1)=h_r0(1)+h_r0(2) 
  end do

  do j_do = 2 , 3
     h_r0(1)=hpps*rab_distance(1)*rab_distance(j_do)
     h_r0(2)=hppp*rab_distance(1)*rab_distance(j_do)
     h_ijmn(2,j_do+1)=h_r0(1)-h_r0(2) 

     h_r0(1)=hpps_b*rab_distance(1)*rab_distance(j_do)
     h_r0(2)=hppp_b*rab_distance(1)*rab_distance(j_do)
     h_ijmn(j_do+1,2)=h_r0(1)-h_r0(2) 
  end do

  h_r0(1)=hpps*rab_distance(2)*rab_distance(3)
  h_r0(2)=hppp*rab_distance(2)*rab_distance(3)
  h_ijmn(3,4)=h_r0(1)-h_r0(2) 

  h_r0(1)=hpps_b*rab_distance(2)*rab_distance(3)
  h_r0(2)=hppp_b*rab_distance(2)*rab_distance(3)
  h_ijmn(4,3)=h_r0(1)-h_r0(2) 


  s_ijmn=dcmplx(0.d0,0.d0)

  return
end subroutine set_off_gsp

subroutine h_ss_sigma_gsp(id,r,hsss)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hsss
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_sss(id)
     rc=rc_sss(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hsss=h_sss(id)*gr

  return
end subroutine h_ss_sigma_gsp

subroutine h_sp_sigma_gsp(id,r,hsps)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hsps
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_sps(id)
     rc=rc_sps(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hsps=h_sps(id)*gr

  return
end subroutine h_sp_sigma_gsp

subroutine h_pp_sigma_gsp(id,r,hpps)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hpps
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_pps(id)
     rc=rc_pps(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hpps=h_pps(id)*gr

  return
end subroutine h_pp_sigma_gsp

subroutine h_pp_pi_gsp(id,r,hppp)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hppp
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_ppp(id)
     rc=rc_ppp(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hppp=h_ppp(id)*gr

  return
end subroutine h_pp_pi_gsp

subroutine h_sd_sigma_gsp(id,r,hsds)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hsds
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_sds(id)
     rc=rc_sds(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hsds=h_sds(id)*gr

  return
end subroutine h_sd_sigma_gsp

subroutine h_pd_sigma_gsp(id,r,hpds)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hpds
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_pds(id)
     rc=rc_pds(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hpds=h_pds(id)*gr

  return
end subroutine h_pd_sigma_gsp

subroutine h_pd_pi_gsp(id,r,hpdp)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hpdp
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_pdp(id)
     rc=rc_pdp(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hpdp=h_pdp(id)*gr

  return
end subroutine h_pd_pi_gsp

subroutine h_dd_sigma_gsp(id,r,hdds)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hdds
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_dds(id)
     rc=rc_dds(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hdds=h_dds(id)*gr

  return
end subroutine h_dd_sigma_gsp

subroutine h_dd_pi_gsp(id,r,hddp)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hddp
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_ddp(id)
     rc=rc_ddp(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hddp=h_ddp(id)*gr

  return
end subroutine h_dd_pi_gsp

subroutine h_dd_delta_gsp(id,r,hddd)

  use gsp_parameter

  implicit none
  integer, intent(in) :: id
  real(8), intent(in) :: r
  real(8), intent(out) :: hddd
  real(8) :: rc,nc,gr

  if( r <= r1(id) ) then
     nc=nc_ddd(id)
     rc=rc_ddd(id)
     gr=(r0(id)/r)**n(id)*dexp(n(id)*(-1.d0*(r/rc)**nc+(r0(id)/rc)**nc))
  else
     rc=r1(id)
     gr=tsc0(id)+tsc1(id)*(r-rc)+tsc2(id)*(r-rc)**2+tsc3(id)*(r-rc)**3
  end if

  hddd=h_ddd(id)*gr

  return
end subroutine h_dd_delta_gsp
