subroutine print_amplitudes_kp(irepeat)
! A (*very* slow and memory intensive) test routine to print the current amplitudes (as stored
! in CurrentDets) of *all* determinants to a file. The amplitude of each replica will be printed
! one after the other. Since this is intended to be used with kp-fciqmc, irepeat is the number of
! the current repeat, but it will simply be used in naming the output file.
use DetBitOps, only: EncodeBitDet, IsAllowedHPHF
use FciMCData, only: nWalkerHashes, HashIndex, CurrentDets, HFSym
use hash, only: FindWalkerHash
use gndts_mod, only: gndts
use sym_mod, only: getsym
use SystemData, only: nel, nbasis, BRR, nBasisMax, G1, tSpn, lms, tParity, SymRestrict, BasisFn
use util_mod, only: int_fmt, get_free_unit
integer, intent(in) :: irepeat
integer, allocatable :: nI_list(:, :)
integer :: temp(1, 1), hf_ind, ndets
integer :: i, j, counter, temp_unit, DetHash
integer(n_int) :: ilut(0:NIfTot)
integer(n_int) :: int_sign(lenof_sign)
real(dp) :: real_sign(lenof_sign)
type(ll_node), pointer :: temp_node
type(BasisFn) :: iSym
character(15) :: ind, filename
! Determine the total number of determinants.
call gndts(nel, nbasis, BRR, nBasisMax, temp, .true., G1, tSpn, lms, tParity, SymRestrict, ndets, hf_ind)
allocate(nI_list(nel, ndets))
! Generate the determinants and move them to nI_list.
call gndts(nel, nbasis, BRR, nBasisMax, nI_list, .false., G1, tSpn, lms, tParity, SymRestrict, ndets, hf_ind)
write(ind, '(i15)') irepeat
filename = trim('amps.'//adjustl(ind))
temp_unit = get_free_unit()
open(temp_unit, file=trim(filename), status='replace')
counter = 0
do i = 1, ndets
call getsym(nI_list(:, i), nel, G1, nBasisMax, iSym)
! Only carry on if the symmetry of this determinant is correct.
if (iSym%Sym%S /= HFSym%Sym%S .or. iSym%Ms /= HFSym%Ms .or. iSym%Ml /= HFSym%Ml) cycle
call EncodeBitDet(nI_list(:, i), ilut)
if (.not. IsAllowedHPHF(ilut(0:nifd))) cycle
counter = counter + 1
real_sign = 0.0_dp
DetHash = FindWalkerHash(nI_list(:, i), nWalkerHashes)
temp_node => HashIndex(DetHash)
if (temp_node%ind /= 0) then
do while (associated(temp_node))
if (all(ilut(0:nifd) == CurrentDets(0:nifd, temp_node%ind))) then
int_sign = CurrentDets(IlutBits%ind_pop:IlutBits%ind_pop + lenof_sign - 1, temp_node%ind)
real_sign = transfer(int_sign, real_sign)
exit
end if
temp_node => temp_node%next
end do
end if
do j = 1, lenof_sign
write(temp_unit, '(a1,'//int_fmt(counter, 0)//',a1,'//int_fmt(j, 0)//',a1,1x,es19.12)') &
"(", counter, ",", j, ")", real_sign(j)
end do
end do
close(temp_unit)
deallocate(nI_list)
end subroutine print_amplitudes_kp