mirror of
https://gitlab.com/scemama/eplf
synced 2024-10-31 19:23:55 +01:00
Acceleration
This commit is contained in:
parent
921e8429cd
commit
77ca64c612
@ -97,13 +97,14 @@ END_PROVIDER
|
|||||||
integer :: k,l,m,n,p,p2
|
integer :: k,l,m,n,p,p2
|
||||||
integer :: ik,il,jk,jl
|
integer :: ik,il,jk,jl
|
||||||
double precision :: phase,dtemp(2)
|
double precision :: phase,dtemp(2)
|
||||||
integer :: exc(4)
|
integer :: exc(4), nactive, nactive2
|
||||||
|
|
||||||
PROVIDE det
|
PROVIDE det
|
||||||
PROVIDE elec_num_2
|
PROVIDE elec_num_2
|
||||||
|
PROVIDE mo_value_prod_p
|
||||||
|
|
||||||
do k=1,det_num
|
do k=1,det_num
|
||||||
do l=1,det_num
|
do l=k,det_num
|
||||||
|
|
||||||
exc(1) = abs(det_exc(k,l,1))
|
exc(1) = abs(det_exc(k,l,1))
|
||||||
exc(2) = abs(det_exc(k,l,2))
|
exc(2) = abs(det_exc(k,l,2))
|
||||||
@ -118,47 +119,49 @@ END_PROVIDER
|
|||||||
dtemp(1) = 0.d0
|
dtemp(1) = 0.d0
|
||||||
dtemp(2) = 0.d0
|
dtemp(2) = 0.d0
|
||||||
do p=1,2
|
do p=1,2
|
||||||
|
nactive = elec_num_2(p) -mo_closed_num
|
||||||
|
nactive2 = elec_num_2(p2)-mo_closed_num
|
||||||
p2 = 1+mod(p,2)
|
p2 = 1+mod(p,2)
|
||||||
if ( exc(3) == 0 ) then
|
if ( exc(3) == 0 ) then
|
||||||
! Closed-open shell interactions
|
! Closed-open shell interactions
|
||||||
do j=1,mo_closed_num
|
do j=1,mo_closed_num
|
||||||
do n=1,elec_num_2(p)-mo_closed_num
|
do n=1,nactive
|
||||||
ik = det(n,k,p)
|
ik = det(n,k,p)
|
||||||
il = det(n,l,p)
|
il = det(n,l,p)
|
||||||
dtemp(1) += mo_value_p(ik)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(il)*mo_eplf_integral_matrix(j,j) - &
|
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j) - &
|
||||||
mo_value_p(j)*mo_eplf_integral_matrix(j,il) )
|
mo_value_prod_p(j,ik)*mo_eplf_integral_matrix(j,il) )
|
||||||
dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(j,j)
|
dtemp(2) += mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!- Open-closed shell interactions
|
!- Open-closed shell interactions
|
||||||
do m=1,elec_num_2(p)-mo_closed_num
|
do m=1,nactive
|
||||||
jk = det(m,k,p)
|
jk = det(m,k,p)
|
||||||
jl = det(m,l,p)
|
jl = det(m,l,p)
|
||||||
do i=1,mo_closed_num
|
do i=1,mo_closed_num
|
||||||
dtemp(1) += mo_value_p(i)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) - &
|
mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk) - &
|
||||||
mo_value_p(jl)*mo_eplf_integral_matrix(jk,i) )
|
mo_value_prod_p(i,jl)*mo_eplf_integral_matrix(i,jk) )
|
||||||
dtemp(2) += mo_value_p(i)*mo_value_p(i)*mo_eplf_integral_matrix(jk,jl)
|
dtemp(2) += mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!- Open-open shell interactions
|
!- Open-open shell interactions
|
||||||
do m=1,elec_num_2(p)-mo_closed_num
|
do m=1,nactive
|
||||||
jk = det(m,k,p)
|
jk = det(m,k,p)
|
||||||
jl = det(m,l,p)
|
jl = det(m,l,p)
|
||||||
do n=1,elec_num_2(p)-mo_closed_num
|
do n=1,nactive
|
||||||
ik = det(n,k,p)
|
ik = det(n,k,p)
|
||||||
il = det(n,l,p)
|
il = det(n,l,p)
|
||||||
dtemp(1) += mo_value_p(ik)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - &
|
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(jl,jk) - &
|
||||||
mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) )
|
mo_value_prod_p(jl,ik)*mo_eplf_integral_matrix(il,jk) )
|
||||||
enddo
|
enddo
|
||||||
do n=1,elec_num_2(p2)-mo_closed_num
|
do n=1,nactive2
|
||||||
ik = det(n,k,p2)
|
ik = det(n,k,p2)
|
||||||
il = det(n,l,p2)
|
il = det(n,l,p2)
|
||||||
dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(jk,jl)
|
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(jl,jk)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -169,32 +172,32 @@ END_PROVIDER
|
|||||||
|
|
||||||
!- Open-closed shell interactions
|
!- Open-closed shell interactions
|
||||||
do j=1,mo_closed_num
|
do j=1,mo_closed_num
|
||||||
dtemp(1) += mo_value_p(ik)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(il)*mo_eplf_integral_matrix(j,j) - &
|
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j) - &
|
||||||
mo_value_p(j)*mo_eplf_integral_matrix(j,il) )
|
mo_value_prod_p(j,ik)*mo_eplf_integral_matrix(j,il) )
|
||||||
dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(j,j)
|
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(j,j)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!- Closed-open shell interactions
|
!- Closed-open shell interactions
|
||||||
do i=1,mo_closed_num
|
do i=1,mo_closed_num
|
||||||
dtemp(1) += mo_value_p(i)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) - &
|
mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk) - &
|
||||||
mo_value_p(jl)*mo_eplf_integral_matrix(jk,i) )
|
mo_value_prod_p(i,jl)*mo_eplf_integral_matrix(i,jk) )
|
||||||
dtemp(2) += mo_value_p(i)*mo_value_p(i)*mo_eplf_integral_matrix(jk,jl)
|
dtemp(2) += mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!- Open-open shell interactions
|
!- Open-open shell interactions
|
||||||
do m=1,elec_num_2(p)-mo_closed_num
|
do m=1,nactive
|
||||||
jk = det(m,k,p)
|
jk = det(m,k,p)
|
||||||
jl = det(m,l,p)
|
jl = det(m,l,p)
|
||||||
dtemp(1) += mo_value_p(ik)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - &
|
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(jl,jk) - &
|
||||||
mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) )
|
mo_value_prod_p(jl,ik)*mo_eplf_integral_matrix(il,jk) )
|
||||||
enddo
|
enddo
|
||||||
do m=1,elec_num_2(p2)-mo_closed_num
|
do m=1,nactive2
|
||||||
jk = det(m,k,p2)
|
jk = det(m,k,p2)
|
||||||
jl = det(m,l,p2)
|
jl = det(m,l,p2)
|
||||||
dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(jk,jl)
|
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(jl,jk)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else if ( (exc(3) == 2).and.(exc(p) == 2) ) then
|
else if ( (exc(3) == 2).and.(exc(p) == 2) ) then
|
||||||
@ -202,9 +205,9 @@ END_PROVIDER
|
|||||||
! Consider only the double excitations of same-spin electrons
|
! Consider only the double excitations of same-spin electrons
|
||||||
call get_double_excitation(k,l,ik,il,jk,jl,p)
|
call get_double_excitation(k,l,ik,il,jk,jl,p)
|
||||||
|
|
||||||
dtemp(1) += mo_value_p(ik)* ( &
|
dtemp(1) += ( &
|
||||||
mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - &
|
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(jl,jk) - &
|
||||||
mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) )
|
mo_value_prod_p(jl,ik)*mo_eplf_integral_matrix(il,jk) )
|
||||||
|
|
||||||
else if ( (exc(3) == 2).and.(exc(p) == 1) ) then
|
else if ( (exc(3) == 2).and.(exc(p) == 1) ) then
|
||||||
|
|
||||||
@ -212,7 +215,7 @@ END_PROVIDER
|
|||||||
call get_single_excitation(k,l,ik,il,p)
|
call get_single_excitation(k,l,ik,il,p)
|
||||||
call get_single_excitation(k,l,jk,jl,p2)
|
call get_single_excitation(k,l,jk,jl,p2)
|
||||||
|
|
||||||
dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(jk,jl)
|
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(jl,jk)
|
||||||
|
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -220,6 +223,10 @@ END_PROVIDER
|
|||||||
phase = dble(exc(4))
|
phase = dble(exc(4))
|
||||||
eplf_up_up += phase * det_coef(k)*det_coef(l) * dtemp(1)
|
eplf_up_up += phase * det_coef(k)*det_coef(l) * dtemp(1)
|
||||||
eplf_up_dn += phase * det_coef(k)*det_coef(l) * dtemp(2)
|
eplf_up_dn += phase * det_coef(k)*det_coef(l) * dtemp(2)
|
||||||
|
if (k /= l) then
|
||||||
|
eplf_up_up += phase * det_coef(k)*det_coef(l) * dtemp(1)
|
||||||
|
eplf_up_dn += phase * det_coef(k)*det_coef(l) * dtemp(2)
|
||||||
|
endif
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
Loading…
Reference in New Issue
Block a user