| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(lattice), | optional | :: | lat |
subroutine init_tmat(lat)
class(lattice), optional :: lat
! i should create a new, more flexible routine which sets up the
! TMAT for the different lattice types. although i am not sure if
! we need this anymore
! this also depends on the boundary conditions
character(*), parameter :: this_routine = "init_tmat"
integer :: i, ind, iunit, r_i(3), r_j(3), diff(3), j, iunit2
HElement_t(dp) :: mat_el
complex(dp) :: imag
real(dp) :: hop
! depending on the input i either create tmat2d here or is have to
! set it up, so it can be used to create the lattice..
! but for the beginning i think i want to set it up here from the
! lattice structure!
! if the lattice class is alread set up and initialized, this indicates
! that it was build-in created and tmat has to be calculated from it
! now!
if (present(lat)) then
if (t_print_tmat) then
iunit = get_free_unit()
open(iunit, file='TMAT')
iunit2 = get_free_unit()
open(iunit2, file = 'spatial-tmat', status = 'replace')
end if
if (t_twisted_bc) then
! this is the twist implementation with complex hopping
! elements
if (associated(tmat2d)) deallocate(tmat2d)
allocate(tmat2d(nbasis, nbasis))
tmat2d = 0.0_dp
do i = 1, lat%get_nsites()
ind = lat%get_site_index(i)
r_i = lat%get_r_vec(i)
associate(next => lat%get_neighbors(ind))
do j = 1, size(next)
r_j = lat%get_r_vec(next(j))
diff = r_i - r_j
! x-hopping
if (abs(diff(1)) /= 0) then
if (abs(diff(1)) == 1) then
! no hop over boundary
if (diff(1) == 1) then
! then we hop left
! twisted BCs are given in units of
! 2pi/L so a twist of 1 corresponds to
! the same system!
imag = exp(-cmplx(0.0, &
2 * pi / lat%get_length(1) * twisted_bc(1), dp))
else if (diff(1) == -1) then
imag = exp(cmplx(0.0, &
2 * pi / lat%get_length(1) * twisted_bc(1), dp))
else
call stop_all(this_routine, "something wrong!")
end if
else
! hopping over boundary
! directions are otherwise
if (diff(1) > 0) then
imag = exp(cmplx(0.0, &
2 * pi / lat%get_length(1) * twisted_bc(1), dp))
else
imag = exp(-cmplx(0.0, &
2 * pi / lat%get_length(1) * twisted_bc(1), dp))
end if
end if
end if
if (lat%get_ndim() > 1) then
! y-hopping
if (abs(diff(2)) /= 0) then
if (abs(diff(2)) == 1) then
! no hop over boundary
if (diff(2) == 1) then
! then we hop left
imag = exp(-cmplx(0.0, &
2 * pi / lat%get_length(2) * twisted_bc(2), dp))
else if (diff(2) == -1) then
imag = exp(cmplx(0.0, &
2 * pi / lat%get_length(2) * twisted_bc(2), dp))
else
call stop_all(this_routine, "something wrong!")
end if
else
! hopping over boundary
! directions are otherwise
if (diff(2) > 0) then
imag = exp(cmplx(0.0, &
2 * pi / lat%get_length(2) * twisted_bc(2), dp))
else
imag = exp(-cmplx(0.0, &
2 * pi / lat%get_length(2) * twisted_bc(2), dp))
end if
end if
end if
end if
if (lat%get_ndim() > 2) then
call stop_all(this_routine, &
"twisted BCs only implemented up to 2D")
end if
#ifdef CMPLX_
mat_el = imag * bhub
#else
mat_el = h_cast(imag) * bhub
#endif
! beta orbitals:
tmat2d(2 * ind - 1, 2 * next(j) - 1) = mat_el
! alpha:
tmat2d(2 * ind, 2 * next(j)) = mat_el
if (t_print_tmat) then
write(iunit, *) 2 * ind - 1, 2 * next(j) - 1, mat_el
write(iunit, *) 2 * ind, 2 * next(j), mat_el
write(iunit2,*) ind, next(j), mat_el
end if
end do
ASSERT(all(next > 0))
ASSERT(all(next <= nbasis / 2))
end associate
ASSERT(lat%get_nsites() == nbasis / 2)
ASSERT(ind > 0)
ASSERT(ind <= nbasis / 2)
end do
else if (any(t_anti_periodic)) then
! implement anti-periodic BCs specifically
! t_anti_periodic is a vector for the x and y flag
! seperately
if (associated(tmat2d)) deallocate(tmat2d)
allocate(tmat2d(nbasis, nbasis))
tmat2d = 0.0_dp
do i = 1, lat%get_nsites()
ind = lat%get_site_index(i)
r_i = lat%get_r_vec(i)
associate(next => lat%get_neighbors(ind))
do j = 1, size(next)
r_j = lat%get_r_vec(next(j))
diff = r_i - r_j
! x-hopping
if (abs(diff(1)) /= 0) then
if (abs(diff(1)) == 1) then
! no hop over boundary
hop = 1.0_dp
else
if (t_anti_periodic(1)) then
hop = -1.0_dp
else
hop = 1.0_dp
end if
end if
end if
if (lat%get_ndim() > 1) then
! y-hopping
if (abs(diff(2)) /= 0) then
if (abs(diff(2)) == 1) then
! no hop over boundary
hop = 1.0_dp
else
if (t_anti_periodic(2)) then
hop = -1.0_dp
else
hop = 1.0_dp
end if
end if
end if
end if
if (lat%get_ndim() > 2) then
call stop_all(this_routine, &
"anti-periodic BCs only implemented up to 2D")
end if
mat_el = hop * bhub
! beta orbitals:
tmat2d(2 * ind - 1, 2 * next(j) - 1) = mat_el
! alpha:
tmat2d(2 * ind, 2 * next(j)) = mat_el
if (t_print_tmat) then
write(iunit, *) 2 * ind - 1, 2 * next(j) - 1, mat_el
write(iunit, *) 2 * ind, 2 * next(j), mat_el
write(iunit2,*) ind, next(j), mat_el
end if
end do
ASSERT(all(next > 0))
ASSERT(all(next <= nbasis / 2))
end associate
ASSERT(lat%get_nsites() == nbasis / 2)
ASSERT(ind > 0)
ASSERT(ind <= nbasis / 2)
end do
else
! what do i need to do?
! loop over the indices in the lattice and get the neighbors
! and i have to store it in spin-indices remember that!
if (associated(tmat2d)) deallocate(tmat2d)
allocate(tmat2d(nbasis, nbasis))
tmat2d = 0.0_dp
do i = 1, lat%get_nsites()
ind = lat%get_site_index(i)
associate(next => lat%get_neighbors(ind))
! beta orbitals:
tmat2d(2 * ind - 1, 2 * next - 1) = bhub
! alpha:
tmat2d(2 * ind, 2 * next) = bhub
ASSERT(all(next > 0))
ASSERT(all(next <= nbasis / 2))
if (t_print_tmat) then
do j = 1, size(next)
write(iunit, *) 2 * ind - 1, 2 * next(j) - 1, bhub
write(iunit, *) 2 * ind, 2 * next(j), bhub
write(iunit2,*) ind, next(j), bhub
end do
end if
end associate
ASSERT(lat%get_nsites() == nbasis / 2)
ASSERT(ind > 0)
ASSERT(ind <= nbasis / 2)
end do
end if
else
! this indicates that tmat has to be created from an fcidump
! and the lattice is set up afterwards!
end if
if (t_print_tmat) then
close(iunit)
close(iunit2)
end if
end subroutine init_tmat