mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-07-16 08:00:37 +02:00
Accelerated cache-map access
This commit is contained in:
parent
47b8070339
commit
a4516fb8f9
@ -200,128 +200,88 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
|
|||||||
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
|
||||||
|
|
||||||
|
|
||||||
out_val(1:sze) = 0.d0
|
|
||||||
if (banned_excitation(j,l)) then
|
if (banned_excitation(j,l)) then
|
||||||
return
|
out_val(1:sze) = 0.d0
|
||||||
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ii0 = l-mo_integrals_cache_min
|
if (mo_integrals_cache_min > 1) then
|
||||||
ii0 = ior(ii0, k-mo_integrals_cache_min)
|
|
||||||
ii0 = ior(ii0, j-mo_integrals_cache_min)
|
|
||||||
|
|
||||||
integer :: ii0, ii0_8, ii_8
|
if (do_mo_cholesky) then
|
||||||
ii0_8 = l-mo_integrals_cache_min
|
|
||||||
ii0_8 = ior( shiftl(ii0_8,mo_integrals_cache_shift), k-mo_integrals_cache_min)
|
|
||||||
ii0_8 = ior( shiftl(ii0_8,mo_integrals_cache_shift), j-mo_integrals_cache_min)
|
|
||||||
|
|
||||||
q = min(j,l)
|
call dgemv('T', cholesky_mo_num, mo_integrals_cache_min-1, 1.d0, &
|
||||||
s = max(j,l)
|
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
|
||||||
q = q+shiftr(s*s-s,1)
|
cholesky_mo_transp(1,j,l), 1, 0.d0, &
|
||||||
|
out_val, 1)
|
||||||
|
|
||||||
do i=1,sze
|
|
||||||
if (banned_excitation(i,k)) cycle
|
|
||||||
ii = ior(ii0, i-mo_integrals_cache_min)
|
|
||||||
if (iand(ii, -mo_integrals_cache_size) == 0) then
|
|
||||||
ii_8 = ior( shiftl(ii0_8,mo_integrals_cache_shift), i-mo_integrals_cache_min)
|
|
||||||
out_val(i) = mo_integrals_cache(ii_8)
|
|
||||||
else
|
else
|
||||||
p = min(i,k)
|
|
||||||
r = max(i,k)
|
|
||||||
p = p+shiftr(r*r-r,1)
|
|
||||||
i1 = min(p,q)
|
|
||||||
i2 = max(p,q)
|
|
||||||
idx = i1+shiftr(i2*i2-i2,1)
|
|
||||||
!DIR$ FORCEINLINE
|
|
||||||
call map_get(map,idx,tmp)
|
|
||||||
out_val(i) = dble(tmp)
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! if (banned_excitation(j,l)) then
|
q = min(j,l)
|
||||||
! out_val(1:sze) = 0.d0
|
s = max(j,l)
|
||||||
! return
|
q = q+shiftr(s*s-s,1)
|
||||||
! endif
|
|
||||||
!
|
do i=1,mo_integrals_cache_min-1
|
||||||
! if (mo_integrals_cache_min > 1) then
|
if (banned_excitation(i,k)) then
|
||||||
!
|
out_val(i) = 0.d0
|
||||||
! if (do_mo_cholesky) then
|
cycle
|
||||||
!
|
endif
|
||||||
! call dgemv('T', cholesky_mo_num, mo_integrals_cache_min-1, 1.d0, &
|
p = min(i,k)
|
||||||
! cholesky_mo_transp(1,1,k), cholesky_mo_num, &
|
r = max(i,k)
|
||||||
! cholesky_mo_transp(1,j,l), 1, 0.d0, &
|
p = p+shiftr(r*r-r,1)
|
||||||
! out_val, 1)
|
i1 = min(p,q)
|
||||||
!
|
i2 = max(p,q)
|
||||||
! else
|
idx = i1+shiftr(i2*i2-i2,1)
|
||||||
!
|
!DIR$ FORCEINLINE
|
||||||
! q = min(j,l)
|
call map_get(map,idx,tmp)
|
||||||
! s = max(j,l)
|
out_val(i) = dble(tmp)
|
||||||
! q = q+shiftr(s*s-s,1)
|
enddo
|
||||||
!
|
|
||||||
! do i=1,mo_integrals_cache_min-1
|
endif
|
||||||
! if (banned_excitation(i,k)) then
|
|
||||||
! out_val(i) = 0.d0
|
endif
|
||||||
! cycle
|
|
||||||
! endif
|
|
||||||
! p = min(i,k)
|
ii = l-mo_integrals_cache_min
|
||||||
! r = max(i,k)
|
ii = ior( shiftl(ii, mo_integrals_cache_shift), k-mo_integrals_cache_min)
|
||||||
! p = p+shiftr(r*r-r,1)
|
ii = ior( shiftl(ii, mo_integrals_cache_shift), j-mo_integrals_cache_min)
|
||||||
! i1 = min(p,q)
|
ii = shiftl(ii, mo_integrals_cache_shift)
|
||||||
! i2 = max(p,q)
|
out_val(mo_integrals_cache_min:mo_integrals_cache_max) = &
|
||||||
! idx = i1+shiftr(i2*i2-i2,1)
|
mo_integrals_cache(ii:ii+mo_integrals_cache_max-mo_integrals_cache_min)
|
||||||
! !DIR$ FORCEINLINE
|
|
||||||
! call map_get(map,idx,tmp)
|
if (mo_integrals_cache_max < mo_num) then
|
||||||
! out_val(i) = dble(tmp)
|
|
||||||
! enddo
|
if (do_mo_cholesky) then
|
||||||
!
|
|
||||||
! endif
|
call dgemv('T', cholesky_mo_num, mo_num-mo_integrals_cache_max, 1.d0, &
|
||||||
!
|
cholesky_mo_transp(1,mo_integrals_cache_max+1,k), cholesky_mo_num, &
|
||||||
! endif
|
cholesky_mo_transp(1,j,l), 1, 0.d0, &
|
||||||
!
|
out_val(mo_integrals_cache_max+1), 1)
|
||||||
!
|
|
||||||
! ii = l-mo_integrals_cache_min
|
else
|
||||||
! ii = ior( shiftl(ii, mo_integrals_cache_shift), k-mo_integrals_cache_min)
|
|
||||||
! ii = ior( shiftl(ii, mo_integrals_cache_shift), j-mo_integrals_cache_min)
|
q = min(j,l)
|
||||||
! ii = shiftl(ii, mo_integrals_cache_shift)
|
s = max(j,l)
|
||||||
! do i=mo_integrals_cache_min, mo_integrals_cache_max
|
q = q+shiftr(s*s-s,1)
|
||||||
! ii = ii+1
|
|
||||||
! out_val(i) = mo_integrals_cache(ii)
|
do i=mo_integrals_cache_max+1,mo_num
|
||||||
! enddo
|
if (banned_excitation(i,k)) then
|
||||||
!
|
out_val(i) = 0.d0
|
||||||
!
|
cycle
|
||||||
! if (mo_integrals_cache_max < mo_num) then
|
endif
|
||||||
!
|
p = min(i,k)
|
||||||
! if (do_mo_cholesky) then
|
r = max(i,k)
|
||||||
!
|
p = p+shiftr(r*r-r,1)
|
||||||
! call dgemv('T', cholesky_mo_num, mo_num-mo_integrals_cache_max, 1.d0, &
|
i1 = min(p,q)
|
||||||
! cholesky_mo_transp(1,mo_integrals_cache_max+1,k), cholesky_mo_num, &
|
i2 = max(p,q)
|
||||||
! cholesky_mo_transp(1,j,l), 1, 0.d0, &
|
idx = i1+shiftr(i2*i2-i2,1)
|
||||||
! out_val(mo_integrals_cache_max+1), 1)
|
!DIR$ FORCEINLINE
|
||||||
!
|
call map_get(map,idx,tmp)
|
||||||
! else
|
out_val(i) = dble(tmp)
|
||||||
!
|
enddo
|
||||||
! q = min(j,l)
|
|
||||||
! s = max(j,l)
|
endif
|
||||||
! q = q+shiftr(s*s-s,1)
|
|
||||||
!
|
endif
|
||||||
! do i=mo_integrals_cache_max+1,mo_num
|
|
||||||
! if (banned_excitation(i,k)) then
|
|
||||||
! out_val(i) = 0.d0
|
|
||||||
! cycle
|
|
||||||
! endif
|
|
||||||
! p = min(i,k)
|
|
||||||
! r = max(i,k)
|
|
||||||
! p = p+shiftr(r*r-r,1)
|
|
||||||
! i1 = min(p,q)
|
|
||||||
! i2 = max(p,q)
|
|
||||||
! idx = i1+shiftr(i2*i2-i2,1)
|
|
||||||
! !DIR$ FORCEINLINE
|
|
||||||
! call map_get(map,idx,tmp)
|
|
||||||
! out_val(i) = dble(tmp)
|
|
||||||
! enddo
|
|
||||||
!
|
|
||||||
! endif
|
|
||||||
!
|
|
||||||
! endif
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user