10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00

added is_connected_to

This commit is contained in:
Yann Garniron 2015-11-19 21:20:43 +01:00
parent 8a67f8e7d9
commit 806d7be98b
3 changed files with 56 additions and 14 deletions

View File

@ -79,7 +79,6 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n
integer(bit_kind) :: tq(Nint,2,n_selected)
integer :: N_tq, c_ref ,degree
integer :: connected_to_ref
double precision :: hIk, hla, hIl, dIk(N_states), dka(N_states), dIa(N_states)
double precision, allocatable :: dIa_hla(:,:)
@ -262,6 +261,7 @@ subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq
integer :: nt,ni
logical, external :: is_connected_to
integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators)
@ -273,15 +273,18 @@ subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq
i_loop : do i=1,N_selected
do j=1,N_miniList
nt = 0
do ni=1,Nint
nt += popcnt(xor(miniList(ni,1,j), det_buffer(ni,1,i))) + popcnt(xor(miniList(ni,2,j), det_buffer(ni,2,i)))
end do
if(nt <= 4) then
cycle i_loop
if(is_connected_to(det_buffer(ni,1,i), miniList, Nint, N_miniList)) then
cycle
end if
end do
! do j=1,N_miniList
! nt = 0
! do ni=1,Nint
! nt += popcnt(xor(miniList(ni,1,j), det_buffer(ni,1,i))) + popcnt(xor(miniList(ni,2,j), det_buffer(ni,2,i)))
! end do
! if(nt <= 4) then
! cycle i_loop
! end if
! end do
! if(connected_to_ref(det_buffer(1,1,i),psi_det_generators,Nint, &
! i_generator,N_det_generators) /= 0) then
! cycle i_loop

View File

@ -25,7 +25,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
integer(bit_kind) :: minilist_gen(Nint,2,N_det_generators)
integer :: N_minilist_gen
logical :: fullMatch
logical, external :: is_connected_to
@ -55,11 +55,15 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
! end if
! end do
c_ref = connected_to_ref(buffer(1,1,i),miniList_gen,Nint,N_minilist_gen+1,N_minilist_gen)
! c_ref = connected_to_ref(buffer(1,1,i),miniList_gen,Nint,N_minilist_gen+1,N_minilist_gen)
!
! if (c_ref /= 0) then
! cycle
! endif
if (c_ref /= 0) then
if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then
cycle
endif
end if
if (is_in_wavefunction(buffer(1,1,i),Nint)) then
cycle

View File

@ -154,6 +154,41 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
! END DEBUG is_in_wf
end
logical function is_connected_to(key,keys,Nint,Ndet)
use bitmasks
implicit none
integer, intent(in) :: Nint, Ndet
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2)
integer :: i, l
integer :: degree_x2
ASSERT (Nint > 0)
ASSERT (Nint == N_int)
is_connected_to = .false.
do i=1,Ndet
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
!DEC$ LOOP COUNT MIN(3)
do l=2,Nint
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
popcnt(xor( key(l,2), keys(l,2,i)))
enddo
if (degree_x2 > 4) then
cycle
else
is_connected_to = .true.
return
endif
enddo
end
integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
use bitmasks
implicit none