subroutine tran_bulk(transport, hB0, hB1, timing_level, stdout, seedname, timer, error, comm)
!================================================!
use w90_constants, only: dp, cmplx_0, cmplx_1, cmplx_i, pi
use w90_io, only: io_stopwatch_start, io_stopwatch_stop, io_date
use w90_wannier90_types, only: transport_type
use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc
use w90_types, only: timer_list_type
implicit none
! arguments
integer, intent(in) :: stdout
integer, intent(in) :: timing_level
real(kind=dp), allocatable :: hB0(:, :)
real(kind=dp), allocatable :: hB1(:, :)
type(transport_type), intent(in) :: transport
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), allocatable, intent(out) :: error
type(w90_comm_type), intent(in) :: comm
character(len=50), intent(in) :: seedname
! local variables
integer :: qc_unit, dos_unit
integer :: ierr
integer :: n_e, n, i
real(kind=dp) :: qc, dos
real(kind=dp) :: e_scan
complex(kind=dp) :: e_scan_cmp
complex(kind=dp), allocatable, dimension(:, :) :: tot, tott
complex(kind=dp), allocatable, dimension(:, :) :: g_B, gR, gL
complex(kind=dp), allocatable, dimension(:, :) :: sLr, sRr
complex(kind=dp), allocatable, dimension(:, :) :: s1, s2, c1
character(len=50) :: filename
character(len=9) :: cdate, ctime
if (timing_level > 1) call io_stopwatch_start('tran: bulk', timer)
allocate (tot(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating tot in tran_bulk', comm)
return
end if
allocate (tott(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating tott in tran_bulk', comm)
return
end if
allocate (g_B(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating g_B in tran_bulk', comm)
return
end if
allocate (gL(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating gL in tran_bulk', comm)
return
end if
allocate (gR(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating gR in tran_bulk', comm)
return
end if
allocate (sLr(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating sLr in tran_bulk', comm)
return
end if
allocate (sRr(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating sRr in tran_bulk', comm)
return
end if
allocate (s1(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating s1 in tran_bulk', comm)
return
end if
allocate (s2(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating s2 in tran_bulk', comm)
return
end if
allocate (c1(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating c1 in tran_bulk', comm)
return
end if
call io_date(cdate, ctime)
open (newunit=qc_unit, file=trim(seedname)//'_qc.dat', status='unknown', &
form='formatted', action='write')
write (qc_unit, *) '## written on '//cdate//' at '//ctime ! Date and time
open (newunit=dos_unit, file=trim(seedname)//'_dos.dat', status='unknown', &
form='formatted', action='write')
write (dos_unit, *) '## written on '//cdate//' at '//ctime ! Date and time
! set up the layer hamiltonians
if (transport%read_ht) then
allocate (hB0(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating hB0 in tran_bulk', comm)
return
end if
allocate (hB1(transport%num_bb, transport%num_bb), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating hB1 in tran_bulk', comm)
return
end if
filename = trim(seedname)//'_htB.dat'
call tran_read_htX(transport%num_bb, hB0, hB1, filename, stdout, error, comm)
if (allocated(error)) return
end if
! loop over the energies
n_e = floor((transport%win_max - transport%win_min)/transport%energy_step) + 1
write (stdout, '(/1x,a)', advance='no') 'Calculating quantum&
& conductance and density of states...'
do n = 1, n_e
e_scan = transport%win_min + real(n - 1, dp)*transport%energy_step
! if (mod(n,nint(0.1*n_e)).eq.0) write(stdout,'(a)',advance='no') '.'
! compute conductance according to Fisher and Lee
! retarded Green
e_scan_cmp = e_scan + eta
call tran_transfer(tot, tott, hB0, hB1, e_scan_cmp, transport%num_bb, stdout, error, comm)
if (allocated(error)) return
call tran_green(tot, tott, hB0, hB1, e_scan, g_B, 0, 1, transport%num_bb, stdout, error, comm)
if (allocated(error)) return
! compute S_Lr and S_Rr
c1(:, :) = cmplx(hB1(:, :), kind=dp)
! Self-energy (Sigma_L^r) : sLr = (hB1)^+ * tott
! Self-energy (Sigma_R^r) : sRr = (hB1) * tot
sLr = cmplx_0
sRr = cmplx_0
call ZGEMM('C', 'N', transport%num_bb, transport%num_bb, transport%num_bb, cmplx_1, c1, &
transport%num_bb, tott, transport%num_bb, cmplx_0, sLr, transport%num_bb)
call ZGEMM('N', 'N', transport%num_bb, transport%num_bb, transport%num_bb, cmplx_1, c1, &
transport%num_bb, tot, transport%num_bb, cmplx_0, sRr, transport%num_bb)
! Gamma_L = i(Sigma_L^r-Sigma_L^a)
gL = cmplx_i*(sLr - conjg(transpose(sLr)))
! Gamma_R = i(Sigma_R^r-Sigma_R^a)
gR = cmplx_i*(sRr - conjg(transpose(sRr)))
s1 = cmplx_0
s2 = cmplx_0
c1 = cmplx_0
! s1 = Gamma_L * g_B^r
call ZGEMM('N', 'N', transport%num_bb, transport%num_bb, transport%num_bb, cmplx_1, gL, &
transport%num_bb, g_B, transport%num_bb, cmplx_0, s1, transport%num_bb)
! s2 = Gamma_L * g_B^r * Gamma_R
call ZGEMM('N', 'N', transport%num_bb, transport%num_bb, transport%num_bb, cmplx_1, s1, &
transport%num_bb, gR, transport%num_bb, cmplx_0, s2, transport%num_bb)
! c1 = Gamma_L * g_B^r * Gamma_R * g_B^a
call ZGEMM('N', 'C', transport%num_bb, transport%num_bb, transport%num_bb, cmplx_1, s2, &
transport%num_bb, g_B, transport%num_bb, cmplx_0, c1, transport%num_bb)
qc = 0.0_dp
do i = 1, transport%num_bb
qc = qc + real(c1(i, i), dp)
end do
write (qc_unit, '(f15.9,f18.9)') e_scan, qc
dos = 0.0_dp
do i = 1, transport%num_bb
dos = dos - aimag(g_B(i, i))
end do
dos = dos/pi
write (dos_unit, '(f15.9,f18.9)') e_scan, dos
end do
write (stdout, '(a/)') ' done'
close (qc_unit)
close (dos_unit)
deallocate (c1, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating c1 in tran_bulk', comm)
return
end if
deallocate (s2, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating s2 in tran_bulk', comm)
return
end if
deallocate (s1, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating s1 in tran_bulk', comm)
return
end if
deallocate (sRr, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating sRr in tran_bulk', comm)
return
end if
deallocate (sLr, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating sLr in tran_bulk', comm)
return
end if
deallocate (gR, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating gR in tran_bulk', comm)
return
end if
deallocate (gL, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating gL in tran_bulk', comm)
return
end if
deallocate (g_B, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating g_B in tran_bulk', comm)
return
end if
deallocate (tott, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating tott in tran_bulk', comm)
return
end if
deallocate (tot, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating tot in tran_bulk', comm)
return
end if
if (timing_level > 1) call io_stopwatch_stop('tran: bulk', timer)
return
end subroutine tran_bulk
