ws_translate_dist Subroutine

public subroutine ws_translate_dist(ws_distance, ws_region, num_wann, wannier_centres, real_lattice, mp_grid, nrpts, irvec, error, comm, force_recompute)

Uses

  • proc~~ws_translate_dist~~UsesGraph proc~ws_translate_dist ws_translate_dist module~w90_types w90_types proc~ws_translate_dist->module~w90_types module~w90_utility w90_utility proc~ws_translate_dist->module~w90_utility module~w90_constants w90_constants module~w90_types->module~w90_constants module~w90_comms w90_comms module~w90_utility->module~w90_comms module~w90_utility->module~w90_constants module~w90_comms->module~w90_constants module~w90_error_base w90_error_base module~w90_comms->module~w90_error_base

Find the supercell translation (i.e. the translation by a integer number of supercell vectors, the supercell being defined by the mp_grid) that minimizes the distance between two given Wannier functions, i and j, the first in unit cell 0, the other in unit cell R. I.e., we find the translation to put WF j in the Wigner-Seitz of WF i. We also look for the number of equivalent translation, that happen when w_j,R is on the edge of the WS of w_i,0. The results are stored in global arrays wdist_ndeg, irdist_ws, crdist_ws.

Arguments

Type IntentOptional Attributes Name
type(ws_distance_type), intent(inout) :: ws_distance
type(ws_region_type), intent(in) :: ws_region
integer, intent(in) :: num_wann
real(kind=dp), intent(in) :: wannier_centres(:,:)
real(kind=dp), intent(in) :: real_lattice(3,3)
integer, intent(in) :: mp_grid(3)
integer, intent(in) :: nrpts
integer, intent(in) :: irvec(:,:)
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm
logical, intent(in), optional :: force_recompute

Calls

proc~~ws_translate_dist~~CallsGraph proc~ws_translate_dist ws_translate_dist proc~clean_ws_translate clean_ws_translate proc~ws_translate_dist->proc~clean_ws_translate proc~r_wz_sc R_wz_sc proc~ws_translate_dist->proc~r_wz_sc proc~set_error_alloc set_error_alloc proc~ws_translate_dist->proc~set_error_alloc proc~set_error_fatal set_error_fatal proc~ws_translate_dist->proc~set_error_fatal proc~utility_frac_to_cart utility_frac_to_cart proc~ws_translate_dist->proc~utility_frac_to_cart proc~utility_inverse_mat utility_inverse_mat proc~ws_translate_dist->proc~utility_inverse_mat proc~set_error_dealloc set_error_dealloc proc~clean_ws_translate->proc~set_error_dealloc proc~r_wz_sc->proc~set_error_fatal proc~r_wz_sc->proc~utility_frac_to_cart proc~utility_cart_to_frac utility_cart_to_frac proc~r_wz_sc->proc~utility_cart_to_frac proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error proc~utility_inv3 utility_inv3 proc~utility_inverse_mat->proc~utility_inv3 proc~set_error_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error

Called by

proc~~ws_translate_dist~~CalledByGraph proc~ws_translate_dist ws_translate_dist proc~plot_interpolate_bands plot_interpolate_bands proc~plot_interpolate_bands->proc~ws_translate_dist proc~plot_main plot_main proc~plot_main->proc~ws_translate_dist proc~plot_main->proc~plot_interpolate_bands proc~pw90common_wanint_setup pw90common_wanint_setup proc~pw90common_wanint_setup->proc~ws_translate_dist proc~w90_plot w90_plot proc~w90_plot->proc~plot_main program~postw90 postw90 program~postw90->proc~pw90common_wanint_setup program~wannier wannier program~wannier->proc~w90_plot

