enumerate_sing_doub_kpnt Subroutine

public subroutine enumerate_sing_doub_kpnt(ex_flag, only_keep_conn, nSing, nDoub, tStore, ilut_list, space_size)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: ex_flag
logical, intent(in) :: only_keep_conn
integer, intent(out) :: nSing
integer, intent(out) :: nDoub
logical, intent(in) :: tStore
integer(kind=n_int), intent(inout), optional :: ilut_list(0:,:)
integer, intent(inout), optional :: space_size

Contents


Source Code

    subroutine enumerate_sing_doub_kpnt(ex_flag, only_keep_conn, nSing, nDoub, tStore, ilut_list, space_size)

        ! In/Out: ilut_list - List of determinants generated.
        ! In/Out: space_size - Number of determinants in the generated space.
        !             If ilut_list is not empty on input and you want to keep
        !             the states already in it, then on input space_size should
        !             be equal to the number of states to be kept in ilut_list,
        !             and new states will be added in from space_size+1.
        !             Otherwise, space_size must equal 0 on input.
        !             On output space_size will equal the total number of
        !             generated plus what space_size was on input.

        integer, intent(in) :: ex_flag
        logical, intent(in) :: only_keep_conn
        integer, intent(out) :: nSing, nDoub
        logical, intent(in) :: tStore
        integer(n_int), optional, intent(inout) :: ilut_list(0:, :)
        integer, optional, intent(inout) :: space_size

        integer, allocatable :: excit_gen(:)
        integer(n_int) :: ilut(0:NIfTot)
        integer :: iExcit, iMaxExcit, ierr
        integer :: nJ(nel), nStore(6), nExcitMemLen(1)
        logical :: tTempUseBrill
        character(*), parameter :: t_r = 'enumerate_doubles_kpnt'
        HElement_t(dp) :: HEl

        nSing = 0
        nDoub = 0
        iMaxExcit = 0
        nStore(1:6) = 0

        ! Use Alex's old excitation generators. However, we have to ensure
        ! that brillouins theorem isn't on!
        if (tUseBrillouin) then
            tTempUseBrill = .true.
            tUseBrillouin = .false.
        else
            tTempUseBrill = .false.
        end if

        call gensymexcitit2par_worker(hfdet, nel, G1, nBasis, .true., nExcitMemLen, &
                            nJ, iMaxExcit, nStore, ex_flag, 1, nEl)

        allocate(excit_gen(nExcitMemLen(1)), stat=ierr)
        if (ierr /= 0) call Stop_All(t_r, "Problem allocating excitation generator")
        excit_gen = 0

        call gensymexcitit2par_worker(hfdet, nel, G1, nBasis, .true., excit_gen, nJ, &
                            iMaxExcit, nStore, ex_flag, 1, nEl)

        if (tGUGA) then
            call stop_all("generate_sing_doub_determinants", &
                          "modify get_helement for GUGA")
        end if
        do while (.true.)
            call gensymexcitit2par_worker(hfdet, nel, G1, nBasis, .false., excit_gen, &
                                nJ, iExcit, nStore, ex_flag, 1, nEl)

            if (nJ(1) == 0) exit

            if (tStore) then
                call EncodeBitDet(nJ, ilut)
                ! If using a deterministic space connected to the Hartree-Fock
                ! then check that this determinant is actually connected to it!
                if (only_keep_conn) then
                    HEl = get_helement(hfdet, nJ, ilutHF, ilut)
                    if (abs(real(HEl, dp)) < 1.e-12_dp) cycle
                end if
                call add_state_to_space(ilut, ilut_list, space_size, nJ)
            end if

            if (iExcit == 1) then
                nSing = nSing + 1
            else if (iExcit == 2) then
                nDoub = nDoub + 1
            else
                call stop_all(t_r, "Trying to generate more than doubles!")
            end if
        end do

        tUseBrillouin = tTempUseBrill

    end subroutine enumerate_sing_doub_kpnt