sitesym_symmetrize_u_matrix Subroutine

public subroutine sitesym_symmetrize_u_matrix(sitesym, umat, num_bands, ndim, num_kpts, num_wann, stdout, error, comm, lwindow_in)

Uses

  • proc~~sitesym_symmetrize_u_matrix~~UsesGraph proc~sitesym_symmetrize_u_matrix sitesym_symmetrize_u_matrix module~w90_wannier90_types w90_wannier90_types proc~sitesym_symmetrize_u_matrix->module~w90_wannier90_types module~w90_constants w90_constants module~w90_wannier90_types->module~w90_constants

Arguments

Type IntentOptional Attributes Name
type(sitesym_type), intent(in) :: sitesym
complex(kind=dp), intent(inout) :: umat(:,:,:)
integer, intent(in) :: num_bands
integer, intent(in) :: ndim
integer, intent(in) :: num_kpts
integer, intent(in) :: num_wann
integer, intent(in) :: stdout
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm
logical, intent(in), optional :: lwindow_in(:,:)

Calls

proc~~sitesym_symmetrize_u_matrix~~CallsGraph proc~sitesym_symmetrize_u_matrix sitesym_symmetrize_u_matrix proc~set_error_fatal set_error_fatal proc~sitesym_symmetrize_u_matrix->proc~set_error_fatal proc~symmetrize_ukirr symmetrize_ukirr proc~sitesym_symmetrize_u_matrix->proc~symmetrize_ukirr zgemm zgemm proc~sitesym_symmetrize_u_matrix->zgemm 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~symmetrize_ukirr->proc~set_error_fatal proc~symmetrize_ukirr->zgemm proc~orthogonalize_u orthogonalize_u proc~symmetrize_ukirr->proc~orthogonalize_u proc~set_error_unconv set_error_unconv proc~symmetrize_ukirr->proc~set_error_unconv proc~orthogonalize_u->proc~set_error_fatal proc~set_error_dealloc set_error_dealloc proc~orthogonalize_u->proc~set_error_dealloc zgesvd zgesvd proc~orthogonalize_u->zgesvd proc~set_error_unconv->proc~comms_sync_error proc~set_error_unconv->proc~set_base_error proc~set_error_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error

Called by

proc~~sitesym_symmetrize_u_matrix~~CalledByGraph proc~sitesym_symmetrize_u_matrix sitesym_symmetrize_u_matrix proc~dis_extract dis_extract proc~dis_extract->proc~sitesym_symmetrize_u_matrix proc~dis_main dis_main proc~dis_main->proc~sitesym_symmetrize_u_matrix proc~dis_main->proc~dis_extract proc~internal_find_u internal_find_u proc~dis_main->proc~internal_find_u proc~internal_find_u->proc~sitesym_symmetrize_u_matrix proc~overlap_project overlap_project proc~overlap_project->proc~sitesym_symmetrize_u_matrix proc~w90_disentangle~2 w90_disentangle proc~w90_disentangle~2->proc~dis_main proc~w90_project_overlap~2 w90_project_overlap proc~w90_project_overlap~2->proc~overlap_project proc~w90_disentangle w90_disentangle proc~w90_disentangle->proc~w90_disentangle~2 proc~w90_project_overlap w90_project_overlap proc~w90_project_overlap->proc~w90_project_overlap~2 program~wannier wannier program~wannier->proc~w90_disentangle~2 program~wannier->proc~w90_project_overlap~2

Source Code

  subroutine sitesym_symmetrize_u_matrix(sitesym, umat, num_bands, ndim, num_kpts, num_wann, &
                                         stdout, error, comm, lwindow_in)
    !================================================!
    !
    ! calculate U(Rk)=d(R,k)*U(k)*D^{\dagger}(R,k) in the following two cases:
    !
    ! 1. "disentanglement" phase (present(lwindow))
    !    ndim=num_bands
    !
    ! 2. Minimization of Omega_{D+OD} (.not.present(lwindow))
    !    ndim=num_wann,  d=sym%d_matrix_band
    !
    !================================================!

    use w90_wannier90_types, only: sitesym_type

    implicit none

    ! arguments
    type(sitesym_type), intent(in) :: sitesym
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    integer, intent(in) :: num_bands
    integer, intent(in) :: stdout
    integer, intent(in) :: num_wann
    integer, intent(in) :: num_kpts
    integer, intent(in) :: ndim

    complex(kind=dp), intent(inout) :: umat(:, :, :) !(ndim, num_wann, num_kpts)

    logical, optional, intent(in) :: lwindow_in(:, :) !(num_bands, num_kpts)

    ! local variables
    integer :: ik, ir, isym, irk, n
    logical :: ldone(num_kpts)
    complex(kind=dp) :: cmat(ndim, num_wann)

    if (present(lwindow_in) .and. (ndim .ne. num_bands)) then
      call set_error_fatal(error, 'ndim!=num_bands', comm)
      return
    end if
    if (.not. present(lwindow_in)) then
      if (ndim .ne. num_wann) then
        call set_error_fatal(error, 'ndim!=num_wann', comm)
        return
      end if
    end if

    ldone = .false.
    do ir = 1, sitesym%nkptirr
      ik = sitesym%ir2ik(ir)
      ldone(ik) = .true.
      if (present(lwindow_in)) then
        n = count(lwindow_in(:, ik))
      else
        n = ndim
      end if
      if (present(lwindow_in)) then
        call symmetrize_ukirr(num_wann, num_bands, ir, ndim, umat(:, :, ik), sitesym, stdout, &
                              error, comm, n)
      else
        call symmetrize_ukirr(num_wann, num_bands, ir, ndim, umat(:, :, ik), sitesym, stdout, &
                              error, comm)
      end if
      if (allocated(error)) return

      do isym = 2, sitesym%nsymmetry
        irk = sitesym%kptsym(isym, ir)
        if (ldone(irk)) cycle
        ldone(irk) = .true.
        ! cmat = d(R,k) * U(k)
        call zgemm('N', 'N', n, num_wann, n, cmplx_1, &
                   sitesym%d_matrix_band(:, :, isym, ir), ndim, &
                   umat(:, :, ik), ndim, cmplx_0, cmat, ndim)

        ! umat(Rk) = cmat*D^{+}(R,k) = d(R,k) * U(k) * D^{+}(R,k)
        call zgemm('N', 'C', n, num_wann, num_wann, cmplx_1, cmat, ndim, &
                   sitesym%d_matrix_wann(:, :, isym, ir), num_wann, cmplx_0, umat(:, :, irk), ndim)
      end do
    end do
    if (any(.not. ldone)) then
      call set_error_fatal(error, 'error in sitesym_symmetrize_u_matrix', comm)
      return
    end if

    return
  end subroutine sitesym_symmetrize_u_matrix