diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index 9beac80b..42c8d9d0 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -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 - end if - end do + if(is_connected_to(det_buffer(ni,1,i), miniList, Nint, N_miniList)) then + cycle + end if +! 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 diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 02a36fff..05176fe6 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -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 diff --git a/src/Determinants/connected_to_ref.irp.f b/src/Determinants/connected_to_ref.irp.f index 8f594738..dc7698b5 100644 --- a/src/Determinants/connected_to_ref.irp.f +++ b/src/Determinants/connected_to_ref.irp.f @@ -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