dis_windows Subroutine

public subroutine dis_windows(dis_spheres, dis_manifold, eigval_opt, kpt_latt, recip_lattice, indxfroz, indxnfroz, ndimfroz, iprint, num_bands, num_kpts, num_wann, timing_level, lfrozen, linner, on_root, stdout, timer, error, comm)

Uses

  • proc~~dis_windows~~UsesGraph proc~dis_windows dis_windows module~w90_constants w90_constants proc~dis_windows->module~w90_constants module~w90_error w90_error proc~dis_windows->module~w90_error module~w90_io w90_io proc~dis_windows->module~w90_io module~w90_types w90_types proc~dis_windows->module~w90_types module~w90_wannier90_types w90_wannier90_types proc~dis_windows->module~w90_wannier90_types module~w90_comms w90_comms module~w90_error->module~w90_comms module~w90_error_base w90_error_base module~w90_error->module~w90_error_base module~w90_io->module~w90_constants module~w90_types->module~w90_constants module~w90_wannier90_types->module~w90_constants module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

This subroutine selects the states that are inside the outer window (ie, the energy window out of which we fish out the optimally-connected subspace) and those that are inside the inner window (that make up the frozen manifold, and are straightfowardly included as they are). This, in practice, amounts to slimming down the original num_wann x num_wann overlap matrices, removing rows and columns that belong to u_nks that have been excluded forever, and marking (indexing) the rows and columns that correspond to frozen states.

Note - in windows eigval_opt are shifted, so the lowest ones go from nfirstwin(nkp) to nfirstwin(nkp)+ndimwin(nkp)-1, and above they are set to zero.

Arguments

Type IntentOptional Attributes Name
type(dis_spheres_type), intent(in) :: dis_spheres
type(dis_manifold_type), intent(inout) :: dis_manifold
real(kind=dp), intent(inout) :: eigval_opt(:,:)
real(kind=dp), intent(in) :: kpt_latt(3,num_kpts)
real(kind=dp), intent(in) :: recip_lattice(3,3)
integer, intent(inout) :: indxfroz(:,:)
integer, intent(inout) :: indxnfroz(:,:)
integer, intent(inout) :: ndimfroz(:)
integer, intent(in) :: iprint
integer, intent(in) :: num_bands
integer, intent(in) :: num_kpts
integer, intent(in) :: num_wann
integer, intent(in) :: timing_level
logical, intent(inout) :: lfrozen(:,:)
logical, intent(inout) :: linner
logical, intent(in) :: on_root
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~~dis_windows~~CallsGraph proc~dis_windows dis_windows 10 10 proc~dis_windows->10 proc~io_stopwatch_start io_stopwatch_start proc~dis_windows->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~dis_windows->proc~io_stopwatch_stop proc~set_error_fatal set_error_fatal proc~dis_windows->proc~set_error_fatal proc~set_error_input set_error_input proc~dis_windows->proc~set_error_input 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_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error

Called by

proc~~dis_windows~~CalledByGraph proc~dis_windows dis_windows proc~dis_main dis_main proc~dis_main->proc~dis_windows proc~w90_disentangle~2 w90_disentangle proc~w90_disentangle~2->proc~dis_main proc~w90_disentangle w90_disentangle proc~w90_disentangle->proc~w90_disentangle~2 program~wannier wannier program~wannier->proc~w90_disentangle~2

