gen_exc_djs_guga Subroutine

public subroutine gen_exc_djs_guga(ilutI, csf_i)

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: ilutI(0:niftot)
type(CSF_Info_t), intent(in) :: csf_i

Contents

Source Code


Source Code

    subroutine gen_exc_djs_guga(ilutI, csf_i)
        integer(n_int), intent(in) :: ilutI(0:niftot)
        type(CSF_Info_t), intent(in) :: csf_i
        character(*), parameter :: this_routine = "gen_exc_djs_guga"

        integer :: nI(nel), flags_I, n_singles, n_doubles
        real(dp) :: sign_i(lenof_sign), full_sign(1)

        integer(n_int), allocatable :: excits(:, :)
        integer(n_int) :: ilutG(0:GugaBits%len_tot)

        call extract_bit_rep(ilutI, nI, sign_I, flags_I)

        if (RDMExcitLevel == 1) then
            call fill_diag_1rdm_guga(one_rdms, nI, sign_I)
        else
            full_sign = sign_i(1) * sign_I(lenof_sign)
            call fill_spawn_rdm_diag_guga(two_rdm_spawn, nI, full_sign)
        end if

        call convert_ilut_toGUGA(ilutI, ilutG)

        ! one-rdm is always calculated
        ! calculate the excitations here
        ! but with my general two-body excitation routine i do not need
        ! to calculate this in case of more than singles:
        if (RDMExcitLevel == 1) then
            call calc_explicit_1_rdm_guga(ilutG, csf_i, n_singles, excits)

            ! and then sort them correctly in the communicated array
            call assign_excits_to_proc_guga(n_singles, excits, 1)

            deallocate(excits)
            call LogMemDealloc(this_routine, tag_excitations)
        end if

        ! now to double excitations if requsted:
        if (RDMExcitLevel /= 1) then

            ! if i want to mimic stochastic RDM sampling I also
            ! have to explicitly create single excitations, but
            ! store them in the according 2-RDM entries
            call calc_explicit_1_rdm_guga(ilutG, csf_i, n_singles, excits)

            ! and then sort them correctly in the communicated array
            call assign_excits_to_proc_guga(n_singles, excits, 1)

            deallocate(excits)
            call LogMemDealloc(this_routine, tag_excitations)

            call calc_explicit_2_rdm_guga(ilutG, csf_i, n_doubles, excits)

            call assign_excits_to_proc_guga(n_doubles, excits, 2)

            deallocate(excits)
            call LogMemDealloc(this_routine, tag_excitations)
        end if

    end subroutine gen_exc_djs_guga