add_to_en_pert_t Subroutine

public subroutine add_to_en_pert_t(en_pert, nI, ilut, contrib_sign)

Arguments

Type IntentOptional Attributes Name
type(en_pert_t), intent(inout) :: en_pert
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilut(0:NIfTot)
real(kind=dp), intent(in) :: contrib_sign(en_pert%sign_length)

Contents

Source Code


Source Code

    subroutine add_to_en_pert_t(en_pert, nI, ilut, contrib_sign)

        ! In/Out: en_pert - the en_pert_t object to which contributions will be added.
        ! In: nI - A list of the occupied orbitals in the determinant.
        ! In: ilut - The determinant in a bitstring form.
        ! In: contrib_sign - the sign (amplitude) of the contribution to be added.

        use hash, only: hash_table_lookup, add_hash_table_entry
        use SystemData, only: nel

        type(en_pert_t), intent(inout) :: en_pert
        integer, intent(in) :: nI(nel)
        integer(n_int), intent(in) :: ilut(0:NIfTot)
        real(dp), intent(in) :: contrib_sign(en_pert%sign_length)

        integer :: ind, hash_val, slots_left
        real(dp) :: real_sign_old(en_pert%sign_length), real_sign_new(en_pert%sign_length)
        logical :: tSuccess
        character(*), parameter :: t_r = 'add_to_en_pert_t'

        ! Search to see if this determinant is already in the dets array.
        ! If it, tSuccess will be true and ind will hold the position of the
        ! entry in en_pert%dets.
        call hash_table_lookup(nI, ilut, nifd, en_pert%hash_table, en_pert%dets, ind, hash_val, tSuccess)

        if (tSuccess) then
            ! Extract the existing sign.
            call extract_sign_EN(en_pert%sign_length, en_pert%dets(:, ind), real_sign_old)
            ! Update the total sign.
            real_sign_new = real_sign_old + contrib_sign
            ! Encode the new sign.
            call encode_sign_EN(en_pert%sign_length, en_pert%dets(:, ind), real_sign_new)
        else
            en_pert%ndets = en_pert%ndets + 1

            ! Check that there is enough memory for the new determinant.
            slots_left = en_pert%max_ndets - en_pert%ndets

            if (slots_left < 0) then
                write(stdout, '("ERROR: No space left in the EN2 array. Aborting to prevent incorrect results...")')
                call neci_flush(stdout)
                call stop_all(t_r, 'No space left in the EN2 array. Please increase memoryfacspawn.')
            else if (slots_left < 20) then
                write (stdout, '("WARNING: Less than 20 slots left in EN2 array. The program will abort &
                           &when there are no slots remaining.")'); call neci_flush(stdout)
            end if

            en_pert%dets(0:nifd, en_pert%ndets) = ilut(0:nifd)
            call encode_sign_EN(en_pert%sign_length, en_pert%dets(:, en_pert%ndets), contrib_sign)

            call add_hash_table_entry(en_pert%hash_table, en_pert%ndets, hash_val)
        end if

    end subroutine add_to_en_pert_t