subroutine InitFCIMC_HF_orthog()
! This is a reimplementation of InitFCIMC_HF to work with multiple
! different reference states.
!
! In the end, we expect to be able to just substitute it back in
! for the original. It should give the same results
! TODO: Substitute back
integer :: run, site, hash_val, i
logical :: repeated
HElement_t(dp) :: hdiag
character(*), parameter :: this_routine = 'InitFCIMC_HF_orthog'
! Add some implementation guards
! Default values, unless overridder for individual procs
NoatHF = 0.0_dp
TotWalkers = 0
TotWalkersOld = 0
tRef_Not_HF = .true.
tNoBrillouin = .true.
!
! Initialise each of the runs separately.
site = 0
do run = 1, inum_runs
! If this run should have the reference on this site, then
! initialise it as appropriate.
if (iProcIndex == iRefProc(run)) then
! Check if this reference is the same as any of the previous
! ones. If it is not, then at the end of the loop (i == site+1)
repeated = .false.
do i = 1, site
if (DetBitEQ(CurrentDets(:, i), ilutRef(:, run))) then
repeated = .true.
exit
end if
end do
site = i
if (.not. repeated) then
! Add the site to the main list (unless it is already there)
call encode_det(CurrentDets(:, site), ilutRef(:, run))
hash_val = FindWalkerHash(ProjEDet(:, run), nWalkerHashes)
call add_hash_table_entry(HashIndex, site, hash_val)
! Clear all the flags and sign
call clear_all_flags(CurrentDets(:, site))
call nullify_ilut(CurrentDets(:, site))
end if
! Set reference determinant as an initiator if tTruncInitiator
if (tTruncInitiator) then
call set_flag(CurrentDets(:, site), get_initiator_flag_by_run(run))
end if
! The global reference is the HF and is primary for printed
! energies.
if (run == 1) HFInd = site
hdiag = get_diagonal_matel(ProjEDet(:, run), ilutRef(:, run))
call set_det_diagH(site, real(hdiag, dp) - Hii)
call set_det_offdiagH(site, h_cast(0_dp))
if (associated(lookup_supergroup_indexer)) then
call set_supergroup_idx(site, lookup_supergroup_indexer%idx_nI(ProjEDet(:, run)))
end if
! store the determinant
call store_decoding(site, ProjEDet(:, run))
! Obtain the initial sign
if (.not. tStartSinglePart) &
call stop_all(this_routine, "Only startsinglepart supported")
call encode_part_sign(CurrentDets(:, site), InitialPart, min_part_type(run))
! Initial control values
TotWalkers = site
TotWalkersOld = site
NoatHF(min_part_type(run)) = InitialPart
TotParts(min_part_type(run)) = real(InitialPart, dp)
TotPartsOld(min_part_type(run)) = real(InitialPart, dp)
end if
end do
! Check to ensure that the following code is valid
if (.not. tStartSinglePart) &
call stop_all(this_routine, "Only startsinglepart supported")
! Initialise global variabes for calculation on the root node
OldAllNoatHF = 0.0_dp
AllNoatHF = 0.0_dp
call MPISum(TotWalkers, AllTotWalkers)
if (iProcIndex == root) then
OldAllNoatHF(:) = InitialPart
OldAllAvWalkersCyc(:) = InitialPart
AllNoatHF(:) = InitialPart
InstNoatHF(:) = InitialPart
AllTotParts(:) = InitialPart
AllTotPartsOld(:) = InitialPart
AllNoAbortedOld(:) = InitialPart
OldAllHFCyc(:) = InitialPart
TotWalkersOld = TotWalkers
end if
end subroutine InitFCIMC_HF_orthog