10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-09 07:33:53 +01:00
quantum_package/plugins/Perturbation/pert_sc2.irp.f

30 lines
874 B
Fortran
Raw Normal View History

2014-06-02 19:35:42 +02:00
double precision function repeat_all_e_corr(key_in)
implicit none
integer(bit_kind), intent(in) :: key_in(N_int,2)
integer :: i,degree
double precision :: accu
use bitmasks
accu = 0.d0
call get_excitation_degree(key_in,ref_bitmask,degree,N_int)
if(degree==2)then
do i = 1, N_det_selectors
call get_excitation_degree(ref_bitmask,psi_selectors(1,1,i),degree,N_int)
if(degree.ne.2)cycle
call get_excitation_degree(key_in,psi_selectors(1,1,i),degree,N_int)
if (degree<=3)cycle
accu += E_corr_per_selectors(i)
enddo
elseif(degree==1)then
do i = 1, N_det_selectors
call get_excitation_degree(ref_bitmask,psi_selectors(1,1,i),degree,N_int)
if(degree.ne.2)cycle
call get_excitation_degree(key_in,psi_selectors(1,1,i),degree,N_int)
if (degree<=2)cycle
accu += E_corr_per_selectors(i)
enddo
endif
repeat_all_e_corr = accu
end