wham_get_JJp_JJm_list Subroutine

private subroutine wham_get_JJp_JJm_list(delHH, UU, eig, JJp_list, JJm_list, num_wann, fermi_energy_list, occ)

Uses

  • proc~~wham_get_jjp_jjm_list~~UsesGraph proc~wham_get_jjp_jjm_list wham_get_JJp_JJm_list module~w90_constants w90_constants proc~wham_get_jjp_jjm_list->module~w90_constants module~w90_utility w90_utility proc~wham_get_jjp_jjm_list->module~w90_utility module~w90_utility->module~w90_constants module~w90_comms w90_comms module~w90_utility->module~w90_comms module~w90_comms->module~w90_constants module~w90_error_base w90_error_base module~w90_comms->module~w90_error_base

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout) :: delHH(:,:)
complex(kind=dp), intent(in) :: UU(:,:)
real(kind=dp), intent(in) :: eig(:)
complex(kind=dp), intent(out) :: JJp_list(:,:,:)
complex(kind=dp), intent(out) :: JJm_list(:,:,:)
integer, intent(in) :: num_wann
real(kind=dp), intent(in), allocatable :: fermi_energy_list(:)
real(kind=dp), intent(in), optional, dimension(:) :: occ

Calls

proc~~wham_get_jjp_jjm_list~~CallsGraph proc~wham_get_jjp_jjm_list wham_get_JJp_JJm_list proc~utility_rotate_new utility_rotate_new proc~wham_get_jjp_jjm_list->proc~utility_rotate_new proc~utility_zgemm_new utility_zgemm_new proc~utility_rotate_new->proc~utility_zgemm_new zgemm zgemm proc~utility_zgemm_new->zgemm

Called by

proc~~wham_get_jjp_jjm_list~~CalledByGraph proc~wham_get_jjp_jjm_list wham_get_JJp_JJm_list proc~wham_get_eig_uu_hh_jjlist wham_get_eig_UU_HH_JJlist proc~wham_get_eig_uu_hh_jjlist->proc~wham_get_jjp_jjm_list proc~berry_get_imfgh_klist berry_get_imfgh_klist proc~berry_get_imfgh_klist->proc~wham_get_eig_uu_hh_jjlist proc~berry_get_imf_klist berry_get_imf_klist proc~berry_get_imf_klist->proc~berry_get_imfgh_klist proc~berry_main berry_main proc~berry_main->proc~berry_get_imfgh_klist proc~berry_main->proc~berry_get_imf_klist proc~gyrotropic_get_k_list gyrotropic_get_k_list proc~gyrotropic_get_k_list->proc~berry_get_imfgh_klist proc~gyrotropic_get_k_list->proc~berry_get_imf_klist proc~k_path k_path proc~k_path->proc~berry_get_imfgh_klist proc~k_path->proc~berry_get_imf_klist proc~k_slice k_slice proc~k_slice->proc~berry_get_imfgh_klist proc~k_slice->proc~berry_get_imf_klist proc~gyrotropic_main gyrotropic_main proc~gyrotropic_main->proc~gyrotropic_get_k_list program~postw90 postw90 program~postw90->proc~berry_main program~postw90->proc~k_path program~postw90->proc~k_slice program~postw90->proc~gyrotropic_main

Source Code

  subroutine wham_get_JJp_JJm_list(delHH, UU, eig, JJp_list, JJm_list, num_wann, &
                                   fermi_energy_list, occ)
    !================================================!
    !                                                !
    ! Compute JJ^+_a and JJ^-_a (a=Cartesian index)  !
    ! for a list of Fermi energies                   !
    !                                                !
    ! This routine is a replacement for              !
    ! wham_get_JJp_list and wham_getJJm_list.        !
    ! It computes both lists at once in a more       !
    ! efficient manner.                              !
    !                                                !
    !  Tsirkin:   added the optional occ parameter   !
    !                                                !
    !================================================!

    use w90_constants, only: dp, cmplx_0, cmplx_i
    use w90_utility, only: utility_rotate_new

    ! arguments
    real(kind=dp), allocatable, intent(in) :: fermi_energy_list(:)
    integer, intent(in) :: num_wann
    real(kind=dp), intent(in) :: eig(:)
    real(kind=dp), intent(in), optional, dimension(:) :: occ
    complex(kind=dp), intent(inout) :: delHH(:, :)
    complex(kind=dp), intent(in) :: UU(:, :)
    complex(kind=dp), intent(out) :: JJm_list(:, :, :)
    complex(kind=dp), intent(out) :: JJp_list(:, :, :)

    ! local variables
    integer :: n, m, ife, nfermi_loc
    real(kind=dp) :: fe

    if (present(occ)) then
      nfermi_loc = 1
    else
      nfermi_loc = 0
      if (allocated(fermi_energy_list)) nfermi_loc = size(fermi_energy_list)
    end if

    call utility_rotate_new(delHH, UU, num_wann)
    do ife = 1, nfermi_loc
      fe = fermi_energy_list(ife)
      do m = 1, num_wann
        do n = 1, num_wann
          if (present(occ)) then
            if (occ(m) < 0.5_dp .and. occ(n) > 0.5_dp) then
              JJm_list(n, m, ife) = cmplx_i*delHH(n, m)/(eig(m) - eig(n))
              JJp_list(m, n, ife) = cmplx_i*delHH(m, n)/(eig(n) - eig(m))
            else
              JJm_list(n, m, ife) = cmplx_0
              JJp_list(m, n, ife) = cmplx_0
            end if
          else
            if (eig(n) > fe .and. eig(m) < fe) then
              JJp_list(n, m, ife) = cmplx_i*delHH(n, m)/(eig(m) - eig(n))
              JJm_list(m, n, ife) = cmplx_i*delHH(m, n)/(eig(n) - eig(m))
            else
              JJp_list(n, m, ife) = cmplx_0
              JJm_list(m, n, ife) = cmplx_0
            end if
          end if
        end do
      end do
      call utility_rotate_new(JJp_list(:, :, ife), UU, num_wann, reverse=.true.)
      call utility_rotate_new(JJm_list(:, :, ife), UU, num_wann, reverse=.true.)
    end do

  end subroutine wham_get_JJp_JJm_list