init_cepa_shifts Subroutine

public subroutine init_cepa_shifts()

Arguments

None

Contents

Source Code


Source Code

    subroutine init_cepa_shifts()
        use DetBitOps, only: TestClosedShellDet
        use FciMCData, only: ilutref

        character(*), parameter :: this_routine = "init_cepa_shifts"

        integer :: i
        ! i have to allocate it for each replica

        print *, "init cepa shifts "

        if (.not. allocated(ilutref)) then
            call stop_all(this_routine, "reference det not yet set!")
        end if

        do i = 1, inum_runs
            if (.not. TestClosedShellDet(ilutref(:, i))) then
                call stop_all(this_routine, "Cepa shifts only for closed shell reference!")
            end if
        end do

        select case (trim(adjustl(cepa_method)))

        case ('0')
            ! here the shift has to cancel the correlation energy, but i can't
            ! point to the shift.. hm.. i guess i can't do that so nicely..
            cepa_shift_single => cepa_0
            cepa_shift_double => cepa_0

        case ('1')

            cepa_shift_single => cepa_1_single
            cepa_shift_double => cepa_1_double
            call stop_all(this_routine, "cepa(1) not yet implemented!")

        case ('3')

            cepa_shift_single => cepa_3_single
            cepa_shift_double => cepa_3_double

            call stop_all(this_routine, "cepa(3) not yet implemented!")

        case ('acpf')

            ! here it gets tricky.. it would be nice if we have the shift here.
            ! i actually should us procedure pointers i guess..
            cepa_shift_single => cepa_acpf
            cepa_shift_double => cepa_acpf

        case ('aqcc')

            ! is it orbital or electrons here?
            if (nel <= 3) then
                call stop_all(this_routine, "not enough electrons for aqcc shift!")
            end if

            aqcc_factor = (1.0_dp - real((nel - 3) * (nel - 2), dp) / real(nel * (nel - 1), dp))

            cepa_shift_single => cepa_aqcc
            cepa_shift_double => cepa_aqcc
!
        case default

            call stop_all(this_routine, "not recognised cepa shift!")

        end select

        ! i have to point to the cc-version or to the CISD version too..
        if (t_cc_amplitudes) then
            cepa_shift => cepa_shift_cc
        else
            cepa_shift => cepa_shift_cisd
        end if

    end subroutine init_cepa_shifts