Source Code

  subroutine ws_translate_dist(ws_distance, ws_region, num_wann, wannier_centres, real_lattice, &
                               mp_grid, nrpts, irvec, error, comm, force_recompute)
    !================================================!
    !! Find the supercell translation (i.e. the translation by a integer number of
    !! supercell vectors, the supercell being defined by the mp_grid) that
    !! minimizes the distance between two given Wannier functions, i and j,
    !! the first in unit cell 0, the other in unit cell R.
    !! I.e., we find the translation to put WF j in the Wigner-Seitz of WF i.
    !! We also look for the number of equivalent translation, that happen when w_j,R
    !! is on the edge of the WS of w_i,0. The results are stored in global
    !! arrays wdist_ndeg, irdist_ws, crdist_ws.
    !================================================!

    use w90_utility, only: utility_cart_to_frac, utility_frac_to_cart, utility_inverse_mat
    use w90_types, only: ws_region_type, ws_distance_type

    implicit none

    type(ws_distance_type), intent(inout) :: ws_distance
    type(ws_region_type), intent(in) :: ws_region
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    integer, intent(in) :: mp_grid(3)
    integer, intent(in) :: num_wann
    integer, intent(in) :: nrpts
    integer, intent(in) :: irvec(:, :)

    real(kind=dp), intent(in) :: real_lattice(3, 3)
    real(kind=dp), intent(in) :: wannier_centres(:, :)

    logical, optional, intent(in):: force_recompute ! set to true to force recomputing everything

    ! local variables
    real(kind=dp) :: inv_lattice(3, 3)
    integer  :: iw, jw, ideg, ir, ierr
    integer :: shifts(3, ndegenx)
    real(DP) :: irvec_cart(3), tmp(3), tmp_frac(3), R_out(3, ndegenx)

    ! The subroutine does nothing if called more than once, which may
    ! not be the best thing if you invoke it while the WFs are moving
    if (present(force_recompute)) then
      if (force_recompute) then
        call clean_ws_translate(ws_distance, error, comm)
        if (allocated(error)) return
      end if
    end if
    if (ws_distance%done) return
    ws_distance%done = .true.

    if (ndegenx*num_wann*nrpts <= 0) then
      call set_error_fatal(error, "unexpected dimensions in ws_translate_dist", comm)
      return
    end if

    allocate (ws_distance%irdist(3, ndegenx, num_wann, num_wann, nrpts), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating irdist_ws in ws_translate_dist', comm)
      return
    end if
    allocate (ws_distance%crdist(3, ndegenx, num_wann, num_wann, nrpts), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating crdist_ws in ws_translate_dist', comm)
      return
    end if
    allocate (ws_distance%ndeg(num_wann, num_wann, nrpts), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating wcenter_ndeg in ws_translate_dist', comm)
      return
    end if

    !translation_centre_frac = 0._dp
    ws_distance%ndeg = 0
    ws_distance%irdist = 0
    ws_distance%crdist = 0

    call utility_inverse_mat(real_lattice, inv_lattice)
    do ir = 1, nrpts
      do jw = 1, num_wann
        do iw = 1, num_wann
          call utility_frac_to_cart(REAL(irvec(:, ir), kind=dp), irvec_cart, real_lattice)
          ! function JW translated in the Wigner-Seitz around function IW
          ! and also find its degeneracy, and the integer shifts needed
          ! to identify it
          ! Note: the routine outputs R_out, but we don't really need it
          ! This is kept in case in the future we might want to use it
          ! R_out contains the actual vector between the two WFs. We
          ! calculate instead crdist_ws, that is the Bravais lattice vector
          ! between two supercell lattices, that is the only one we need
          ! later for interpolation etc.
          call r_wz_sc(-wannier_centres(:, iw) &
                       + (irvec_cart + wannier_centres(:, jw)), (/0._dp, 0._dp, 0._dp/), &
                       ws_distance%ndeg(iw, jw, ir), R_out, shifts, mp_grid, real_lattice, &
                       inv_lattice, ws_region%ws_search_size, ws_region%ws_distance_tol, &
                       error, comm)
          if (allocated(error)) return

          do ideg = 1, ws_distance%ndeg(iw, jw, ir)
            ws_distance%irdist(:, ideg, iw, jw, ir) = irvec(:, ir) + shifts(:, ideg)
            tmp_frac = REAL(ws_distance%irdist(:, ideg, iw, jw, ir), kind=dp)
            CALL utility_frac_to_cart(tmp_frac, tmp, real_lattice)
            ws_distance%crdist(:, ideg, iw, jw, ir) = tmp
          end do
        end do
      end do
    end do
  end subroutine ws_translate_dist