mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Accelerated get_excitation_degree_vector
This commit is contained in:
parent
c042e5af0c
commit
7ef8ee171d
@ -48,13 +48,16 @@ subroutine get_excitation_operators_for_one_ref(det_ref,i_state,ndetnonref,N_con
|
||||
N_connect_ref = 0
|
||||
do i = 1, ndetnonref
|
||||
call i_H_j_phase_out(det_ref,psi_non_ref(1,1,i),N_int,hij,phase,exc,degree)
|
||||
! if(dabs(hij).le.mo_integrals_threshold)cycle
|
||||
if (dabs(hij) <= mo_integrals_threshold) then
|
||||
cycle
|
||||
endif
|
||||
N_connect_ref +=1
|
||||
index_connected(N_connect_ref) = i
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
amplitudes_phase_less(N_connect_ref) = hij * lambda_mrcc(i_state,i) !*phase
|
||||
|
||||
if (degree==2) then
|
||||
|
||||
excitation_operators(1,N_connect_ref) = h1
|
||||
excitation_operators(2,N_connect_ref) = p1
|
||||
excitation_operators(3,N_connect_ref) = h2
|
||||
@ -63,10 +66,12 @@ subroutine get_excitation_operators_for_one_ref(det_ref,i_state,ndetnonref,N_con
|
||||
excitation_operators(5,N_connect_ref) = 2
|
||||
elseif(s1==s2.and.s1==2)then ! double beta
|
||||
excitation_operators(5,N_connect_ref) = -2
|
||||
else
|
||||
excitation_operators(5,N_connect_ref)= 0 ! double alpha/beta
|
||||
else ! double alpha/beta
|
||||
excitation_operators(5,N_connect_ref) = 0
|
||||
endif
|
||||
|
||||
else if(degree==1) then
|
||||
|
||||
if(s1==1)then ! mono alpha
|
||||
excitation_operators(5,N_connect_ref) = 1
|
||||
excitation_operators(1,N_connect_ref) = h1
|
||||
@ -76,8 +81,11 @@ subroutine get_excitation_operators_for_one_ref(det_ref,i_state,ndetnonref,N_con
|
||||
excitation_operators(3,N_connect_ref) = h1
|
||||
excitation_operators(4,N_connect_ref) = p1
|
||||
endif
|
||||
|
||||
else
|
||||
|
||||
N_connect_ref-=1
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
@ -960,7 +960,7 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
integer, intent(out) :: degree(sze)
|
||||
integer, intent(out) :: idx(0:sze)
|
||||
|
||||
integer :: i,l
|
||||
integer :: i,l,d
|
||||
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (sze > 0)
|
||||
@ -970,9 +970,12 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
|
||||
!DIR$ LOOP COUNT (1000)
|
||||
do i=1,sze
|
||||
degree(l) = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||
d = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||
popcnt(xor( key1(1,2,i), key2(1,2))),-1)
|
||||
if (degree(l) < 3) then
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
degree(l) = d
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -982,11 +985,14 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
|
||||
!DIR$ LOOP COUNT (1000)
|
||||
do i=1,sze
|
||||
degree(l) = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||
d = ishft(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))),-1)
|
||||
if (degree(l) < 3) then
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
degree(l) = d
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -996,13 +1002,16 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
|
||||
!DIR$ LOOP COUNT (1000)
|
||||
do i=1,sze
|
||||
degree(l) = ishft( popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||
d = ishft( 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))),-1)
|
||||
if (degree(l) < 3) then
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
degree(l) = d
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1012,14 +1021,17 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
|
||||
!DIR$ LOOP COUNT (1000)
|
||||
do i=1,sze
|
||||
degree(l) = 0
|
||||
d = 0
|
||||
!DEC$ LOOP COUNT MIN(4)
|
||||
do l=1,Nint
|
||||
degree(l) = degree(l)+ popcnt(xor( key1(l,1,i), key2(l,1))) +&
|
||||
d = d + popcnt(xor( key1(l,1,i), key2(l,1))) +&
|
||||
popcnt(xor( key1(l,2,i), key2(l,2)))
|
||||
enddo
|
||||
degree(l) = ishft(degree(l),-1)
|
||||
if (degree(l) < 3) then
|
||||
d = ishft(d,-1)
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
degree(l) = d
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
|
Loading…
Reference in New Issue
Block a user