LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-22 05:02:15 +02:00
Code Issues Releases Wiki Activity

added create_minilist_find_previous

Browse Source
This commit is contained in:
Yann Garniron 2015-11-19 20:57:44 +01:00
parent a3cb6019cc
commit 8a67f8e7d9
3 changed files with 85 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
plugins/MRCC_Utils/mrcc_dress.irp.f
View File

@ -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

46
plugins/Perturbation/perturbation.template.f
View File

@ -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

52
src/Determinants/slater_rules.irp.f
View File

@ -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