internal_slim_m Subroutine

public subroutine internal_slim_m(m_matrix_orig_local, ndimwin, nfirstwin, nnlist, nntot, num_bands, timing_level, timer, dist_k, global_k, error, comm)

Uses

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

This subroutine slims down the original Mmn(k,b), removing rows and columns corresponding to u_nks that fall outside the outer energy window.

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout) :: m_matrix_orig_local(:,:,:,:)
integer, intent(in) :: ndimwin(:)
integer, intent(in) :: nfirstwin(:)
integer, intent(in) :: nnlist(:,:)
integer, intent(in) :: nntot
integer, intent(in) :: num_bands
integer, intent(in) :: timing_level
type(timer_list_type), intent(inout) :: timer
integer, intent(in) :: dist_k(:)
integer, intent(in) :: global_k(:)
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~internal_slim_m~~CallsGraph proc~internal_slim_m internal_slim_m proc~io_stopwatch_start io_stopwatch_start proc~internal_slim_m->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~internal_slim_m->proc~io_stopwatch_stop proc~mpirank mpirank proc~internal_slim_m->proc~mpirank proc~set_error_alloc set_error_alloc proc~internal_slim_m->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~internal_slim_m->proc~set_error_dealloc 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_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error

Called by

proc~~internal_slim_m~~CalledByGraph proc~internal_slim_m internal_slim_m proc~dis_main dis_main proc~dis_main->proc~internal_slim_m 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 internal_slim_m(m_matrix_orig_local, ndimwin, nfirstwin, nnlist, nntot, num_bands, &
                             timing_level, timer, dist_k, global_k, error, comm)
    !================================================!
    !
    !! This subroutine slims down the original Mmn(k,b), removing
    !! rows and columns corresponding to u_nks that fall outside
    !! the outer energy window.
    !
    !================================================!
    use w90_comms, only: w90_comm_type, mpirank
    use w90_constants, only: dp, cmplx_0
    use w90_error
    use w90_io, only: io_stopwatch_start, io_stopwatch_stop
    use w90_types, only: timer_list_type

    implicit none

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

    integer, intent(in) :: dist_k(:), global_k(:)
    integer, intent(in) :: ndimwin(:)
    integer, intent(in) :: nfirstwin(:) ! (num_kpts) index of lowest band inside outer window at nkp-th
    integer, intent(in) :: nntot, nnlist(:, :) ! (num_kpts, nntot)
    integer, intent(in) :: num_bands
    integer, intent(in) :: timing_level

    complex(kind=dp), intent(inout) :: m_matrix_orig_local(:, :, :, :)

    ! local variables
    integer :: nkp, nkp2, nn, i, j, m, n, ierr, nkp_global, nkrank, my_node_id

    complex(kind=dp), allocatable :: cmtmp(:, :)

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

    my_node_id = mpirank(comm)
    nkrank = count(dist_k == my_node_id) ! number of k points this rank

    allocate (cmtmp(num_bands, num_bands), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating cmtmp in dis_main: slim_m', comm)
      return
    end if
    do nkp = 1, nkrank
      nkp_global = global_k(nkp)
      do nn = 1, nntot
        nkp2 = nnlist(nkp_global, nn)
        do j = 1, ndimwin(nkp2)
          n = nfirstwin(nkp2) + j - 1
          do i = 1, ndimwin(nkp_global)
            m = nfirstwin(nkp_global) + i - 1
            cmtmp(i, j) = m_matrix_orig_local(m, n, nn, nkp)
          end do
        end do
        m_matrix_orig_local(:, :, nn, nkp) = cmplx_0
        do j = 1, ndimwin(nkp2)
          do i = 1, ndimwin(nkp_global)
            m_matrix_orig_local(i, j, nn, nkp) = cmtmp(i, j)
          end do
        end do
      end do
    end do

    deallocate (cmtmp, stat=ierr)
    if (ierr /= 0) then
      call set_error_dealloc(error, 'Error deallocating cmtmp in dis_main: slim_m', comm)
      return
    end if

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

    return
    !================================================!
  end subroutine internal_slim_m