tran_parity_enforce Subroutine

  subroutine tran_parity_enforce(signatures, print_output, transport, num_wann, tran_sorted_idx, &
                                 hr_one_dim, irvec_max, stdout, timer)
    !================================================!
    ! 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: io_stopwatch_start, io_stopwatch_stop
    use w90_types, only: print_output_type, timer_list_type
    use w90_wannier90_types, only: transport_type

    implicit none

    ! arguments
    integer, intent(in) :: irvec_max
    integer, intent(in) :: num_wann
    integer, intent(in) :: stdout
    integer, intent(in) :: tran_sorted_idx(:)

    real(kind=dp), intent(inout) :: signatures(:, :)
    real(kind=dp), intent(inout) :: hr_one_dim(:, :, -irvec_max:)

    type(print_output_type), intent(in) :: print_output
    type(transport_type), intent(in) :: transport
    type(timer_list_type), intent(inout) :: timer

    ! local variables
    integer :: i, j, k, wf_idx, num_wann_cell_ll
    real(kind=dp) :: signature_dot_p

    if (print_output%timing_level > 1) call io_stopwatch_start('tran: parity_enforce', timer)

    ! 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 (transport%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)
          end do
        end if
      end do
    end if

    num_wann_cell_ll = transport%num_ll/transport%num_cell_ll
    if (print_output%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*transport%num_cell_ll

      ! Loop over wannier functions in unit cell

      do j = 1, num_wann_cell_ll
        if (i .le. 2*transport%num_cell_ll) then
          wf_idx = j + (i - 1)*num_wann_cell_ll
        else
          wf_idx = num_wann - 2*transport%num_ll + j + (i - 1 - 2*transport%num_cell_ll)*num_wann_cell_ll
        end if
        signature_dot_p = dot_product(signatures(:, tran_sorted_idx(j)), signatures(:, tran_sorted_idx(wf_idx)))
        if (print_output%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
        end if
        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 (print_output%iprint .lt. 5) write (stdout, *) 'Dot product of signatures: ', signature_dot_p
        end if
        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)
          end do
        end if
      end do
    end do

    if (print_output%timing_level > 1) call io_stopwatch_stop('tran: parity_enforce', timer)

    return

  end subroutine tran_parity_enforce