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

Accelerated bitstring_to_list_ab

Browse Source
This commit is contained in:
Anthony Scemama 2015-11-21 00:32:58 +01:00
parent a3e12f3d33
commit 17b45ba194
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -370,17 +370,17 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint)
do i=1,Nint do i=1,Nint
l = string(i,1) l = string(i,1)
do while (l /= 0_bit_kind) do while (l /= 0_bit_kind)
n_elements(1) = n_elements(1)+1
j = trailz(l) j = trailz(l)
list(n_elements(1),1) = ishift+j n_elements(1) = n_elements(1)+1
l = ibclr(l,j) l = ibclr(l,j)
list(n_elements(1),1) = ishift+j
enddo enddo
l = string(i,2) l = string(i,2)
do while (l /= 0_bit_kind) do while (l /= 0_bit_kind)
n_elements(2) = n_elements(2)+1
j = trailz(l) j = trailz(l)
list(n_elements(2),2) = ishift+j n_elements(2) = n_elements(2)+1
l = ibclr(l,j) l = ibclr(l,j)
list(n_elements(2),2) = ishift+j
enddo enddo
ishift = ishift + bit_kind_size ishift = ishift + bit_kind_size
enddo enddo
@ -1340,6 +1340,7 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb)
integer :: occ(Nint*bit_kind_size,2) integer :: occ(Nint*bit_kind_size,2)
integer :: other_spin integer :: other_spin
integer :: k,l,i integer :: k,l,i
integer :: tmp(2)
ASSERT (iorb > 0) ASSERT (iorb > 0)
ASSERT (ispin > 0) ASSERT (ispin > 0)
@ -1353,19 +1354,19 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb)
other_spin = iand(ispin,1)+1 other_spin = iand(ispin,1)+1
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call get_occ_from_key(key,occ,Nint) call bitstring_to_list_ab(key, occ, tmp, Nint)
na -= 1 na = na-1
hjj -= mo_mono_elec_integral(iorb,iorb) hjj = hjj - mo_mono_elec_integral(iorb,iorb)
! Same spin ! Same spin
do i=1,na do i=1,na
hjj -= mo_bielec_integral_jj_anti(occ(i,ispin),iorb) hjj = hjj - mo_bielec_integral_jj_anti(occ(i,ispin),iorb)
enddo enddo
! Opposite spin ! Opposite spin
do i=1,nb do i=1,nb
hjj -= mo_bielec_integral_jj(occ(i,other_spin),iorb) hjj = hjj - mo_bielec_integral_jj(occ(i,other_spin),iorb)
enddo enddo
end end
@ -1403,18 +1404,18 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb)
key(k,ispin) = ibset(key(k,ispin),l) key(k,ispin) = ibset(key(k,ispin),l)
other_spin = iand(ispin,1)+1 other_spin = iand(ispin,1)+1
hjj += mo_mono_elec_integral(iorb,iorb) hjj = hjj + mo_mono_elec_integral(iorb,iorb)
! Same spin ! Same spin
do i=1,na do i=1,na
hjj += mo_bielec_integral_jj_anti(occ(i,ispin),iorb) hjj = hjj + mo_bielec_integral_jj_anti(occ(i,ispin),iorb)
enddo enddo
! Opposite spin ! Opposite spin
do i=1,nb do i=1,nb
hjj += mo_bielec_integral_jj(occ(i,other_spin),iorb) hjj = hjj + mo_bielec_integral_jj(occ(i,other_spin),iorb)
enddo enddo
na += 1 na = na+1
end end
subroutine get_occ_from_key(key,occ,Nint) subroutine get_occ_from_key(key,occ,Nint)