10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-02 03:15:29 +02:00

Merge pull request #122 from garniron/master

bug in MRCC_dress
This commit is contained in:
Anthony Scemama 2015-12-02 16:09:13 +01:00
commit e6d9cd894a

View File

@ -14,54 +14,6 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), psi_ref_lock, (psi_det_size) ]
END_PROVIDER
! subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, 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,intent(out) :: idx_miniList(N_fullList), N_miniList
! integer, intent(in) :: Nint
! integer(bit_kind) :: key_mask(Nint, 2)
! integer :: ni, i, n_a, n_b, e_a, e_b
!
!
! n_a = 0
! n_b = 0
! do ni=1,nint
! n_a = n_a + popcnt(key_mask(ni,1))
! n_b = n_b + popcnt(key_mask(ni,2))
! end do
!
! if(n_a == 0) then
! N_miniList = N_fullList
! miniList(:,:,:) = fullList(:,:,:)
! do i=1,N_fullList
! idx_miniList(i) = i
! end do
! return
! end if
!
! N_miniList = 0
!
! do i=1,N_fullList
! e_a = n_a
! e_b = n_b
! do ni=1,nint
! e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1)))
! e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2)))
! end do
!
! if(e_a + e_b <= 2) then
! N_miniList = N_miniList + 1
! miniList(:,:,N_miniList) = fullList(:,:,i)
! idx_miniList(N_miniList) = i
! end if
! end do
! end subroutine
subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask)
use bitmasks
implicit none
@ -273,22 +225,9 @@ subroutine find_triples_and_quadruples(i_generator,n_selected,det_buffer,Nint,tq
i_loop : do i=1,N_selected
if(is_connected_to(det_buffer(ni,1,i), miniList, Nint, N_miniList)) then
if(is_connected_to(det_buffer(1,1,i), miniList, Nint, N_miniList)) then
cycle
end if
! do j=1,N_miniList
! nt = 0
! do ni=1,Nint
! nt += popcnt(xor(miniList(ni,1,j), det_buffer(ni,1,i))) + popcnt(xor(miniList(ni,2,j), det_buffer(ni,2,i)))
! end do
! if(nt <= 4) then
! cycle i_loop
! end if
! end do
! if(connected_to_ref(det_buffer(1,1,i),psi_det_generators,Nint, &
! i_generator,N_det_generators) /= 0) then
! cycle i_loop
! end if
! Select determinants that are triple or quadruple excitations
! from the ref