rm_unocc_dets_from_hash_table Subroutine

public subroutine rm_unocc_dets_from_hash_table(hash_table, walker_list, list_length)

Uses

Arguments

Type IntentOptional Attributes Name
type(ll_node), intent(inout), pointer :: hash_table(:)
integer(kind=n_int), intent(in) :: walker_list(0:,:)
integer, intent(in) :: list_length

Contents


Source Code

    subroutine rm_unocc_dets_from_hash_table(hash_table, walker_list, list_length)

        use DetBitOps, only: tAccumEmptyDet
        ! This routine loops through all determinants in walker_list removes
        ! all entries from hash_table for determinants which are both
        ! unoccupied and not core determinants.

        type(ll_node), pointer, intent(inout) :: hash_table(:)
        integer(n_int), intent(in) :: walker_list(0:, :)
        integer, intent(in) :: list_length

        integer :: i, hash_val, nI(nel)
        real(dp) :: real_sign(lenof_sign)
        logical :: found, tCoreDet
        type(ll_node), pointer :: temp_node, prev
#ifdef DEBUG_
        character(len=*), parameter :: this_routine = "rm_unocc_dets_from_hash_table"
#endif

        do i = 1, list_length
            call extract_sign(walker_list(:, i), real_sign)
            tCoreDet = .false.
            if (tSemiStochastic) tCoreDet = test_flag_multi(walker_list(:, i), flag_deterministic)
            if (IsUnoccDet(real_sign) .and. (.not. tCoreDet) .and. (.not. tAccumEmptyDet(walker_list(:, i)))) cycle
            found = .false.
            call decode_bit_det(nI, walker_list(:, i))

            ASSERT(all(nI <= nBasis))
            ASSERT(all(nI > 0))

            hash_val = FindWalkerHash(nI, size(hash_table))
            temp_node => hash_table(hash_val)
            prev => null()
            if (.not. temp_node%ind == 0) then
                ! Loop over all entries with this hash value.
                do while (associated(temp_node))
                    if (temp_node%ind == i) then
                        found = .true.
                        call remove_node(prev, temp_node)
                        exit
                    end if
                    ! Move on to the next determinant with this hash value.
                    prev => temp_node
                    temp_node => temp_node%next
                end do
            end if
            ASSERT(found)
        end do

    end subroutine rm_unocc_dets_from_hash_table