LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-04 05:03:54 +01:00
Code Issues Releases Wiki Activity

Solved bug for large calculations

Browse Source
This commit is contained in:
Anthony Scemama 2017-07-15 01:02:13 +02:00
parent 24725e60e6
commit 2beeb454a4
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -43,10 +43,12 @@ subroutine get_excitation_degree(key1,key2,degree,Nint)
degree = sum(popcnt(xorvec(1:8))) degree = sum(popcnt(xorvec(1:8)))
case default case default
do l=1,ishft(Nint,1) integer :: lmax
lmax = ishft(Nint,1)
do l=1,lmax
xorvec(l) = xor( key1(l), key2(l)) xorvec(l) = xor( key1(l), key2(l))
enddo enddo
degree = sum(popcnt(xorvec(1:l))) degree = sum(popcnt(xorvec(1:lmax)))
end select end select
@ -1503,14 +1505,16 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
!DIR$ LOOP COUNT (1000) !DIR$ LOOP COUNT (1000)
do i=1,sze do i=1,sze
d = 0 d = 0
degree_alpha = 0
degree_beta = 0
!DIR$ LOOP COUNT MIN(4) !DIR$ LOOP COUNT MIN(4)
do m=1,Nint do m=1,Nint
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
+ popcnt(xor( key1(m,2,i), key2(m,2))) + popcnt(xor( key1(m,2,i), key2(m,2)))
key_tmp(m,1) = xor(key1(m,1,i),key2(m,1)) key_tmp(m,1) = xor(key1(m,1,i),key2(m,1))
key_tmp(m,2) = xor(key1(m,2,i),key2(m,2)) key_tmp(m,2) = xor(key1(m,2,i),key2(m,2))
degree_alpha = popcnt(key_tmp(m,1)) degree_alpha += popcnt(key_tmp(m,1))
degree_beta = popcnt(key_tmp(m,2)) degree_beta += popcnt(key_tmp(m,2))
enddo enddo
if(degree_alpha .gt.3 .or. degree_beta .gt.3 )cycle !! no double excitations of same spin if(degree_alpha .gt.3 .or. degree_beta .gt.3 )cycle !! no double excitations of same spin
degree(l) = ishft(d,-1) degree(l) = ishft(d,-1)
@ -1661,12 +1665,13 @@ subroutine get_excitation_degree_vector_mono_or_exchange_verbose(key1,key2,degre
do i=1,sze do i=1,sze
d = 0 d = 0
exchange_1 = 0 exchange_1 = 0
exchange_2 = 0
!DIR$ LOOP COUNT MIN(4) !DIR$ LOOP COUNT MIN(4)
do m=1,Nint do m=1,Nint
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
+ popcnt(xor( key1(m,2,i), key2(m,2))) + popcnt(xor( key1(m,2,i), key2(m,2)))
exchange_1 = popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2)))) exchange_1 += popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2))))
exchange_2 = popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2)))) exchange_2 += popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2))))
enddo enddo
if (d > 4)cycle if (d > 4)cycle
if (d ==4)then if (d ==4)then
@ -2225,7 +2230,7 @@ subroutine get_excitation_degree_spin(key1,key2,degree,Nint)
degree = sum(popcnt(xorvec(1:4))) degree = sum(popcnt(xorvec(1:4)))
case default case default
do l=1,N_int do l=1,Nint
xorvec(l) = xor( key1(l), key2(l)) xorvec(l) = xor( key1(l), key2(l))
enddo enddo
degree = sum(popcnt(xorvec(1:Nint))) degree = sum(popcnt(xorvec(1:Nint)))