Source Code

  subroutine dis_windows(dis_spheres, dis_manifold, eigval_opt, kpt_latt, recip_lattice, indxfroz, &
                         indxnfroz, ndimfroz, iprint, num_bands, num_kpts, num_wann, &
                         timing_level, lfrozen, linner, on_root, stdout, timer, error, comm)
    !================================================!
    !
    !! This subroutine selects the states that are inside the outer
    !! window (ie, the energy window out of which we fish out the
    !! optimally-connected subspace) and those that are inside the
    !! inner window (that make up the frozen manifold, and are
    !! straightfowardly included as they are). This, in practice,
    !! amounts to slimming down the original num_wann x num_wann overlap
    !! matrices, removing rows and columns that belong to u_nks that
    !! have been excluded forever, and marking (indexing) the rows and
    !! columns that correspond to frozen states.
    !!
    !! Note - in windows eigval_opt are shifted, so the lowest ones go
    !! from nfirstwin(nkp) to nfirstwin(nkp)+ndimwin(nkp)-1, and above
    !! they are set to zero.
    !
    !================================================!

    ! OUTPUT:
    !     ndimwin(nkp)   number of bands inside outer window at nkp-th k poi
    !     ndimfroz(nkp)  number of frozen bands at nkp-th k point
    !     lfrozen(i,nkp) true if the i-th band inside outer window is frozen
    !     linner         true if there is an inner window
    !     indxfroz(i,nkp) outer-window band index for the i-th frozen state
    !                     (equals 1 if it is the bottom of outer window)
    !     indxnfroz(i,nkp) outer-window band index for the i-th non-frozen s
    !                     (equals 1 if it is the bottom of outer window)
    !     nfirstwin(nkp) index of lowest band inside outer window at nkp-th
    ! MODIFIED:
    !     eigval_opt(nb,nkp) At input it contains a large set of eigenvalues. At
    !                    it is slimmed down to contain only those inside the
    !                    energy window, stored in nb=1,...,ndimwin(nkp)
    use w90_constants, only: dp
    use w90_error
    use w90_io, only: io_stopwatch_start, io_stopwatch_stop
    use w90_types, only: dis_manifold_type, kmesh_info_type, print_output_type, timer_list_type
    use w90_wannier90_types, only: dis_spheres_type

    implicit none

    ! arguments
    type(dis_spheres_type), intent(in) :: dis_spheres
    type(dis_manifold_type), intent(inout) :: dis_manifold ! ndimwin alone is modified
    type(timer_list_type), intent(inout) :: timer
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    integer, intent(in) :: iprint, timing_level
    integer, intent(in) :: stdout
    integer, intent(in) :: num_bands, num_kpts, num_wann
    integer, intent(inout) :: ndimfroz(:)
    integer, intent(inout) :: indxfroz(:, :)
    integer, intent(inout) :: indxnfroz(:, :)

    real(kind=dp), intent(in) :: kpt_latt(3, num_kpts), recip_lattice(3, 3)
    real(kind=dp), intent(inout) :: eigval_opt(:, :)

    logical, intent(in) :: on_root
    logical, intent(inout) :: linner
    logical, intent(inout) :: lfrozen(:, :)

    ! local variables
    integer :: i, j, nkp
    integer :: imin, imax, kifroz_min, kifroz_max
    real(kind=dp) :: dk(3)
    logical :: dis_ok

    if (timing_level > 1) call io_stopwatch_start('dis: windows', timer)

    linner = .false.

    if (iprint > 0) write (stdout, '(1x,a)') &
      '+----------------------------------------------------------------------------+'
    if (iprint > 0) write (stdout, '(1x,a)') &
      '|                              Energy  Windows                               |'
    if (iprint > 0) write (stdout, '(1x,a)') &
      '|                              ---------------                               |'
    if (iprint > 0) write (stdout, '(1x,a,f10.5,a,f10.5,a)') &
      '|                   Outer: ', dis_manifold%win_min, '  to ', dis_manifold%win_max, &
      '  (eV)                   |'
    if (dis_manifold%frozen_states) then
      if (iprint > 0) write (stdout, '(1x,a,f10.5,a,f10.5,a)') &
        '|                   Inner: ', dis_manifold%froz_min, '  to ', dis_manifold%froz_max, &
        '  (eV)                   |'
    else
      if (iprint > 0) write (stdout, '(1x,a)') &
        '|                   No frozen states were specified                          |'
    end if
    if (iprint > 0) write (stdout, '(1x,a)') &
      '+----------------------------------------------------------------------------+'

    do nkp = 1, num_kpts
      ! Check which eigenvalues fall within the outer window
      if ((eigval_opt(1, nkp) .gt. dis_manifold%win_max) .or. &
          (eigval_opt(num_bands, nkp) .lt. dis_manifold%win_min)) then
        if (on_root) then
          write (stdout, *) ' ERROR AT K-POINT: ', nkp
          write (stdout, *) ' ENERGY WINDOW (eV):    [', dis_manifold%win_min, ',', &
            dis_manifold%win_max, ']'
          write (stdout, *) ' EIGENVALUE RANGE (eV): [', &
            eigval_opt(1, nkp), ',', eigval_opt(num_bands, nkp), ']'
          call set_error_fatal(error, 'dis_windows: The outer energy window contains no eigenvalues', comm)
          return
        end if
      end if

      dis_manifold%ndimwin(nkp) = num_bands
      dis_manifold%nfirstwin(nkp) = 1

      ! Note: we assume that eigvals are ordered from the bottom up
      imin = 0
      imax = 0
      do i = 1, num_bands
        if (imin .eq. 0) then
          if ((eigval_opt(i, nkp) .ge. dis_manifold%win_min) .and. &
              (eigval_opt(i, nkp) .le. dis_manifold%win_max)) imin = i
          imax = i
        end if
        if (eigval_opt(i, nkp) .le. dis_manifold%win_max) imax = i
      end do

      dis_manifold%ndimwin(nkp) = imax - imin + 1
      dis_manifold%nfirstwin(nkp) = imin

      !~~ GS-start
      ! disentangle at the current k-point only if it is within one of the
      ! spheres centered at the k-points listed in kpt_dis
      if (dis_spheres%num .gt. 0) then
        dis_ok = .false.
        ! loop on the sphere centers
        do i = 1, dis_spheres%num
          dk = kpt_latt(:, nkp) - dis_spheres%spheres(1:3, i)
          dk = matmul(anint(dk) - dk, recip_lattice(:, :))
          ! if the current k-point is included in at least one sphere,
          ! then perform disentanglement as usual
          if (abs(dot_product(dk, dk)) .lt. dis_spheres%spheres(4, i)**2) then
            dis_ok = .true.
            exit
          end if
        end do
        ! this kpoint is not included in any sphere: no disentaglement
        if (.not. dis_ok) then
          dis_manifold%ndimwin(nkp) = num_wann
          dis_manifold%nfirstwin(nkp) = dis_spheres%first_wann
        end if
      end if
      !~~ GS-end

      if (dis_manifold%ndimwin(nkp) .lt. num_wann) then
        if (iprint > 0) write (stdout, '(1x, a17, i4, a8, i3, a9, i3)') 'Error at k-point ', nkp, &
          ' ndimwin=', dis_manifold%ndimwin(nkp), ' num_wann=', num_wann
        call set_error_fatal(error, 'dis_windows: Energy window contains fewer states than number of target WFs', comm)
        return
      end if

      do i = 1, dis_manifold%ndimwin(nkp)
        lfrozen(i, nkp) = .false.
      end do

      ! Check which eigenvalues fall within the inner window
      kifroz_min = 0
      kifroz_max = -1

      ! (note that the above obeys kifroz_max-kifroz_min+1=kdimfroz=0, as we w
      if (dis_manifold%frozen_states) then
        do i = imin, imax
          if (kifroz_min .eq. 0) then
            if ((eigval_opt(i, nkp) .ge. dis_manifold%froz_min) .and. &
                (eigval_opt(i, nkp) .le. dis_manifold%froz_max)) then
              ! Relative to bottom of outer window
              kifroz_min = i - imin + 1
              kifroz_max = i - imin + 1
            end if
          elseif (eigval_opt(i, nkp) .le. dis_manifold%froz_max) then
            kifroz_max = kifroz_max + 1
            ! DEBUG
            ! if(kifroz_max.ne.i-imin+1) stop 'something wrong...'
            ! ENDDEBUG
          end if
        end do
      end if

      ndimfroz(nkp) = kifroz_max - kifroz_min + 1

      if (ndimfroz(nkp) .gt. num_wann) then
        if (on_root) write (stdout, 401) nkp, ndimfroz(nkp), num_wann
401     format(' ERROR AT K-POINT ', i4, ' THERE ARE ', i2, &
               ' BANDS INSIDE THE INNER WINDOW AND ONLY', i2, &
               ' TARGET BANDS')
        if (on_root) write (stdout, 402) (eigval_opt(i, nkp), i=imin, imax)
402     format('BANDS: (eV)', 10(F10.5, 1X))
        call set_error_fatal(error, 'dis_windows: More states in the frozen window than target WFs', comm)
        return
      end if

      if (ndimfroz(nkp) .gt. 0) linner = .true.
      ! DEBUG
      !         write(*,'(a,i4,a,i2,a,i2)') 'k point ',nkp,
      !     &    ' lowest band in outer win is # ',imin,
      !     &    '   # frozen states is ',ndimfroz(nkp)
      ! ENDDEBUG
      ! Generate index array for frozen states (those inside inner window)
      if (ndimfroz(nkp) .gt. 0) then
        do i = 1, ndimfroz(nkp)
          indxfroz(i, nkp) = kifroz_min + i - 1
          lfrozen(indxfroz(i, nkp), nkp) = .true.
        end do
        if (indxfroz(ndimfroz(nkp), nkp) .ne. kifroz_max) then
          if (on_root) then
            write (stdout, *) ' Error at k-point ', nkp, ' frozen band #', i
            write (stdout, *) ' ndimfroz=', ndimfroz(nkp)
            write (stdout, *) ' kifroz_min=', kifroz_min
            write (stdout, *) ' kifroz_max=', kifroz_max
            write (stdout, *) ' indxfroz(i,nkp)=', indxfroz(i, nkp)
          end if
          call set_error_fatal(error, 'dis_windows: Something fishy... disentangle.F90+1065', comm)
          return
        end if
      end if

      ! Generate index array for non-frozen states
      i = 0
      do j = 1, dis_manifold%ndimwin(nkp)
        if (.not. lfrozen(j, nkp)) then
          i = i + 1
          indxnfroz(i, nkp) = j
        end if
      end do

      if (i .ne. dis_manifold%ndimwin(nkp) - ndimfroz(nkp)) then
        if (on_root) write (stdout, *) ' Error at k-point: ', nkp
        if (on_root) write (stdout, '(3(a,i5))') ' i: ', i, ' ndimwin: ', &
          dis_manifold%ndimwin(nkp), ' ndimfroz: ', ndimfroz(nkp)
        call set_error_input(error, 'dis_windows: i .ne. (ndimwin-ndimfroz) at k-point', comm)
        return
      end if

      ! Slim down eigval vector at present k
      do i = 1, dis_manifold%ndimwin(nkp)
        j = dis_manifold%nfirstwin(nkp) + i - 1
        eigval_opt(i, nkp) = eigval_opt(j, nkp)
      end do

      do i = dis_manifold%ndimwin(nkp) + 1, num_bands
        eigval_opt(i, nkp) = 0.0_dp
      end do

    end do
    ! [k-point loop (nkp)]

![ysl-b]
!~    if (gamma_only) then
!~       if (.not. allocated(ph_g)) then
!~          allocate(  ph_g(num_bands),stat=ierr )
!~          if (ierr/=0) call io_error('Error in allocating ph_g in dis_windows')
!~          ph_g = cmplx_1
!~       endif
!~       ! Apply same operation to ph_g
!~       do i = 1, ndimwin(1)
!~          j = nfirstwin(1) + i - 1
!~          ph_g(i) = ph_g(j)
!~       enddo
!~       do i = ndimwin(1) + 1, num_bands
!~          ph_g(i) = cmplx_0
!~       enddo
!~    endif
!~![ysl-e]

    if (iprint > 1) then ! iprint > 0 implies rank > 0
      write (stdout, '(1x,a)') &
        '|                        K-points with Frozen States                         |'
      write (stdout, '(1x,a)') &
        '|                        ---------------------------                         |'
      i = 0
      do nkp = 1, num_kpts
        if (ndimfroz(nkp) .gt. 0) then
          i = i + 1
          if (i .eq. 1) then
            write (stdout, '(1x,a,i6)', advance='no') '|', nkp
          else if ((i .gt. 1) .and. (i .lt. 12)) then
            write (stdout, '(i6)', advance='no') nkp
          else if (i .eq. 12) then
            write (stdout, '(i6,a)') nkp, '    |'
            i = 0
          end if
        end if
      end do
      if (i .ne. 0) then
        do j = 1, 12 - i
          write (stdout, '(6x)', advance='no')
        end do
        write (stdout, '(a)') '    |'
      end if
      write (stdout, '(1x,a)') &
        '+----------------------------------------------------------------------------+'
    end if

    if (iprint > 0) write (stdout, '(3x,a,i4)') 'Number of target bands to extract: ', num_wann
    if (iprint > 1) then
      write (stdout, '(4(1x,a,/),(1x,a))') &
        '+----------------------------------------------------------------------------+', &
        '|                                  Windows                                   |', &
        '|                                  -------                                   |', &
        '|               K-point      Ndimwin     Ndimfroz    Nfirstwin               |', &
        '|               ----------------------------------------------               |'

      do nkp = 1, num_kpts
        write (stdout, 403) nkp, dis_manifold%ndimwin(nkp), ndimfroz(nkp), dis_manifold%nfirstwin(nkp)
      end do
403   format(1x, '|', 14x, i6, 7x, i6, 7x, i6, 6x, i6, 18x, '|')
      write (stdout, '(1x,a)') &
        '+----------------------------------------------------------------------------+'
    end if

    if (timing_level > 1) call io_stopwatch_stop('dis: windows', timer)

    return
    !================================================!
  end subroutine dis_windows