subroutine tran_parity_enforce(signatures)
!==============================================================!
! Here, the signatures of the each wannier fucntion (stored in !
! signatures) is used to determine its relavite parity !
! with respect to the first unit cell. The parity pattern of !
! first unit cell is then enforced. !
!==============================================================!
use w90_constants, only: dp
use w90_io, only: stdout, io_stopwatch
use w90_parameters, only: tran_num_cell_ll, num_wann, tran_num_ll, &
timing_level, iprint, tran_easy_fix
implicit none
real(dp), intent(inout), dimension(:, :) :: signatures
integer :: i, j, k, wf_idx, num_wann_cell_ll
real(dp) :: signature_dot_p
if (timing_level > 1) call io_stopwatch('tran: parity_enforce', 1)
!
! NP: special "easy" fix of the parities by switching the sign
! of the Wannier Functions if the first element of the signature
! is found negative. Then updating the signature and the Hamiltonian
! matrix element for the corresponding line and column
!
if (tran_easy_fix) then
do i = 1, num_wann
if (real(signatures(1, i)) .lt. 0.0_dp) then
signatures(:, i) = -signatures(:, i)
do k = 1, num_wann
hr_one_dim(k, i, 0) = -hr_one_dim(k, i, 0)
hr_one_dim(i, k, 0) = -hr_one_dim(i, k, 0)
enddo
endif
enddo
endif
num_wann_cell_ll = tran_num_ll/tran_num_cell_ll
if (iprint .eq. 5) write (stdout, '(a101)') 'Unit cell Sorted WF index Unsort WF index &
&Unsorted WF Equiv Signature Dot Product'
!
! Loop over unit cell in principal layers
!
do i = 2, 4*tran_num_cell_ll
!
! Loop over wannier functions in unit cell
!
do j = 1, num_wann_cell_ll
if (i .le. 2*tran_num_cell_ll) then
wf_idx = j + (i - 1)*num_wann_cell_ll
else
wf_idx = num_wann - 2*tran_num_ll + j + (i - 1 - 2*tran_num_cell_ll)*num_wann_cell_ll
endif
signature_dot_p = dot_product(signatures(:, tran_sorted_idx(j)), signatures(:, tran_sorted_idx(wf_idx)))
if (iprint .eq. 5) then
write (stdout, '(2x,i4,3(13x,i5),12x,f20.17)') &
i, wf_idx, tran_sorted_idx(wf_idx), tran_sorted_idx(j), signature_dot_p
endif
if (abs(signature_dot_p) .le. 0.8_dp) then
write (stdout, '(a28,i4,a64,i4,a20)') ' WARNING: Wannier function (', tran_sorted_idx(wf_idx), &
') seems to has poor resemblance to equivalent wannier function (', tran_sorted_idx(j), ') in first unit cell'
if (iprint .lt. 5) write (stdout, *) 'Dot product of signatures: ', signature_dot_p
endif
if (signature_dot_p .lt. 0.0_dp) then
do k = 1, num_wann
hr_one_dim(k, tran_sorted_idx(wf_idx), 0) = -hr_one_dim(k, tran_sorted_idx(wf_idx), 0)
hr_one_dim(tran_sorted_idx(wf_idx), k, 0) = -hr_one_dim(tran_sorted_idx(wf_idx), k, 0)
enddo
endif
enddo
enddo
if (timing_level > 1) call io_stopwatch('tran: parity_enforce', 2)
return
end subroutine tran_parity_enforce