added create_minilist_find_previous

2024-12-23 04:43:50 +01:00 · 2015-11-19 20:57:44 +01:00 · 2015-11-19 20:57:44 +01:00 · 8a67f8e7d9
commit 8a67f8e7d9
parent a3cb6019cc
3 changed files with 85 additions and 66 deletions
--- a/plugins/MRCC_Utils/mrcc_dress.irp.f
+++ b/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,58 +91,21 @@ 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
-  N_miniList = 0
-  N_supalist = 0
+  !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
+  call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
  
-  do ni = 1,Nint
-    l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
-  end do
-  
-  if(l == 0) then
-    N_miniList = i_generator-1
-    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)
+  if(fullMatch) then
    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
  
  
  call find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist)
--- a/plugins/Perturbation/perturbation.template.f
+++ b/plugins/Perturbation/perturbation.template.f
@ -23,11 +23,10 @@ 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)
@ -36,26 +35,31 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
  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
-      if(idx_minilist_gen(k) >= i_generator) then
-        exit
-      end if
-      ex = 0
-      do ni=1,Nint
-        ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i)))
-      end do
-      if(ex <= 4) then
-        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)
-! 
-!     if (c_ref /= 0) then
-!       cycle
+!     do k=1,N_minilist_gen
+!       ex = 0
+!       do ni=1,Nint
+!         ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i)))
+!       end do
+!       if(ex <= 4) then
+!         cycle buffer_loop
 !       end if
+!     end do
+    
+    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 (is_in_wavefunction(buffer(1,1,i),Nint)) then
      cycle
--- a/src/Determinants/slater_rules.irp.f
+++ b/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