pw90common_wanint_data_dist Subroutine

public subroutine pw90common_wanint_data_dist(num_wann, num_kpts, num_bands, u_matrix_opt, u_matrix, dis_manifold, wannier_data, scissors_shift, v_matrix, num_valence_bands, have_disentangled, error, comm)

Uses

  • proc~~pw90common_wanint_data_dist~~UsesGraph proc~pw90common_wanint_data_dist pw90common_wanint_data_dist module~w90_comms w90_comms proc~pw90common_wanint_data_dist->module~w90_comms module~w90_constants w90_constants proc~pw90common_wanint_data_dist->module~w90_constants module~w90_io w90_io proc~pw90common_wanint_data_dist->module~w90_io module~w90_types w90_types proc~pw90common_wanint_data_dist->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_io->module~w90_constants module~w90_types->module~w90_constants

Distribute the um and chk files

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: num_wann
integer, intent(in) :: num_kpts
integer, intent(in) :: num_bands
complex(kind=dp), intent(inout), allocatable :: u_matrix_opt(:,:,:)
complex(kind=dp), intent(inout), allocatable :: u_matrix(:,:,:)
type(dis_manifold_type), intent(inout) :: dis_manifold
type(wannier_data_type), intent(inout) :: wannier_data
real(kind=dp), intent(in) :: scissors_shift
complex(kind=dp), allocatable :: v_matrix(:,:,:)
integer, intent(in) :: num_valence_bands
logical, intent(inout) :: have_disentangled
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~pw90common_wanint_data_dist~~CallsGraph proc~pw90common_wanint_data_dist pw90common_wanint_data_dist interface~comms_bcast comms_bcast proc~pw90common_wanint_data_dist->interface~comms_bcast proc~mpirank mpirank proc~pw90common_wanint_data_dist->proc~mpirank proc~set_error_alloc set_error_alloc proc~pw90common_wanint_data_dist->proc~set_error_alloc proc~comms_bcast_char comms_bcast_char interface~comms_bcast->proc~comms_bcast_char proc~comms_bcast_cmplx comms_bcast_cmplx interface~comms_bcast->proc~comms_bcast_cmplx proc~comms_bcast_int comms_bcast_int interface~comms_bcast->proc~comms_bcast_int proc~comms_bcast_logical comms_bcast_logical interface~comms_bcast->proc~comms_bcast_logical proc~comms_bcast_real comms_bcast_real interface~comms_bcast->proc~comms_bcast_real 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~comms_bcast_char->proc~comms_sync_error proc~comms_no_sync_bcast_char comms_no_sync_bcast_char proc~comms_bcast_char->proc~comms_no_sync_bcast_char proc~comms_bcast_cmplx->proc~comms_sync_error proc~comms_no_sync_bcast_cmplx comms_no_sync_bcast_cmplx proc~comms_bcast_cmplx->proc~comms_no_sync_bcast_cmplx proc~comms_bcast_int->proc~comms_sync_error proc~comms_no_sync_bcast_int comms_no_sync_bcast_int proc~comms_bcast_int->proc~comms_no_sync_bcast_int proc~comms_bcast_logical->proc~comms_sync_error proc~comms_no_sync_bcast_logical comms_no_sync_bcast_logical proc~comms_bcast_logical->proc~comms_no_sync_bcast_logical proc~comms_bcast_real->proc~comms_sync_error proc~comms_no_sync_bcast_real comms_no_sync_bcast_real proc~comms_bcast_real->proc~comms_no_sync_bcast_real

Called by

proc~~pw90common_wanint_data_dist~~CalledByGraph proc~pw90common_wanint_data_dist pw90common_wanint_data_dist program~postw90 postw90 program~postw90->proc~pw90common_wanint_data_dist

Source Code

  subroutine pw90common_wanint_data_dist(num_wann, num_kpts, num_bands, u_matrix_opt, u_matrix, &
                                         dis_manifold, wannier_data, scissors_shift, v_matrix, &
                                         num_valence_bands, have_disentangled, error, comm)
    !================================================!
    !
    !! Distribute the um and chk files
    !
    !================================================!

    use w90_constants, only: dp, cmplx_0
    use w90_io, only: io_date, io_time
    use w90_types, only: dis_manifold_type, wannier_data_type
    use w90_comms, only: w90_comm_type, mpirank, comms_bcast

    implicit none

    type(dis_manifold_type), intent(inout) :: dis_manifold
    type(wannier_data_type), intent(inout) :: wannier_data
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    integer, intent(in) :: num_valence_bands
    integer, intent(in) :: num_wann, num_kpts, num_bands
    real(kind=dp), intent(in) :: scissors_shift
    complex(kind=dp), allocatable :: v_matrix(:, :, :)
    complex(kind=dp), allocatable, intent(inout) :: u_matrix_opt(:, :, :), u_matrix(:, :, :)
    logical, intent(inout) :: have_disentangled

    integer :: ierr, loop_kpt, m, i, j
    logical :: on_root = .false.

    if (mpirank(comm) == 0) on_root = .true.

