InitFCIMC_HF Subroutine

public subroutine InitFCIMC_HF()

Arguments

None

Contents

Source Code


Source Code

    subroutine InitFCIMC_HF()

        integer :: run, DetHash
        real(dp), dimension(lenof_sign) :: InitialSign
        HElement_t(dp) :: h_temp

        if (tOrthogonaliseReplicas) then
            call InitFCIMC_HF_orthog()
            return
        end if

        InitialPartVec = 0.0_dp
        do run = 1, inum_runs
            InitialPartVec(min_part_type(run)) = InitialPart
#ifdef CMPLX_
            InitialPartVec(max_part_type(run)) = 0.0_dp
#endif
        end do

        !Setup initial walker local variables for HF walkers start
        IF (iProcIndex == iRefProc(1)) THEN

            ! Encode the reference determinant identification.
            call encode_det(CurrentDets(:, 1), iLutHF)

            !Point at the correct position for the first walker
            DetHash = FindWalkerHash(HFDet, nWalkerHashes)    !Find det hash position
            HashIndex(DetHash)%Ind = 1

            ! Clear the flags
            call clear_all_flags(CurrentDets(:, 1))

            ! Set reference determinant as an initiator if
            ! tTruncInitiator is set, for both imaginary and real flags
            ! in real-time calculations, the reference does not have any special role
            if (tTruncInitiator) then
                do run = 1, inum_runs
                    call set_flag(CurrentDets(:, 1), get_initiator_flag_by_run(run))
                end do
            end if

            ! If running a semi-stochastic simulation, set flag to specify the Hartree-Fock is in the
            ! deterministic space.
            if (tSemiStochastic) then
                do run = 1, inum_runs
                    call set_flag(CurrentDets(:, 1), flag_deterministic(run))
                end do
            end if

            ! if no reference energy is used, explicitly get the HF energy
            if (tZeroRef) then
                h_temp = get_diagonal_matel(HFDet, ilutHF)
            else
                ! HF energy is equal to 0 (when used as reference energy)
                h_temp = h_cast(0.0_dp)
            end if
            call set_det_diagH(1, real(h_temp, dp))
            call set_det_offdiagH(1, h_cast(0.0_dp))
            HFInd = 1

            call store_decoding(1, HFDet)

            if (associated(lookup_supergroup_indexer)) then
                call set_supergroup_idx(1, lookup_supergroup_indexer%idx_nI(HFDet))
            end if

            if (tContTimeFCIMC .and. tContTimeFull) &
                call set_spawn_rate(1, spawn_rate_full(HFDet, ilutHF))

            ! Obtain the initial sign
            InitialSign = 0.0_dp
            if (tStartSinglePart) then
                InitialSign(:) = InitialPartVec(:)
                TotParts(:) = InitialPartVec(:)
                TotPartsOld(:) = InitialPartVec(:)
            else
                do run = 1, inum_runs
                    InitialSign(min_part_type(run)) = InitWalkers
                    TotParts(min_part_type(run)) = real(InitWalkers, dp)
                    TotPartsOld(min_part_type(run)) = real(InitWalkers, dp)
#ifdef CMPLX_
                    TotParts(max_part_type(run)) = 0.0_dp
                    TotPartsOld(max_part_type(run)) = 0.0_dp
#endif
                end do
            end if

            ! set initial values for global control variables.

            TotWalkers = 1
            TotWalkersOld = 1
            NoatHF(:) = InitialSign(:)
            call encode_sign(CurrentDets(:, 1), InitialSign)
        ELSE
            NoatHF(:) = 0.0_dp
            TotWalkers = 0
            TotWalkersOld = 0
        end if

        OldAllNoatHF(:) = 0.0_dp
        AllNoatHF(:) = 0.0_dp
        IF (TStartSinglePart) THEN
            !Initialise global variables for calculation on the root node
            IF (iProcIndex == root) THEN
                OldAllNoatHF = InitialPartVec
                do run = 1, inum_runs
                    OldAllAvWalkersCyc(run) = sum(InitialPartVec( &
                                                  min_part_type(run):max_part_type(run)))
                end do
                AllNoatHF = InitialPartVec
                InstNoatHF = InitialPartVec
                AllTotParts = InitialPartVec
                AllTotPartsOld = InitialPartVec
                AllNoAbortedOld(:) = 0.0_dp
                iter_data_fciqmc%tot_parts_old = InitialPartVec
                AllTotWalkers = 1
                AllTotWalkersOld = 1
                do run = 1, inum_runs
                    OldAllHFCyc(run) = ARR_RE_OR_CPLX(InitialPartVec, run)
                end do
            end if
        ELSE
            !In this, only one processor has initial particles.
            IF (iProcIndex == Root) THEN
                AllTotWalkers = 1
                AllTotWalkersOld = 1
                do run = 1, inum_runs
                    iter_data_fciqmc%tot_parts_old(run) = real(InitWalkers, dp)
                    AllTotParts(run) = InitWalkers
                    AllTotPartsOld(run) = InitWalkers
                    AllNoAbortedOld(run) = 0.0_dp
                end do
            end if
        end if

    end subroutine InitFCIMC_HF