10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-02 11:25:26 +02:00

Corrected filter_connected_davidson

This commit is contained in:
Anthony Scemama 2014-05-30 22:48:09 +02:00
parent 7cefd341bb
commit 4feffb008f
3 changed files with 72 additions and 62 deletions

View File

@ -77,6 +77,12 @@ Documentation
`key_pattern_not_in_ref <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connected_to_ref.irp.f#L222>`_
Min and max values of the integers of the keys of the reference
`det_connections <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connections.irp.f#L10>`_
.br
`n_con_int <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connections.irp.f#L2>`_
Number of integers to represent the connections between determinants
`davidson_converged <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/davidson.irp.f#L383>`_
True if the Davidson algorithm is converged
@ -228,15 +234,7 @@ Documentation
idx(0) is the number of determinants that interact with key1
`filter_connected_i_h_psi0_sc2 <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/filter_connected.irp.f#L310>`_
standard filter_connected_i_H_psi but returns in addition
.br
the array of the index of the non connected determinants to key1
.br
in order to know what double excitation can be repeated on key1
.br
idx_repeat(0) is the number of determinants that can be used
.br
to repeat the excitations
Undocumented
`get_s2 <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/s2.irp.f#L1>`_
Returns <S^2>

View File

@ -111,7 +111,7 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
integer(bit_kind), intent(in) :: key2(Nint,2)
integer, intent(out) :: idx(0:sze)
integer :: i,j,l
integer :: i,j,k,l
integer :: degree_x2
integer :: j_int, j_start
integer*8 :: itmp
@ -140,70 +140,80 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
itmp = iand(itmp-1_8,itmp)
enddo
enddo
! l=1
! !DIR$ LOOP COUNT (1000)
! do i=1,sze
! degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
! popcnt(xor( key1(2,1,i), key2(2,1)))
! if (degree_x2 < 5) then
! if (idx(l) /= i) then
! print *, l, idx(l), i
! endif
! idx(l) = i
! l = l+1
! endif
! enddo
else if (Nint==2) then
!DIR$ LOOP COUNT (1000)
do i=1,sze
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,2,i), key2(2,2)))
if (degree_x2 < 5) then
idx(l) = i
l = l+1
endif
i = idx(0)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
popcnt(xor( key1(2,1,j), key2(2,1))) + &
popcnt(xor( key1(1,2,j), key2(1,2))) + &
popcnt(xor( key1(2,2,j), key2(2,2)))
if (degree_x2 < 5) then
idx(l) = j
l = l+1
endif
enddo
itmp = iand(itmp-1_8,itmp)
enddo
enddo
else if (Nint==3) then
!DIR$ LOOP COUNT (1000)
do i=1,sze
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(2,2,i), key2(2,2))) + &
popcnt(xor( key1(3,1,i), key2(3,1))) + &
popcnt(xor( key1(3,2,i), key2(3,2)))
if (degree_x2 < 5) then
idx(l) = i
l = l+1
endif
i = idx(0)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
popcnt(xor( key1(1,2,j), key2(1,2))) + &
popcnt(xor( key1(2,1,j), key2(2,1))) + &
popcnt(xor( key1(2,2,j), key2(2,2))) + &
popcnt(xor( key1(3,1,j), key2(3,1))) + &
popcnt(xor( key1(3,2,j), key2(3,2)))
if (degree_x2 < 5) then
idx(l) = j
l = l+1
endif
enddo
itmp = iand(itmp-1_8,itmp)
enddo
enddo
else
!DIR$ LOOP COUNT (1000)
do i=1,sze
degree_x2 = 0
!DEC$ LOOP COUNT MIN(4)
do j=1,Nint
degree_x2 = degree_x2+ popcnt(xor( key1(j,1,i), key2(j,1))) +&
popcnt(xor( key1(j,2,i), key2(j,2)))
if (degree_x2 > 4) then
exit
endif
i = idx(0)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
degree_x2 = 0
!DEC$ LOOP COUNT MIN(4)
do k=1,Nint
degree_x2 = degree_x2+ popcnt(xor( key1(k,1,j), key2(k,1))) +&
popcnt(xor( key1(k,2,j), key2(k,2)))
if (degree_x2 > 4) then
exit
endif
enddo
if (degree_x2 <= 5) then
idx(l) = j
l = l+1
endif
enddo
itmp = iand(itmp-1_8,itmp)
enddo
if (degree_x2 <= 5) then
idx(l) = i
l = l+1
endif
enddo
endif
idx(0) = l-1
end

View File

@ -868,9 +868,11 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint)
call filter_connected_davidson(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx)
do jj=1,idx(0)
j = idx(jj)
call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
vt (i) = vt (i) + hij*u_0(j)
vt (j) = vt (j) + hij*u_0(i)
if ( (dabs(u_0(j)) > 1.d-7).or.((dabs(u_0(i)) > 1.d-7)) ) then
call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
vt (i) = vt (i) + hij*u_0(j)
vt (j) = vt (j) + hij*u_0(i)
endif
enddo
enddo
!$OMP END DO