added create_minilist_find_previous

plugins/MRCC_Utils/mrcc_dress.irp.f

@@ -75,7 +75,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n
   integer                        :: i,j,k,l
   integer                        :: degree_alpha(psi_det_size)
   integer                        :: idx_alpha(0:psi_det_size)
-  logical                        :: good
+  logical                        :: good, fullMatch
 
   integer(bit_kind)              :: tq(Nint,2,n_selected)
   integer                        :: N_tq, c_ref ,degree
@@ -91,57 +91,20 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n
   integer                        :: iint, ipos
   integer                        :: i_state, k_sd, l_sd, i_I, i_alpha
   
-  integer(bit_kind),allocatable  :: miniList(:,:,:), supalist(:,:,:)
+  integer(bit_kind),allocatable  :: miniList(:,:,:)
   integer(bit_kind),intent(in)   :: key_mask(Nint, 2)
   integer,allocatable            :: idx_miniList(:)
-  integer                        :: N_miniList, N_supalist, ni, leng
+  integer                        :: N_miniList, ni, leng
   
   
   leng = max(N_det_generators, N_det_non_ref)
-  allocate(miniList(Nint, 2, leng), idx_miniList(leng), supalist(Nint,2,leng))
+  allocate(miniList(Nint, 2, leng), idx_miniList(leng))
   
-  l = 0
+  !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
-  N_miniList = 0
+  call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
-  N_supalist = 0
-    
-  do ni = 1,Nint
-    l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
-  end do
   
-  if(l == 0) then
+  if(fullMatch) then
-    N_miniList = i_generator-1
+    return
-    miniList(:,:,:N_miniList) = psi_det_generators(:,:,:N_minilist)
-  else
-    do i=i_generator-1,1,-1
-      k = l
-      do ni=1,nint
-        k -= popcnt(iand(key_mask(ni,1), psi_det_generators(ni,1,i))) + popcnt(iand(key_mask(ni,2), psi_det_generators(ni,2,i)))
-      end do
-      
-!       if(k == 0) then
-!         deallocate(miniList, supalist, idx_miniList)
-!         return
-!       else if(k <= 2) then
-!         N_minilist += 1
-!         miniList(:,:,N_minilist) = psi_det_generators(:,:,i)
-!       end if
-!       
-      if(k == 2) then
-        N_supalist += 1
-        supalist(:,:,N_supalist) = psi_det_generators(:,:,i)
-      else if(k == 1) then
-        N_minilist += 1
-        miniList(:,:,N_minilist) = psi_det_generators(:,:,i)
-      else if(k == 0) then
-        deallocate(miniList, supalist, idx_miniList)
-        return
-      end if
-    end do
-  end if
-  
-  if(N_supalist > 0) then
-    miniList(:,:,N_minilist+1:N_minilist+N_supalist) = supalist(:,:,:N_supalist)
-    N_minilist = N_minilist + N_supalist
   end if
   
   

plugins/Perturbation/perturbation.template.f

@@ -23,39 +23,43 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
   integer :: idx_minilist(N_det_selectors), N_minilist
   
   integer(bit_kind) :: minilist_gen(Nint,2,N_det_generators)
-  integer :: idx_minilist_gen(N_det_generators), N_minilist_gen
+  integer :: N_minilist_gen
+  logical :: fullMatch
   
 
-  call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint)
-  call create_minilist(key_mask, psi_det_generators, miniList_gen, idx_miniList_gen, N_det_generators, N_minilist_gen, Nint)
-
   
+
   ASSERT (Nint > 0)
   ASSERT (Nint == N_int)
   ASSERT (buffer_size >= 0)
   ASSERT (minval(sum_norm_pert) >= 0.d0)
   ASSERT (N_st > 0)
   
+  call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint)
+  call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint)
+  
+  if(fullMatch) then
+    return
+  end if
+  
+  
   buffer_loop : do i = 1,buffer_size
     
-    do k=1,N_minilist_gen
+!     do k=1,N_minilist_gen
-      if(idx_minilist_gen(k) >= i_generator) then
+!       ex = 0
-        exit
+!       do ni=1,Nint
-      end if
+!         ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i)))
-      ex = 0
+!       end do
-      do ni=1,Nint
+!       if(ex <= 4) then
-        ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i)))
+!         cycle buffer_loop
-      end do
+!       end if
-      if(ex <= 4) then
+!     end do
-        cycle buffer_loop
-      end if
-    end do
     
-!     c_ref = connected_to_ref(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det_generators)
+    c_ref = connected_to_ref(buffer(1,1,i),miniList_gen,Nint,N_minilist_gen+1,N_minilist_gen)
-! 
+
-!     if (c_ref /= 0) then
+    if (c_ref /= 0) then
-!       cycle
+      cycle
-!     endif
+    endif
     
     if (is_in_wavefunction(buffer(1,1,i),Nint)) then
       cycle

src/Determinants/slater_rules.irp.f

@@ -810,6 +810,58 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
   end do
 end subroutine
 
+subroutine create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
+  use bitmasks
+  implicit none
+  
+  integer(bit_kind), intent(in)            :: fullList(Nint, 2, N_fullList)
+  integer, intent(in)                      :: N_fullList
+  integer(bit_kind),intent(out)            :: miniList(Nint, 2, N_fullList)
+  integer(bit_kind)                        :: subList(Nint, 2, N_fullList)
+  logical,intent(out)                      :: fullMatch
+  integer,intent(out)                      :: N_miniList
+  integer, intent(in)                      :: Nint
+  integer(bit_kind)                        :: key_mask(Nint, 2)
+  integer                                  :: ni, i, k, l, N_subList
+  
+  
+  fullMatch = .false.
+  l = 0
+  N_miniList = 0
+  N_subList = 0
+    
+  do ni = 1,Nint
+    l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
+  end do
+  
+  if(l == 0) then
+    N_miniList = N_fullList
+    miniList(:,:,:N_miniList) = fullList(:,:,:N_minilist)
+  else
+    do i=N_fullList,1,-1
+      k = l
+      do ni=1,nint
+        k -= popcnt(iand(key_mask(ni,1), fullList(ni,1,i))) + popcnt(iand(key_mask(ni,2), fullList(ni,2,i)))
+      end do
+      if(k == 2) then
+        N_subList += 1
+        subList(:,:,N_subList) = fullList(:,:,i)
+      else if(k == 1) then
+        N_minilist += 1
+        miniList(:,:,N_minilist) = fullList(:,:,i)
+      else if(k == 0) then
+        fullMatch = .true.
+        return
+      end if
+    end do
+  end if
+  
+  if(N_subList > 0) then
+    miniList(:,:,N_minilist+1:N_minilist+N_subList) = sublist(:,:,:N_subList)
+    N_minilist = N_minilist + N_subList
+  end if
+end subroutine
+
 
 subroutine i_H_psi_nominilist(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
   use bitmasks