diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index b5e14565..9beac80b 100644 --- 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,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 - N_miniList = 0 - N_supalist = 0 - - do ni = 1,Nint - l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2)) - end do + !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) - 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) - 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 + if(fullMatch) then + return end if diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 8ac1c51e..02a36fff 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/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 - 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 +! 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),psi_det_generators,Nint,i_generator,N_det_generators) -! -! if (c_ref /= 0) then -! cycle -! endif + 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 diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 8daf27ae..ea3e9f3c 100644 --- 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