subroutine berry_get_shc_tetrahedron(pw90_berry, ws_region, pw90_spin_hall, wannier_data, ws_distance, &
wigner_seitz, AA_R, HH_R, SH_R, SHR_R, SR_R, SS_R, SAA_R, SBB_R, &
kpt, imjv, eig_out, real_lattice, mp_grid, num_wann, &
seedname, stdout, error, comm)
!====================================================================!
! returns the values used for calculating the SHC Kubo formula !
! imjv = Im [j^{z}_{x,nmk} * v_{y,nmk}] !
! eig_out = energy eigenvalues !
!====================================================================!
use w90_constants, only: dp, cmplx_0, cmplx_i
use w90_utility, only: utility_diagonalize, utility_rotate
use w90_error, only: w90_error_type
use w90_comms, only: w90_comm_type
use w90_types, only: print_output_type, wannier_data_type, ws_region_type, &
ws_distance_type
use w90_postw90_types, only: pw90_berry_mod_type, pw90_spin_hall_type, wigner_seitz_type
use w90_postw90_common, only: pw90common_fourier_R_to_k_new, pw90common_fourier_R_to_k_vec
! arguments
type(pw90_berry_mod_type), intent(in) :: pw90_berry
type(ws_region_type), intent(in) :: ws_region
type(pw90_spin_hall_type), intent(in) :: pw90_spin_hall
type(wannier_data_type), intent(in) :: wannier_data
type(wigner_seitz_type), intent(inout) :: wigner_seitz
type(ws_distance_type), intent(inout) :: ws_distance
type(w90_error_type), allocatable, intent(out) :: error
type(w90_comm_type), intent(in) :: comm
integer, intent(in) :: num_wann
integer, intent(in) :: mp_grid(3)
integer, intent(in) :: stdout
real(kind=dp), intent(in) :: kpt(3)
real(kind=dp), intent(in) :: real_lattice(3, 3)
real(kind=dp), dimension(:, :), intent(out) :: imjv
real(kind=dp), dimension(:), intent(out) :: eig_out
complex(kind=dp), allocatable, intent(inout) :: AA_R(:, :, :, :) ! <0n|r|Rm>
complex(kind=dp), allocatable, intent(inout) :: HH_R(:, :, :) ! <0n|r|Rm>
complex(kind=dp), allocatable, intent(inout) :: SR_R(:, :, :, :, :) ! <0n|sigma_x,y,z.(r-R)_alpha|Rm>
complex(kind=dp), allocatable, intent(inout) :: SHR_R(:, :, :, :, :) ! <0n|sigma_x,y,z.H.(r-R)_alpha|Rm>
complex(kind=dp), allocatable, intent(inout) :: SH_R(:, :, :, :) ! <0n|sigma_x,y,z.H|Rm>
complex(kind=dp), allocatable, intent(inout) :: SS_R(:, :, :, :) ! <0n|sigma_x,y,z|Rm>
complex(kind=dp), allocatable, intent(inout) :: SAA_R(:, :, :, :, :)
complex(kind=dp), allocatable, intent(inout) :: SBB_R(:, :, :, :, :)
character(len=50), intent(in) :: seedname
! internal vars
complex(kind=dp), allocatable :: HH(:, :)
complex(kind=dp), allocatable :: delHH(:, :, :)
complex(kind=dp), allocatable :: UU(:, :)
complex(kind=dp), allocatable :: VV0(:, :, :)
complex(kind=dp), allocatable :: VV(:, :, :)
complex(kind=dp), allocatable :: AA(:, :, :)
complex(kind=dp), allocatable :: SS(:, :, :)
complex(kind=dp), allocatable :: spinVel0(:, :, :, :), spinVel(:, :, :, :)
complex(kind=dp), allocatable :: SAA(:, :, :, :)
complex(kind=dp), allocatable :: SBB(:, :, :, :)
integer :: i, j, n, m
real(kind=dp) :: eig(num_wann), occ(num_wann)
allocate (HH(num_wann, num_wann))
allocate (delHH(num_wann, num_wann, 3))
allocate (UU(num_wann, num_wann))
allocate (VV(num_wann, num_wann, 3))
allocate (VV0(num_wann, num_wann, 3))
allocate (AA(num_wann, num_wann, 3))
allocate (SS(num_wann, num_wann, 3))
allocate (spinVel0(num_wann, num_wann, 3, 3))
allocate (spinVel(num_wann, num_wann, 3, 3))
allocate (SAA(num_wann, num_wann, 3, 3))
allocate (SBB(num_wann, num_wann, 3, 3))
call pw90common_fourier_R_to_k_new(ws_region, wannier_data, ws_distance, wigner_seitz, &
HH_R, kpt, real_lattice, &
mp_grid, num_wann, error, comm, OO=HH, &
OO_dx=delHH(:, :, 1), &
OO_dy=delHH(:, :, 2), &
OO_dz=delHH(:, :, 3))
if (allocated(error)) return
! call wham_get_eig_deleig(dis_manifold, kpt_latt, pw90_band_deriv_degen, ws_region, print_output, wannier_data, &
! ws_distance, wigner_seitz, delHH, HH, HH_R, u_matrix, UU, v_matrix, &
! del_eig, eig, eigval, kpt, real_lattice, scissors_shift, mp_grid, &
! num_bands, num_kpts, num_wann, num_valence_bands, effective_model, &
! have_disentangled, timer, error, comm)
call utility_diagonalize(HH, num_wann, eig, UU, error, comm)
call pw90common_fourier_R_to_k_vec(ws_region, wannier_data, ws_distance, wigner_seitz, &
AA_R, kpt, &
real_lattice, mp_grid, num_wann, &
error, comm, OO_true=AA)
call pw90common_fourier_R_to_k_vec(ws_region, wannier_data, ws_distance, wigner_seitz, &
SS_R, kpt, &
real_lattice, mp_grid, num_wann, &
error, comm, OO_true=SS)
if (index(pw90_spin_hall%method, 'ryoo') > 0) then
call pw90common_fourier_R_to_k_new(ws_region, wannier_data, ws_distance, wigner_seitz, &
SAA_R(:, :, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha), &
kpt, real_lattice, mp_grid, num_wann, error, comm, &
OO=SAA(:, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha))
call pw90common_fourier_R_to_k_new(ws_region, wannier_data, ws_distance, wigner_seitz, &
SBB_R(:, :, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha), &
kpt, real_lattice, mp_grid, num_wann, error, comm, &
OO=SBB(:, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha))
else
call pw90common_fourier_R_to_k_new(ws_region, wannier_data, ws_distance, wigner_seitz, &
SR_R(:, :, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha), &
kpt, real_lattice, mp_grid, num_wann, error, comm, &
OO=SAA(:, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha))
call pw90common_fourier_R_to_k_new(ws_region, wannier_data, ws_distance, wigner_seitz, &
SHR_R(:, :, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha), &
kpt, real_lattice, mp_grid, num_wann, error, comm, &
OO=SBB(:, :, pw90_spin_hall%gamma, pw90_spin_hall%alpha))
end if
do i = 1, 3
AA(:, :, i) = utility_rotate(AA(:, :, i), UU, num_wann)
SS(:, :, i) = utility_rotate(SS(:, :, i), UU, num_wann)
VV0(:, :, i) = utility_rotate(delHH(:, :, i), UU, num_wann)
do j = 1, 3
SAA(:, :, i, j) = utility_rotate(SAA(:, :, i, j), UU, num_wann)
SBB(:, :, i, j) = utility_rotate(SBB(:, :, i, j), UU, num_wann)
end do
end do
!velocity
do m = 1, num_wann
do n = 1, num_wann
VV(n, m, pw90_spin_hall%beta) = VV0(n, m, pw90_spin_hall%beta) &
- cmplx_i*AA(n, m, pw90_spin_hall%beta)*(eig(m) - eig(n))
end do
end do
!spin velocity
spinVel0 = 0.D0
spinVel = 0.D0
i = pw90_spin_hall%alpha
j = pw90_spin_hall%gamma
spinVel0(:, :, j, i) = matmul(VV0(:, :, i), SS(:, :, j)) + &
matmul(SS(:, :, j), VV0(:, :, i))
do m = 1, num_wann
do n = 1, num_wann
spinVel(n, m, j, i) = spinVel0(n, m, j, i) &
- cmplx_i*(eig(m)*SAA(n, m, j, i) - SBB(n, m, j, i))
spinVel(n, m, j, i) = spinVel(n, m, j, i) &
+ cmplx_i*(eig(n)*conjg(SAA(m, n, j, i)) - conjg(SBB(m, n, j, i)))
end do
end do
spinVel = spinVel/2.0_dp
!output
do n = 1, num_wann
do m = 1, num_wann
imjv(n, m) = aimag(spinVel(n, m, j, i)*VV(m, n, pw90_spin_hall%beta))
end do
end do
eig_out = eig
deallocate (HH)
deallocate (delHH)
deallocate (UU)
deallocate (VV)
deallocate (VV0)
deallocate (AA)
deallocate (SS)
deallocate (spinVel0)
deallocate (spinVel)
deallocate (SAA)
deallocate (SBB)
end subroutine berry_get_shc_tetrahedron
