subroutine read_chkpt(common_data, checkpoint, istdout, istderr, ierr)
use w90_comms, only: mpirank
use w90_error_base, only: w90_error_type
use w90_error, only: set_error_alloc, set_error_dealloc
use w90_readwrite, only: w90_readwrite_read_chkpt, w90_readwrite_chkpt_dist
implicit none
! arguments
character(len=20), intent(out) :: checkpoint
integer, intent(in) :: istdout, istderr
integer, intent(out) :: ierr
type(lib_common_type), target, intent(inout) :: common_data
! local variables
complex(kind=dp), allocatable :: m(:, :, :, :)
integer, pointer :: nw, nb, nk, nn
integer :: rank, nexclude = 0, istat
logical :: ispostw90 = .false. ! ispostw90 is used to print a different error message in case the chk file is missing (did you run w90 first?)
type(w90_error_type), allocatable :: error
ierr = 0
rank = mpirank(common_data%comm)
nb => common_data%num_bands
nk => common_data%num_kpts
nn => common_data%kmesh_info%nntot
nw => common_data%num_wann
! allocating and partially assigning the full matrix on all ranks and reducing is a terrible idea at scale
! alternatively, allocate on root and use point-to-point
! or, if required only for checkpoint file writing, then use mpi-io (but needs to be ordered io, alas)
! or, even better, use parallel hdf5
allocate (m(nw, nw, nn, nk), stat=istat) ! all kpts
if (istat /= 0) then
call set_error_alloc(error, 'Error allocating m in read_chkpt', common_data%comm)
call prterr(error, ierr, istdout, istderr, common_data%comm)
return
end if
if (rank == 0) then
if (allocated(common_data%exclude_bands)) nexclude = size(common_data%exclude_bands)
call w90_readwrite_read_chkpt(common_data%dis_manifold, common_data%exclude_bands, &
common_data%kmesh_info, common_data%kpt_latt, &
common_data%wannier_data, m, common_data%u_matrix, &
common_data%u_matrix_opt, common_data%real_lattice, &
common_data%omega%invariant, common_data%mp_grid, nb, &
nexclude, nk, nw, checkpoint, common_data%have_disentangled, &
ispostw90, common_data%seedname, istdout, error, &
common_data%comm)
if (allocated(error)) then
call prterr(error, ierr, istdout, istderr, common_data%comm)
return
end if
end if
! scatter from m_matrix to m_matrix_local (cf overlap_read)
call w90_readwrite_chkpt_dist(common_data%dis_manifold, common_data%wannier_data, &
common_data%u_matrix, common_data%u_matrix_opt, m, &
common_data%m_matrix_local, common_data%omega%invariant, &
nb, nk, nw, nn, checkpoint, common_data%have_disentangled, &
common_data%dist_kpoints, error, common_data%comm)
if (allocated(error)) then
call prterr(error, ierr, istdout, istderr, common_data%comm)
return
end if
deallocate (m, stat=istat)
if (istat /= 0) then
call set_error_alloc(error, 'Error deallocating m in read_chkpt', common_data%comm)
call prterr(error, ierr, istdout, istderr, common_data%comm)
return
end if
end subroutine read_chkpt