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

optimized minilist order

Browse Source
This commit is contained in:
Yann Garniron 2015-11-05 15:05:19 +01:00
parent 238a5d6dd6
commit a6163512e1
1 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -91,16 +91,19 @@ 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(:,:,:) integer(bit_kind),allocatable :: miniList(:,:,:), supalist(:,:,:)
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, ni integer :: N_miniList, N_supalist, ni, leng
leng = max(N_det_generators, N_det_non_ref)
allocate(miniList(Nint, 2, max(N_det_generators, N_det_non_ref)), idx_miniList(max(N_det_generators, N_det_non_ref))) allocate(miniList(Nint, 2, leng), idx_miniList(leng), supalist(Nint,2,leng))
l = 0 l = 0
N_miniList = 0
N_supalist = 0
do ni = 1,Nint do ni = 1,Nint
l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2)) l += popcnt(key_mask(ni,1)) + popcnt(key_mask(ni,2))
end do end do
@ -109,22 +112,36 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n
N_miniList = i_generator-1 N_miniList = i_generator-1
miniList(:,:,:N_miniList) = psi_det_generators(:,:,:N_minilist) miniList(:,:,:N_miniList) = psi_det_generators(:,:,:N_minilist)
else else
N_miniList = 0
do i=i_generator-1,1,-1 do i=i_generator-1,1,-1
k = l k = l
do ni=1,nint 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))) 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 end do
if(k == 0) then ! if(k == 0) then
deallocate(miniList, idx_miniList) ! deallocate(miniList, supalist, idx_miniList)
return ! return
end if ! else if(k <= 2) then
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 N_minilist += 1
miniList(:,:,N_minilist) = psi_det_generators(:,:,i) miniList(:,:,N_minilist) = psi_det_generators(:,:,i)
else if(k == 0) then
deallocate(miniList, supalist, idx_miniList)
return
end if end if
end do 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
@ -286,10 +303,12 @@ subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq
integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators) integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators)
integer,intent(in) :: N_miniList integer,intent(in) :: N_miniList
N_tq = 0 N_tq = 0
i_loop : do i=1,N_selected i_loop : do i=1,N_selected
do j=1,N_miniList do j=1,N_miniList
nt = 0 nt = 0