get_AA_R_effective Subroutine

public subroutine get_AA_R_effective(print_output, AA_R, HH_R, nrpts, num_wann, seedname, stdout, timer, error, comm)

Uses

  • proc~~get_aa_r_effective~~UsesGraph proc~get_aa_r_effective get_AA_R_effective module~w90_types w90_types proc~get_aa_r_effective->module~w90_types module~w90_constants w90_constants module~w90_types->module~w90_constants

AA_a(R) = <0|r_a|R> is the Fourier transform of the Berrry connection AA_a(k) = i (a=x,y,z)

Arguments

Type IntentOptional Attributes Name
type(print_output_type), intent(in) :: print_output
complex(kind=dp), intent(inout), allocatable :: AA_R(:,:,:,:)
complex(kind=dp), intent(inout), allocatable :: HH_R(:,:,:)
integer, intent(in) :: nrpts
integer, intent(in) :: num_wann
character(len=50), intent(in) :: seedname
integer, intent(in) :: stdout
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~get_aa_r_effective~~CallsGraph proc~get_aa_r_effective get_AA_R_effective interface~comms_bcast comms_bcast proc~get_aa_r_effective->interface~comms_bcast proc~io_stopwatch_start io_stopwatch_start proc~get_aa_r_effective->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~get_aa_r_effective->proc~io_stopwatch_stop proc~mpirank mpirank proc~get_aa_r_effective->proc~mpirank proc~set_error_fatal set_error_fatal proc~get_aa_r_effective->proc~set_error_fatal proc~set_error_file set_error_file proc~get_aa_r_effective->proc~set_error_file proc~comms_bcast_char comms_bcast_char interface~comms_bcast->proc~comms_bcast_char proc~comms_bcast_cmplx comms_bcast_cmplx interface~comms_bcast->proc~comms_bcast_cmplx proc~comms_bcast_int comms_bcast_int interface~comms_bcast->proc~comms_bcast_int proc~comms_bcast_logical comms_bcast_logical interface~comms_bcast->proc~comms_bcast_logical proc~comms_bcast_real comms_bcast_real interface~comms_bcast->proc~comms_bcast_real proc~comms_sync_error comms_sync_error proc~set_error_fatal->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_fatal->proc~set_base_error proc~set_error_file->proc~comms_sync_error proc~set_error_file->proc~set_base_error proc~comms_bcast_char->proc~comms_sync_error proc~comms_no_sync_bcast_char comms_no_sync_bcast_char proc~comms_bcast_char->proc~comms_no_sync_bcast_char proc~comms_bcast_cmplx->proc~comms_sync_error proc~comms_no_sync_bcast_cmplx comms_no_sync_bcast_cmplx proc~comms_bcast_cmplx->proc~comms_no_sync_bcast_cmplx proc~comms_bcast_int->proc~comms_sync_error proc~comms_no_sync_bcast_int comms_no_sync_bcast_int proc~comms_bcast_int->proc~comms_no_sync_bcast_int proc~comms_bcast_logical->proc~comms_sync_error proc~comms_no_sync_bcast_logical comms_no_sync_bcast_logical proc~comms_bcast_logical->proc~comms_no_sync_bcast_logical proc~comms_bcast_real->proc~comms_sync_error proc~comms_no_sync_bcast_real comms_no_sync_bcast_real proc~comms_bcast_real->proc~comms_no_sync_bcast_real

Called by

proc~~get_aa_r_effective~~CalledByGraph proc~get_aa_r_effective get_AA_R_effective proc~berry_main berry_main proc~berry_main->proc~get_aa_r_effective proc~berry_get_sc_klist berry_get_sc_klist proc~berry_main->proc~berry_get_sc_klist proc~gyrotropic_main gyrotropic_main proc~gyrotropic_main->proc~get_aa_r_effective proc~k_path k_path proc~k_path->proc~get_aa_r_effective proc~k_slice k_slice proc~k_slice->proc~get_aa_r_effective proc~wham_get_eig_uu_hh_aa_sc_tb_conv wham_get_eig_UU_HH_AA_sc_TB_conv proc~wham_get_eig_uu_hh_aa_sc_tb_conv->proc~get_aa_r_effective proc~berry_get_sc_klist->proc~wham_get_eig_uu_hh_aa_sc_tb_conv program~postw90 postw90 program~postw90->proc~berry_main program~postw90->proc~gyrotropic_main program~postw90->proc~k_path program~postw90->proc~k_slice

