mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
added create_minilist_find_previous
This commit is contained in:
parent
a3cb6019cc
commit
8a67f8e7d9
@ -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 :: i,j,k,l
|
||||||
integer :: degree_alpha(psi_det_size)
|
integer :: degree_alpha(psi_det_size)
|
||||||
integer :: idx_alpha(0:psi_det_size)
|
integer :: idx_alpha(0:psi_det_size)
|
||||||
logical :: good
|
logical :: good, fullMatch
|
||||||
|
|
||||||
integer(bit_kind) :: tq(Nint,2,n_selected)
|
integer(bit_kind) :: tq(Nint,2,n_selected)
|
||||||
integer :: N_tq, c_ref ,degree
|
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 :: iint, ipos
|
||||||
integer :: i_state, k_sd, l_sd, i_I, i_alpha
|
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(bit_kind),intent(in) :: key_mask(Nint, 2)
|
||||||
integer,allocatable :: idx_miniList(:)
|
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)
|
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
|
if(fullMatch) then
|
||||||
l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
|
return
|
||||||
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)
|
|
||||||
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
|
end if
|
||||||
|
|
||||||
|
|
||||||
|
@ -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 :: idx_minilist(N_det_selectors), N_minilist
|
||||||
|
|
||||||
integer(bit_kind) :: minilist_gen(Nint,2,N_det_generators)
|
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 > 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 (minval(sum_norm_pert) >= 0.d0)
|
||||||
ASSERT (N_st > 0)
|
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
|
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
|
if (is_in_wavefunction(buffer(1,1,i),Nint)) then
|
||||||
cycle
|
cycle
|
||||||
|
@ -810,6 +810,58 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
|
|||||||
end do
|
end do
|
||||||
end subroutine
|
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)
|
subroutine i_H_psi_nominilist(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
Loading…
Reference in New Issue
Block a user