InitFCIMC_HF_orthog Subroutine

public subroutine InitFCIMC_HF_orthog()

Arguments

None

Contents

Source Code


Source Code

    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