Source Code

  subroutine get_AA_R_effective(print_output, AA_R, HH_R, nrpts, num_wann, seedname, stdout, timer, error, comm)
    !================================================
    !
    !! AA_a(R) = <0|r_a|R> is the Fourier transform
    !! of the Berrry connection AA_a(k) = i<u|del_a u>
    !! (a=x,y,z)
    !
    !================================================

    use w90_types, only: print_output_type, timer_list_type, &
                         ws_distance_type, ws_region_type

    implicit none

    ! arguments
    type(print_output_type), intent(in)   :: print_output
    type(timer_list_type), intent(inout) :: timer
    type(w90_comm_type), intent(in)         :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    integer, intent(in) :: num_wann, nrpts, stdout

    complex(kind=dp), allocatable, intent(inout) :: HH_R(:, :, :) !  <0n|r|Rm>
    complex(kind=dp), allocatable, intent(inout) :: AA_R(:, :, :, :) ! <0n|r|Rm>

    character(len=50), intent(in) :: seedname

    ! local variables
    integer                       :: n, m, i, j, file_unit, ir, io, ivdum(3), ivdum_old(3)
    real(kind=dp)                 :: rdum1_real, rdum1_imag, rdum2_real, rdum2_imag, &
                                     rdum3_real, rdum3_imag
    logical                       :: nn_found
    character(len=60)             :: header
    logical :: on_root = .false.

    if (mpirank(comm) == 0) on_root = .true.

    if (print_output%timing_level > 1 .and. print_output%iprint > 0) &
      call io_stopwatch_start('get_oper: get_AA_R', timer)

    if (.not. allocated(AA_R)) then
      allocate (AA_R(num_wann, num_wann, nrpts, 3))
    else
      if (print_output%timing_level > 1 .and. print_output%iprint > 0) &
        call io_stopwatch_stop('get_oper: get_AA_R', timer)
      return
    end if

    ! Real-space position matrix elements read from file
    !
    if (.not. allocated(HH_R)) then
      call set_error_fatal(error, 'Error in get_AA_R: Must read file'//trim(seedname)//'_HH_R.dat first', comm)
      return
    end if
    AA_R = cmplx_0
    if (on_root) then
      write (stdout, '(/a)') ' Reading position matrix elements from file ' &
        //trim(seedname)//'_AA_R.dat'
      open (newunit=file_unit, file=trim(seedname)//'_AA_R.dat', form='formatted', &
            status='old', err=103)
      read (file_unit, *) ! header
      ir = 1
      ivdum_old(:) = 0
      n = 1
      do
        read (file_unit, '(5I5,6F12.6)', iostat=io) &
          ivdum(1:3), j, i, rdum1_real, rdum1_imag, &
          rdum2_real, rdum2_imag, rdum3_real, rdum3_imag
        if (io < 0) exit
        if (i < 1 .or. i > num_wann .or. j < 1 .or. j > num_wann) then
          write (stdout, *) 'num_wann=', num_wann, '  i=', i, '  j=', j
          call set_error_fatal(error, 'Error in get_AA_R: orbital indices out of bounds', comm)
          return
        end if
        if (n > 1) then
          if (ivdum(1) /= ivdum_old(1) .or. ivdum(2) /= ivdum_old(2) .or. &
              ivdum(3) /= ivdum_old(3)) ir = ir + 1
        end if
        ivdum_old = ivdum
        AA_R(j, i, ir, 1) = AA_R(j, i, ir, 1) + cmplx(rdum1_real, rdum1_imag, kind=dp)
        AA_R(j, i, ir, 2) = AA_R(j, i, ir, 2) + cmplx(rdum2_real, rdum2_imag, kind=dp)
        AA_R(j, i, ir, 3) = AA_R(j, i, ir, 3) + cmplx(rdum3_real, rdum3_imag, kind=dp)
        n = n + 1
      end do
      close (file_unit)
      ! AA_R may not contain the same number of R-vectors as HH_R
      ! (e.g., if a diagonal representation of the position matrix
      ! elements is used, but it cannot be larger
      if (ir > nrpts) then
        write (stdout, *) 'ir=', ir, '  nrpts=', nrpts
        call set_error_fatal(error, 'Error in get_AA_R: inconsistent nrpts values', comm)
        return
      end if
    end if
    call comms_bcast(AA_R(1, 1, 1, 1), num_wann*num_wann*nrpts*3, error, comm)
    if (allocated(error)) return

    if (print_output%timing_level > 1 .and. print_output%iprint > 0) &
      call io_stopwatch_stop('get_oper: get_AA_R', timer)
    return ! careful, don't fall into the below!

101 call set_error_file(error, 'Error: Problem opening input file '//trim(seedname)//'.mmn', comm)
    return
102 call set_error_file(error, 'Error: Problem reading input file '//trim(seedname)//'.mmn', comm)
    return
103 call set_error_file(error, 'Error in get_AA_R: problem opening file '//trim(seedname)//'_AA_R.dat', comm)
    return

  end subroutine get_AA_R_effective