LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-30 00:44:28 +02:00
Code Issues Releases Wiki Activity

Accelerated get_excitation_degree_vector

Browse Source
This commit is contained in:
Anthony Scemama 2015-07-29 16:08:28 +02:00
parent 7ef8ee171d
commit f06d8dc257
2 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
plugins/MRCC_Utils_new/mrcc_dress.irp.f
View File

@ -51,8 +51,9 @@ subroutine mrcc_dress(ndetref,ndetnonref,nstates,delta_ij_,delta_ii_)
!$OMP END SINGLE !$OMP END SINGLE
!$OMP BARRIER !$OMP BARRIER
!$OMP DO SCHEDULE(guided) !$OMP DO SCHEDULE(dynamic)
do l = 1, N_det_non_ref do l = 1, N_det_non_ref
print *, l, '/', N_det_non_ref
double precision :: t_il,phase_il,hil double precision :: t_il,phase_il,hil
call i_H_j_phase_out(psi_ref(1,1,i),psi_non_ref(1,1,l),N_int,hil,phase_il,exc,degree) call i_H_j_phase_out(psi_ref(1,1,i),psi_non_ref(1,1,l),N_int,hil,phase_il,exc,degree)
t_il = hil * lambda_mrcc(i_state,l) t_il = hil * lambda_mrcc(i_state,l)

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

@ -970,12 +970,12 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
!DIR$ LOOP COUNT (1000) !DIR$ LOOP COUNT (1000)
do i=1,sze do i=1,sze
d = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) + & d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))),-1) popcnt(xor( key1(1,2,i), key2(1,2)))
if (d > 2) then if (d > 4) then
cycle cycle
else else
degree(l) = d degree(l) = ishft(d,-1)
idx(l) = i idx(l) = i
l = l+1 l = l+1
endif endif
@ -985,14 +985,14 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
!DIR$ LOOP COUNT (1000) !DIR$ LOOP COUNT (1000)
do i=1,sze do i=1,sze
d = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) + & d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + & popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,1,i), key2(2,1))) + & popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(2,2,i), key2(2,2))),-1) popcnt(xor( key1(2,2,i), key2(2,2)))
if (d > 2) then if (d > 4) then
cycle cycle
else else
degree(l) = d degree(l) = ishft(d,-1)
idx(l) = i idx(l) = i
l = l+1 l = l+1
endif endif
@ -1002,16 +1002,16 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
!DIR$ LOOP COUNT (1000) !DIR$ LOOP COUNT (1000)
do i=1,sze do i=1,sze
d = ishft( popcnt(xor( key1(1,1,i), key2(1,1))) + & d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + & popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,1,i), key2(2,1))) + & popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(2,2,i), key2(2,2))) + & popcnt(xor( key1(2,2,i), key2(2,2))) + &
popcnt(xor( key1(3,1,i), key2(3,1))) + & popcnt(xor( key1(3,1,i), key2(3,1))) + &
popcnt(xor( key1(3,2,i), key2(3,2))),-1) popcnt(xor( key1(3,2,i), key2(3,2)))
if (d > 2) then if (d > 4) then
cycle cycle
else else
degree(l) = d degree(l) = ishft(d,-1)
idx(l) = i idx(l) = i
l = l+1 l = l+1
endif endif
@ -1024,14 +1024,13 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
d = 0 d = 0
!DEC$ LOOP COUNT MIN(4) !DEC$ LOOP COUNT MIN(4)
do l=1,Nint do l=1,Nint
d = d + 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))) + popcnt(xor( key1(l,2,i), key2(l,2)))
enddo enddo
d = ishft(d,-1) if (d > 4) then
if (d > 2) then
cycle cycle
else else
degree(l) = d degree(l) = ishft(d,-1)
idx(l) = i idx(l) = i
l = l+1 l = l+1
endif endif