tran_reduce_hr Subroutine

  1. transport.F90
  2. w90_transport
  3. tran_reduce_hr

private subroutine tran_reduce_hr()

Uses

  • proc~~tran_reduce_hr~~UsesGraph proc~tran_reduce_hr tran_reduce_hr module~w90_constants w90_constants proc~tran_reduce_hr->module~w90_constants module~w90_io w90_io proc~tran_reduce_hr->module~w90_io module~w90_parameters w90_parameters proc~tran_reduce_hr->module~w90_parameters module~w90_hamiltonian w90_hamiltonian proc~tran_reduce_hr->module~w90_hamiltonian module~w90_io->module~w90_constants module~w90_parameters->module~w90_constants module~w90_parameters->module~w90_io module~w90_hamiltonian->module~w90_constants module~w90_comms w90_comms module~w90_hamiltonian->module~w90_comms module~w90_comms->module~w90_constants module~w90_comms->module~w90_io

Arguments

None

Calls

proc~~tran_reduce_hr~~CallsGraph proc~tran_reduce_hr tran_reduce_hr proc~io_error io_error proc~tran_reduce_hr->proc~io_error

Called by

proc~~tran_reduce_hr~~CalledByGraph proc~tran_reduce_hr tran_reduce_hr proc~tran_lcr_2c2_build_ham tran_lcr_2c2_build_ham proc~tran_lcr_2c2_build_ham->proc~tran_reduce_hr proc~tran_main tran_main proc~tran_main->proc~tran_reduce_hr proc~tran_main->proc~tran_lcr_2c2_build_ham proc~tran_lcr_2c2_sort tran_lcr_2c2_sort proc~tran_main->proc~tran_lcr_2c2_sort proc~tran_lcr_2c2_sort->proc~tran_reduce_hr program~wannier wannier program~wannier->proc~tran_main proc~wannier_run wannier_run proc~wannier_run->proc~tran_main

Contents

Source Code

tran_reduce_hr

Source Code

  subroutine tran_reduce_hr()
    !==================================================================!
    !
    ! reduce ham_r from 3-d to 1-d
    !
    use w90_constants, only: dp, eps8
    use w90_io, only: io_error, io_stopwatch, stdout
    use w90_parameters, only: one_dim_dir, real_lattice, num_wann, &
      mp_grid, timing_level
    use w90_hamiltonian, only: irvec, nrpts, ham_r

    implicit none

    integer :: ierr
    integer :: irvec_max, irvec_tmp(3), two_dim_vec(2)
    integer :: i, j
    integer :: i1, i2, i3, n1, nrpts_tmp, loop_rpt

    if (timing_level > 1) call io_stopwatch('tran: reduce_hr', 1)

    ! Find one_dim_vec which is parallel to one_dim_dir
    ! two_dim_vec - the other two lattice vectors
    j = 0
    do i = 1, 3
      if (abs(abs(real_lattice(one_dim_dir, i)) &
              - sqrt(dot_product(real_lattice(:, i), real_lattice(:, i)))) .lt. eps8) then
        one_dim_vec = i
        j = j + 1
      end if
    end do
    if (j .ne. 1) then
      write (stdout, '(i3,a)') j, ' : 1-D LATTICE VECTOR NOT DEFINED'
      call io_error('Error: 1-d lattice vector not defined in tran_reduce_hr')
    end if

    j = 0
    do i = 1, 3
      if (i .ne. one_dim_vec) then
        j = j + 1
        two_dim_vec(j) = i
      end if
    end do

    ! starting H matrix should include all W-S supercell where
    ! the center of the cell spans the full space of the home cell
    ! adding one more buffer layer when mp_grid(one_dim_vec) is an odd number

    !irvec_max = (mp_grid(one_dim_vec)+1)/2
    irvec_tmp = maxval(irvec, DIM=2) + 1
    irvec_max = irvec_tmp(one_dim_vec)
    nrpts_one_dim = 2*irvec_max + 1

    allocate (hr_one_dim(num_wann, num_wann, -irvec_max:irvec_max), stat=ierr)
    if (ierr /= 0) call io_error('Error in allocating hr_one_dim in tran_reduce_hr')
    hr_one_dim = 0.0_dp

    ! check imaginary part
    write (stdout, '(1x,a,F12.6)') 'Maximum imaginary part of the real-space Hamiltonian: ', maxval(abs(aimag(ham_r)))

    ! select a subset of ham_r, where irvec is 0 along the two other lattice vectors

    nrpts_tmp = 0
    loop_n1: do n1 = -irvec_max, irvec_max
      do loop_rpt = 1, nrpts
        i1 = mod(n1 - irvec(one_dim_vec, loop_rpt), mp_grid(one_dim_vec))
        i2 = irvec(two_dim_vec(1), loop_rpt)
        i3 = irvec(two_dim_vec(2), loop_rpt)
        if (i1 .eq. 0 .and. i2 .eq. 0 .and. i3 .eq. 0) then
          nrpts_tmp = nrpts_tmp + 1
          hr_one_dim(:, :, n1) = real(ham_r(:, :, loop_rpt), dp)
          cycle loop_n1
        end if
      end do
    end do loop_n1

    if (nrpts_tmp .ne. nrpts_one_dim) then
      write (stdout, '(a)') 'FAILED TO EXTRACT 1-D HAMILTONIAN'
      call io_error('Error: cannot extract 1d hamiltonian in tran_reduce_hr')
    end if

    if (timing_level > 1) call io_stopwatch('tran: reduce_hr', 2)

    return

  end subroutine tran_reduce_hr