generate_excitation_guga Subroutine

public subroutine generate_excitation_guga(nI, ilutI, nJ, ilutJ, exFlag, IC, excitMat, tParity, pgen, HElGen, store, part_type)

An API interfacing function for generate_excitation to the rest of NECI:

Requires guga_bitRepOps::current_csf_i to be set according to the ilutI.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nEl)
integer(kind=n_int), intent(in) :: ilutI(0:niftot)
integer, intent(out) :: nJ(nEl)
integer(kind=n_int), intent(out) :: ilutJ(0:niftot)
integer, intent(in) :: exFlag
integer, intent(out) :: IC
integer, intent(out) :: excitMat(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pgen
real(kind=dp), intent(out) :: HElGen
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type

Contents


Source Code

    subroutine generate_excitation_guga(nI, ilutI, nJ, ilutJ, exFlag, IC, &
                                        excitMat, tParity, pgen, HElGen, store, part_type)
        !! An API interfacing function for generate_excitation to the rest of NECI:
        !!
        !! Requires guga_bitRepOps::current_csf_i to be set according to the ilutI.
        integer, intent(in) :: nI(nEl), exFlag
        integer(n_int), intent(in) :: ilutI(0:niftot)
        integer, intent(out) :: nJ(nEl), IC, excitMat(2, maxExcit)
        integer(n_int), intent(out) :: ilutJ(0:niftot)
        logical, intent(out) :: tParity
        real(dp), intent(out) :: pgen
        HElement_t(dp), intent(out) :: HElGen
        type(excit_gen_store_type), intent(inout), target :: store
        integer, intent(in), optional :: part_type
        character(*), parameter :: this_routine = "generate_excitation_guga"

        integer(n_int) :: ilut(0:nifguga), new_ilut(0:nifguga)
        integer :: excit_typ(2)

        type(ExcitationInformation_t) :: excitInfo
        real(dp) :: diff
        HElement_t(dp) :: tmp_mat1
        HElement_t(dp) :: tmp_mat

        unused_var(exFlag); unused_var(part_type); unused_var(store)
        ASSERT(is_compatible(ilutI, current_csf_i))

        ! think about default values and unneeded variables for GUGA, but
        ! which have to be processed anyway to interface to NECI

        ! excitatioin matrix... i could set that up for GUGA too..
        ! but its not needed specifically except for RDM and logging purposes

        ! in new implementation with changing relative probabilites of different
        ! types of excitation, misuse this array to log the type of excitation
        excitMat = 0

        ! the parity flag is also unneccesary in GUGA
        tParity = .true.

        ! the inputted exFlag variable, is also not needed probably..

        ! then choose between single or double excitations..
        ! TODO: still have to think how to set up pSingles and pDoubles in
        ! GUGA...

        ! and before i have to convert to GUGA iluts..
        call convert_ilut_toGUGA(ilutI, ilut)

        ASSERT(isProperCSF_ilut(ilut, .true.))

        ! maybe i need to copy the flags of ilutI onto ilutJ
        ilutJ = ilutI

        if (genrand_real2_dSFMT() < pSingles) then

            IC = 1
            call createStochasticExcitation_single(ilut, nI, current_csf_i, new_ilut, pgen)
            pgen = pgen * pSingles

        else

            IC = 2
            call createStochasticExcitation_double(ilut, nI, current_csf_i, new_ilut, pgen, excit_typ)
            pgen = pgen * pDoubles

        end if

        ! for now add a sanity check to compare the stochastic obtained
        ! matrix elements with the exact calculation..
        ! since something is going obviously wrong..
#ifdef DEBUG_
        call additional_checks()
#endif

        ! check if excitation generation was successful
        if (near_zero(pgen)) then
            ! indicate NullDet to skip spawn step
            nJ(1) = 0
            HElGen = h_cast(0.0_dp)

        else

            ! also store information on type of excitation for the automated
            ! tau-search for the non-weighted guga excitation generator in
            ! the excitMat variable
            excitMat(1, 1:2) = excit_typ

            ! profile tells me this costs alot of time.. so remove it
            ! and only do it in debug mode..
            ! i just have to be sure that no wrong csfs are created..

            ASSERT(isProperCSF_ilut(new_ilut, .true.))
            ! otherwise extract H element and convert to 0

            call convert_ilut_toNECI(new_ilut, ilutJ, HElgen)

            if (t_matele_cutoff .and. abs(HElGen) < matele_cutoff) then
                HElgen = h_cast(0.0_dp)
                nJ(1) = 0
                pgen = 0.0_dp
                return
            end if

            call decode_bit_det(nJ, ilutJ)

            if (tHub .and. .not. treal) then
                if (.not. (IsMomentumAllowed(nJ))) then
                    call write_det_guga(stdout, new_ilut)
                end if
            end if
        end if

        if (tStoquastize) HElgen = -abs(HElgen)

    contains

#ifdef DEBUG_
        subroutine additional_checks()

            ! for now add a sanity check to compare the stochastic obtained
            ! matrix elements with the exact calculation..
            ! since something is going obviously wrong..
            if (.not. near_zero(pgen)) then
                call convert_ilut_toNECI(new_ilut, ilutJ, HElgen)
                call calc_guga_matrix_element(ilutI, current_csf_i, ilutJ, CSF_Info_t(ilutJ), excitInfo, tmp_mat, .true.)

                diff = abs(HElGen - tmp_mat)
                if (diff > 1.0e-10_dp) then
                    print *, "WARNING: differing stochastic and exact matrix elements!"
                    call write_det_guga(stdout, ilutI, .true.)
                    call write_det_guga(stdout, ilutJ, .true.)
                    print *, "mat eles and diff:", HElGen, tmp_mat, diff
                    print *, " pgen: ", pgen
                    print *, " deduced excit-info: "
                    call print_excitInfo(excitInfo)
                    print *, " global excit-info: "
                    call print_excitInfo(global_excitInfo)
                    call neci_flush(stdout)
                end if

                ! is the other order also fullfilled?
                call calc_guga_matrix_element(ilutJ, CSF_Info_t(ilutJ), ilutI, current_csf_i, excitInfo, tmp_mat1, .true.)

#ifdef CMPLX_
                diff = abs(tmp_mat1 - conjg(tmp_mat))
#else
                diff = abs(tmp_mat1 - tmp_mat)
#endif
                if (diff > 1.0e-10_dp) then
                    print *, "WARNING: differing sign in matrix elements!"
                    call write_det_guga(stdout, ilutI, .true.)
                    call write_det_guga(stdout, ilutJ, .true.)
                    print *, "mat eles and diff:", tmp_mat, tmp_mat1, diff
                    print *, "<I|H|J> excitInfo:"
                    call print_excitInfo(excitInfo)
                    excitInfo = identify_excitation(ilutI, ilutJ)
                    print *, "<J|H|I> excitInfo:"
                    call print_excitInfo(excitInfo)
                    call neci_flush(stdout)
                end if
            end if
        end subroutine additional_checks
#endif
    end subroutine generate_excitation_guga