An API interfacing function for generate_excitation to the rest of NECI:
Requires guga_bitRepOps::current_csf_i to be set according to the ilutI.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | nI(nEl) | |||
integer(kind=n_int), | intent(in) | :: | ilutI(0:niftot) | |||
integer, | intent(out) | :: | nJ(nEl) | |||
integer(kind=n_int), | intent(out) | :: | ilutJ(0:niftot) | |||
integer, | intent(in) | :: | exFlag | |||
integer, | intent(out) | :: | IC | |||
integer, | intent(out) | :: | excitMat(2,maxExcit) | |||
logical, | intent(out) | :: | tParity | |||
real(kind=dp), | intent(out) | :: | pgen | |||
real(kind=dp), | intent(out) | :: | HElGen | |||
type(excit_gen_store_type), | intent(inout), | target | :: | store | ||
integer, | intent(in), | optional | :: | part_type |
subroutine generate_excitation_guga(nI, ilutI, nJ, ilutJ, exFlag, IC, &
excitMat, tParity, pgen, HElGen, store, part_type)
!! An API interfacing function for generate_excitation to the rest of NECI:
!!
!! Requires guga_bitRepOps::current_csf_i to be set according to the ilutI.
integer, intent(in) :: nI(nEl), exFlag
integer(n_int), intent(in) :: ilutI(0:niftot)
integer, intent(out) :: nJ(nEl), IC, excitMat(2, maxExcit)
integer(n_int), intent(out) :: ilutJ(0:niftot)
logical, intent(out) :: tParity
real(dp), intent(out) :: pgen
HElement_t(dp), intent(out) :: HElGen
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type
character(*), parameter :: this_routine = "generate_excitation_guga"
integer(n_int) :: ilut(0:nifguga), new_ilut(0:nifguga)
integer :: excit_typ(2)
type(ExcitationInformation_t) :: excitInfo
real(dp) :: diff
HElement_t(dp) :: tmp_mat1
HElement_t(dp) :: tmp_mat
unused_var(exFlag); unused_var(part_type); unused_var(store)
ASSERT(is_compatible(ilutI, current_csf_i))
! think about default values and unneeded variables for GUGA, but
! which have to be processed anyway to interface to NECI
! excitatioin matrix... i could set that up for GUGA too..
! but its not needed specifically except for RDM and logging purposes
! in new implementation with changing relative probabilites of different
! types of excitation, misuse this array to log the type of excitation
excitMat = 0
! the parity flag is also unneccesary in GUGA
tParity = .true.
! the inputted exFlag variable, is also not needed probably..
! then choose between single or double excitations..
! TODO: still have to think how to set up pSingles and pDoubles in
! GUGA...
! and before i have to convert to GUGA iluts..
call convert_ilut_toGUGA(ilutI, ilut)
ASSERT(isProperCSF_ilut(ilut, .true.))
! maybe i need to copy the flags of ilutI onto ilutJ
ilutJ = ilutI
if (genrand_real2_dSFMT() < pSingles) then
IC = 1
call createStochasticExcitation_single(ilut, nI, current_csf_i, new_ilut, pgen)
pgen = pgen * pSingles
else
IC = 2
call createStochasticExcitation_double(ilut, nI, current_csf_i, new_ilut, pgen, excit_typ)
pgen = pgen * pDoubles
end if
! for now add a sanity check to compare the stochastic obtained
! matrix elements with the exact calculation..
! since something is going obviously wrong..
#ifdef DEBUG_
call additional_checks()
#endif
! check if excitation generation was successful
if (near_zero(pgen)) then
! indicate NullDet to skip spawn step
nJ(1) = 0
HElGen = h_cast(0.0_dp)
else
! also store information on type of excitation for the automated
! tau-search for the non-weighted guga excitation generator in
! the excitMat variable
excitMat(1, 1:2) = excit_typ
! profile tells me this costs alot of time.. so remove it
! and only do it in debug mode..
! i just have to be sure that no wrong csfs are created..
ASSERT(isProperCSF_ilut(new_ilut, .true.))
! otherwise extract H element and convert to 0
call convert_ilut_toNECI(new_ilut, ilutJ, HElgen)
if (t_matele_cutoff .and. abs(HElGen) < matele_cutoff) then
HElgen = h_cast(0.0_dp)
nJ(1) = 0
pgen = 0.0_dp
return
end if
call decode_bit_det(nJ, ilutJ)
if (tHub .and. .not. treal) then
if (.not. (IsMomentumAllowed(nJ))) then
call write_det_guga(stdout, new_ilut)
end if
end if
end if
if (tStoquastize) HElgen = -abs(HElgen)
contains
#ifdef DEBUG_
subroutine additional_checks()
! for now add a sanity check to compare the stochastic obtained
! matrix elements with the exact calculation..
! since something is going obviously wrong..
if (.not. near_zero(pgen)) then
call convert_ilut_toNECI(new_ilut, ilutJ, HElgen)
call calc_guga_matrix_element(ilutI, current_csf_i, ilutJ, CSF_Info_t(ilutJ), excitInfo, tmp_mat, .true.)
diff = abs(HElGen - tmp_mat)
if (diff > 1.0e-10_dp) then
print *, "WARNING: differing stochastic and exact matrix elements!"
call write_det_guga(stdout, ilutI, .true.)
call write_det_guga(stdout, ilutJ, .true.)
print *, "mat eles and diff:", HElGen, tmp_mat, diff
print *, " pgen: ", pgen
print *, " deduced excit-info: "
call print_excitInfo(excitInfo)
print *, " global excit-info: "
call print_excitInfo(global_excitInfo)
call neci_flush(stdout)
end if
! is the other order also fullfilled?
call calc_guga_matrix_element(ilutJ, CSF_Info_t(ilutJ), ilutI, current_csf_i, excitInfo, tmp_mat1, .true.)
#ifdef CMPLX_
diff = abs(tmp_mat1 - conjg(tmp_mat))
#else
diff = abs(tmp_mat1 - tmp_mat)
#endif
if (diff > 1.0e-10_dp) then
print *, "WARNING: differing sign in matrix elements!"
call write_det_guga(stdout, ilutI, .true.)
call write_det_guga(stdout, ilutJ, .true.)
print *, "mat eles and diff:", tmp_mat, tmp_mat1, diff
print *, "<I|H|J> excitInfo:"
call print_excitInfo(excitInfo)
excitInfo = identify_excitation(ilutI, ilutJ)
print *, "<J|H|I> excitInfo:"
call print_excitInfo(excitInfo)
call neci_flush(stdout)
end if
end if
end subroutine additional_checks
#endif
end subroutine generate_excitation_guga