subroutine read_2rdm_popsfile(rdm, spawn)
! Read 2-RDMs into the rdm object, from an RDM_POPSFILE file.
! The spawn object is used to perform parallel communication of
! elements to their correct process. Already is done by the root
! process. The spawn object is cleared at the end of this routine.
use hash, only: clear_hash_table, FindWalkerHash, add_hash_table_entry
use Parallel_neci, only: iProcIndex, nProcessors
use rdm_data, only: rdm_list_t, rdm_spawn_t
use rdm_data_utils, only: calc_separate_rdm_labels, extract_sign_rdm, add_to_rdm_spawn_t
use rdm_data_utils, only: communicate_rdm_spawn_t_wrapper, annihilate_rdm_list
use util_mod, only: get_free_unit
type(rdm_list_t), intent(inout) :: rdm
type(rdm_spawn_t), intent(inout) :: spawn
integer(int_rdm) :: ijkl, rdm_entry(0:rdm%sign_length)
integer :: ij, kl, i, j, k, l, ij_proc_row, sign_length_old
integer :: ielem, pops_unit, file_end, hash_val
real(dp) :: rdm_sign(rdm%sign_length)
logical :: file_exists, nearly_full, finished, all_finished
character(len=*), parameter :: t_r = 'read_2rdm_popsfile'
write(stdout, '(1X,"Reading in the 2-RDMs...")')
! If we're about to fill up the spawn list, perform a communication.
nearly_full = .false.
! Have we finished adding RDM elements to the spawned list?
finished = .false.
inquire (file='RDM_POPSFILE', exist=file_exists)
if (.not. file_exists) then
call stop_all(t_r, "Attempting to read in the 2-RDM from RDM_POPSFILE, but this file does not exist.")
end if
! Only let the root processor do the reading in.
if (iProcIndex == 0) then
pops_unit = get_free_unit()
open(pops_unit, file='RDM_POPSFILE', status='old', form='unformatted')
! Read in the first line, which holds sign_length for the
! printed RDM - check it is consistent.
read(pops_unit, iostat=file_end) sign_length_old
if (sign_length_old /= rdm%sign_length) then
call stop_all(t_r, "Error reading RDM_POPSFILE - the number of RDMs printed in the &
&popsfile is different to the number to be sampled.")
else if (file_end > 0) then
call stop_all(t_r, "Error reading the first line of RDM_POPSFILE.")
end if
do
read(pops_unit, iostat=file_end) rdm_entry
if (file_end > 0) call stop_all(t_r, "Error reading RDM_POPSFILE.")
! file_end < 0 => end of file reached.
if (file_end < 0) exit
! If the spawned list is nearly full, perform a communication.
if (nearly_full) then
call communicate_rdm_spawn_t_wrapper(spawn, rdm, finished, all_finished)
nearly_full = .false.
end if
call calc_separate_rdm_labels(rdm_entry(0), ij, kl, i, j, k, l)
call extract_sign_rdm(rdm_entry, rdm_sign)
call add_to_rdm_spawn_t(spawn, i, j, k, l, rdm_sign, .false., nearly_full)
end do
close(pops_unit)
end if
finished = .true.
! Keep performing communications until all RDM spawnings on every
! processor have been communicated.
do
call communicate_rdm_spawn_t_wrapper(spawn, rdm, finished, all_finished)
if (all_finished) exit
end do
call annihilate_rdm_list(rdm)
! Fill in the hash table to the RDM. Clear it first, just in case.
call clear_hash_table(rdm%hash_table)
do ielem = 1, rdm%nelements
call calc_separate_rdm_labels(rdm%elements(0, ielem), ij, kl, i, j, k, l)
hash_val = FindWalkerHash((/i, j, k, l/), size(rdm%hash_table))
call add_hash_table_entry(rdm%hash_table, ielem, hash_val)
end do
! Clear the spawn object.
spawn%free_slots = spawn%init_free_slots(0:nProcessors - 1)
call clear_hash_table(spawn%rdm_send%hash_table)
end subroutine read_2rdm_popsfile