Note
current_trial_amps contains both the trial wave function $\Psi_T$
itself, as well as the vector $H^\dagger\Psi_T$. Presumably this was
to make the code more compact and/or memory saving at some point,
though no longer necessary (however, refactoring would require work)
subroutine init_current_trial_amps() !! @note !! `current_trial_amps` contains both the trial wave function $\Psi_T$ !! itself, as well as the vector $H^\dagger\Psi_T$. Presumably this was !! to make the code more compact and/or memory saving at some point, !! though no longer necessary (however, refactoring would require work) !! @endnote use FciMCData, only: ll_node, trial_space, trial_space_size, con_space, con_space_size use FciMCData, only: con_space_vecs, current_trial_amps, HashIndex, trial_wfs, nWalkerHashes use FciMCData, only: CurrentDets use hash, only: FindWalkerHash use SystemData, only: nel integer :: i, hash_val integer :: nI(nel) type(ll_node), pointer :: temp_node ! Don't do anything is this is called before the trial wave function ! initialisation. if (.not. allocated(current_trial_amps)) return current_trial_amps = 0.0_dp do i = 1, trial_space_size call decode_bit_det(nI, trial_space(:, i)) hash_val = FindWalkerHash(nI, nWalkerHashes) temp_node => HashIndex(hash_val) if (temp_node%ind /= 0) then do while (associated(temp_node)) if (all(trial_space(0:nifd, i) == CurrentDets(0:nifd, temp_node%ind))) then call set_flag(CurrentDets(:, temp_node%ind), flag_trial) current_trial_amps(:, temp_node%ind) = trial_wfs(:, i) exit end if temp_node => temp_node%next end do end if nullify (temp_node) end do do i = 1, con_space_size call decode_bit_det(nI, con_space(:, i)) hash_val = FindWalkerHash(nI, nWalkerHashes) temp_node => HashIndex(hash_val) if (temp_node%ind /= 0) then do while (associated(temp_node)) if (all(con_space(0:nifd, i) == CurrentDets(0:nifd, temp_node%ind))) then ! If not also in the trial space. If it is, then we ! don't want the connected flag to be set, or the ! connected vector amplitude to be used. if (.not. test_flag(CurrentDets(:, temp_node%ind), flag_trial)) then call set_flag(CurrentDets(:, temp_node%ind), flag_connected) current_trial_amps(:, temp_node%ind) = con_space_vecs(:, i) end if exit end if temp_node => temp_node%next end do end if nullify (temp_node) end do end subroutine init_current_trial_amps