Distribute the um and chk files
subroutine pw90common_wanint_data_dist
!===========================================================!
! !
!! Distribute the um and chk files
! !
!===========================================================!
use w90_constants, only: dp, cmplx_0, cmplx_i, twopi
use w90_io, only: io_error, io_file_unit, &
io_date, io_time, io_stopwatch
use w90_parameters, only: num_wann, num_kpts, num_bands, have_disentangled, &
u_matrix_opt, u_matrix, m_matrix, &
ndimwin, lwindow, nntot, wannier_centres, &
num_valence_bands, scissors_shift
implicit none
integer :: ierr, loop_kpt, m, i, j
if (.not. on_root) then
! wannier_centres is allocated in param_read, so only on root node
! It is then read in param_read_chpkt
! Therefore, now we need to allocate it on all nodes, and then broadcast it
allocate (wannier_centres(3, num_wann), stat=ierr)
if (ierr /= 0) call io_error('Error allocating wannier_centres in pw90common_wanint_data_dist')
end if
call comms_bcast(wannier_centres(1, 1), 3*num_wann)
! -------------------
! 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) &
call io_error('Error allocating v_matrix in pw90common_wanint_data_dist')
! u_matrix and u_matrix_opt are stored on root only
if (on_root) then
if (.not. have_disentangled) then
v_matrix = u_matrix
else
v_matrix = cmplx_0
do loop_kpt = 1, num_kpts
do j = 1, num_wann
do m = 1, 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)
enddo
enddo
enddo
enddo
endif
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)
endif
endif
call comms_bcast(v_matrix(1, 1, 1), num_bands*num_wann*num_kpts)
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) &
call io_error('Error allocating u_matrix in pw90common_wanint_data_dist')
endif
call comms_bcast(u_matrix(1, 1, 1), num_wann*num_wann*num_kpts)
endif
! if (.not.on_root .and. .not.allocated(m_matrix)) then
! allocate(m_matrix(num_wann,num_wann,nntot,num_kpts),stat=ierr)
! if (ierr/=0)&
! call io_error('Error allocating m_matrix in pw90common_wanint_data_dist')
! endif
! call comms_bcast(m_matrix(1,1,1,1),num_wann*num_wann*nntot*num_kpts)
call comms_bcast(have_disentangled, 1)
if (have_disentangled) then
if (.not. on_root) then
! Do we really need these 'if not allocated'? Didn't use them for
! eigval and kpt_latt above!
! if (.not.allocated(u_matrix_opt)) then
! allocate(u_matrix_opt(num_bands,num_wann,num_kpts),stat=ierr)
! if (ierr/=0)&
! call io_error('Error allocating u_matrix_opt in pw90common_wanint_data_dist')
! endif
if (.not. allocated(lwindow)) then
allocate (lwindow(num_bands, num_kpts), stat=ierr)
if (ierr /= 0) &
call io_error('Error allocating lwindow in pw90common_wanint_data_dist')
endif
if (.not. allocated(ndimwin)) then
allocate (ndimwin(num_kpts), stat=ierr)
if (ierr /= 0) &
call io_error('Error allocating ndimwin in pw90common_wanint_data_dist')
endif
end if
! call comms_bcast(u_matrix_opt(1,1,1),num_bands*num_wann*num_kpts)
call comms_bcast(lwindow(1, 1), num_bands*num_kpts)
call comms_bcast(ndimwin(1), num_kpts)
end if
end subroutine pw90common_wanint_data_dist