subroutine create_trial_hashtables(nexcit)
use FciMCData, only: trial_space, trial_space_size, con_space, con_space_size
use FciMCData, only: con_space_vecs, TrialTag, ConTag, TrialWFTag, ConVecTag
use FciMCData, only: trial_wfs
use hash, only: FindWalkerHash
use MemoryManager, only: LogMemDealloc
integer, intent(in) :: nexcit
integer :: i, nclash, hash_val, mode, ierr
integer :: nI(nel)
#ifdef CMPLX_
integer(n_int) :: temp(2 * nexcit)
#else
integer(n_int) :: temp(nexcit)
#endif
character(len=*), parameter :: t_r = "create_trial_hashtables"
! Create the trial space hash table.
allocate(trial_ht(trial_space_size), stat=ierr)
if (ierr /= 0) call stop_all(t_r, "Error allocating trial_ht.")
do i = 1, trial_space_size
trial_ht(i)%nclash = 0
end do
! When mode = 1, count the number of clashes.
! Alllocate arrays at the end of the mode = 1 loop.
! When mode = 2, fill in arrays.
do mode = 1, 2
do i = 1, trial_space_size
call decode_bit_det(nI, trial_space(:, i))
hash_val = FindWalkerHash(nI, trial_space_size)
if (mode == 1) then
trial_ht(hash_val)%nclash = trial_ht(hash_val)%nclash + 1
else
nclash = trial_ht(hash_val)%nclash + 1
trial_ht(hash_val)%nclash = nclash
trial_ht(hash_val)%states(0:nifd, nclash) = trial_space(0:nifd, i)
trial_ht(hash_val)%states(IlutBits%ind_pop:, nclash) = &
transfer(trial_wfs(:, i), temp)
end if
end do
if (mode == 1) then
do i = 1, size(trial_ht)
nclash = trial_ht(i)%nclash
allocate(trial_ht(i)%states(0:NConEntry, nclash))
! Set this back to zero to use it as a counter next time
! around (when mode == 2).
trial_ht(i)%nclash = 0
end do
end if
end do
! No longer need these arrays in this form.
if (allocated(trial_space)) then
deallocate(trial_space, stat=ierr)
call LogMemDealloc(t_r, TrialTag, ierr)
end if
if (allocated(trial_wfs)) then
deallocate(trial_wfs, stat=ierr)
end if
! Create the connected space hash table.
allocate(con_ht(con_space_size), stat=ierr)
if (ierr /= 0) then
write(stdout, '("ierr:")') ierr
call neci_flush(stdout)
call stop_all("t_r", "Error in allocating con_ht array.")
end if
do i = 1, con_space_size
con_ht(i)%nclash = 0
end do
do mode = 1, 2
do i = 1, con_space_size
call decode_bit_det(nI, con_space(:, i))
hash_val = FindWalkerHash(nI, con_space_size)
if (mode == 1) then
con_ht(hash_val)%nclash = con_ht(hash_val)%nclash + 1
else
nclash = con_ht(hash_val)%nclash + 1
con_ht(hash_val)%nclash = nclash
con_ht(hash_val)%states(0:nifd, nclash) = con_space(0:nifd, i)
con_ht(hash_val)%states(IlutBits%ind_pop:, nclash) &
= transfer(con_space_vecs(:, i), temp)
end if
end do
if (mode == 1) then
do i = 1, size(con_ht)
nclash = con_ht(i)%nclash
allocate(con_ht(i)%states(0:NConEntry, nclash))
! Set this back to zero to use it as a counter next time
! around (when mode == 2).
con_ht(i)%nclash = 0
end do
end if
end do
! No longer need these arrays in this form.
if (allocated(con_space)) then
deallocate(con_space, stat=ierr)
call LogMemDealloc(t_r, ConTag, ierr)
end if
if (allocated(con_space_vecs)) then
deallocate(con_space_vecs, stat=ierr)
call LogMemDealloc(t_r, ConVecTag, ierr)
end if
end subroutine create_trial_hashtables