added is_connected_to

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

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

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