!    if (.not. on_root) then
!      ! wannier_centres is allocated in w90_wannier90_readwrite_read, so only on root node
!      ! It is then read in w90_wannier90_readwrite_read_chpkt
!      ! Therefore, now we need to allocate it on all nodes, and then broadcast it
!      allocate (wannier_data%centres(3, num_wann), stat=ierr)
!      if (ierr /= 0) then
!        call set_error_alloc(error, 'Error allocating wannier_centres in pw90common_wanint_data_dist', comm)
!        return
!      endif
!    end if
!    call comms_bcast(wannier_data%centres(1, 1), 3*num_wann, error, comm)
!    if (allocated(error)) return

    ! -------------------
    ! Ivo: added 8april11
    ! -------------------
    !
    ! Calculate the matrix that describes the combined effect of
    ! disentanglement and maximal localization. This is the combination
    ! that is most often needed for interpolation purposes
    !
    ! Allocate on all nodes
    allocate (v_matrix(num_bands, num_wann, num_kpts), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating v_matrix in pw90common_wanint_data_dist', comm)
      return
    end if
    ! u_matrix and u_matrix_opt are stored on root only
    if (on_root) then
      if (.not. have_disentangled) then
        v_matrix(1:num_wann, :, :) = u_matrix(1:num_wann, :, :)
      else
        v_matrix = cmplx_0
        do loop_kpt = 1, num_kpts
          do j = 1, num_wann
            do m = 1, dis_manifold%ndimwin(loop_kpt)
              do i = 1, num_wann
                v_matrix(m, j, loop_kpt) = v_matrix(m, j, loop_kpt) &
                                           + u_matrix_opt(m, i, loop_kpt)*u_matrix(i, j, loop_kpt)
              end do
            end do
          end do
        end do
      end if
      if (allocated(u_matrix_opt)) deallocate (u_matrix_opt)
      if (.not. (num_valence_bands > 0 .and. abs(scissors_shift) > 1.0e-7_dp)) then
        if (allocated(u_matrix)) deallocate (u_matrix)
      end if
    end if
    call comms_bcast(v_matrix(1, 1, 1), num_bands*num_wann*num_kpts, error, comm)
    if (allocated(error)) return

    if (num_valence_bands > 0 .and. abs(scissors_shift) > 1.0e-7_dp) then
    if (.not. on_root .and. .not. allocated(u_matrix)) then
      allocate (u_matrix(num_wann, num_wann, num_kpts), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error allocating u_matrix in pw90common_wanint_data_dist', comm)
        return
      end if
    end if
    call comms_bcast(u_matrix(1, 1, 1), num_wann*num_wann*num_kpts, error, comm)
    end if

    call comms_bcast(have_disentangled, 1, error, comm)
    if (allocated(error)) return

    if (have_disentangled) then
      if (.not. on_root) then

        if (.not. allocated(dis_manifold%lwindow)) then
          allocate (dis_manifold%lwindow(num_bands, num_kpts), stat=ierr)
          if (ierr /= 0) then
            call set_error_alloc(error, 'Error allocating lwindow in pw90common_wanint_data_dist', comm)
            return
          end if
        end if

        if (.not. allocated(dis_manifold%ndimwin)) then
          allocate (dis_manifold%ndimwin(num_kpts), stat=ierr)
          if (ierr /= 0) then
            call set_error_alloc(error, 'Error allocating ndimwin in pw90common_wanint_data_dist', comm)
            return
          end if
        end if

      end if

!       call comms_bcast(u_matrix_opt(1,1,1),num_bands*num_wann*num_kpts)
      call comms_bcast(dis_manifold%lwindow(1, 1), num_bands*num_kpts, error, comm)
      if (allocated(error)) return
      call comms_bcast(dis_manifold%ndimwin(1), num_kpts, error, comm)
      if (allocated(error)) return
    end if

  end subroutine pw90common_wanint_data_dist