LCPQ/eplf
10
0
Fork 0
mirror of https://gitlab.com/scemama/eplf synced 2024-12-22 12:23:50 +01:00
Code Issues Releases Wiki Activity

Acceleration

Browse Source
This commit is contained in:
Anthony Scemama 2010-12-17 12:03:50 +01:00
parent a982d23987
commit 6dfe81c8bc
2 changed files with 28 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/det.irp.f
View File

@ -100,14 +100,7 @@ BEGIN_PROVIDER [ integer*1, det_exc, (det_num, det_num, 2) ]
endif
enddo
det_exc(k,l,p) *= (1-2*mod( nperm, 2 ))
enddo
enddo
enddo
do p=1,2
do l=1,det_num
do k=1,l-1
det_exc(k,l,p) = det_exc(l,k,p)
det_exc(l,k,p) = det_exc(k,l,p)
enddo
enddo
enddo

46
src/eplf_function.irp.f
View File

@ -123,46 +123,38 @@ END_PROVIDER
nact = elec_num_2(p) -mo_closed_num
nact2 = elec_num_2(p2)-mo_closed_num
if ( exc(3) == 0 ) then
! Closed-open shell interactions
do j=1,mo_closed_num
do n=1,nact
ik = det(n,k,p)
il = det(n,l,p)
jk = det(n,k,p)
jl = det(n,l,p)
do i=1,mo_closed_num
! Closed-open shell interactions
dtemp(1) += ( &
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j) - &
mo_value_prod_p(j,ik)*mo_eplf_integral_matrix(j,il) )
dtemp(2) += mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j)
enddo
enddo
mo_value_prod_p(jl,jk)*mo_eplf_integral_matrix(i,i) - &
mo_value_prod_p(i,jk)*mo_eplf_integral_matrix(i,jl) )
dtemp(2) += mo_value_prod_p(jl,jk)*mo_eplf_integral_matrix(i,i)
!- Open-closed shell interactions
do m=1,nact
jk = det(m,k,p)
jl = det(m,l,p)
do i=1,mo_closed_num
dtemp(1) += ( &
mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk) - &
mo_value_prod_p(i,jl)*mo_eplf_integral_matrix(i,jk) )
dtemp(2) += mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk)
enddo
enddo
!- Open-open shell interactions
do m=1,nact
jk = det(m,k,p)
jl = det(m,l,p)
do n=1,nact
ik = det(n,k,p)
il = det(n,l,p)
ik = det(m,k,p)
il = det(m,l,p)
dtemp(1) += ( &
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(jl,jk) - &
mo_value_prod_p(jl,ik)*mo_eplf_integral_matrix(il,jk) )
enddo
do n=1,nact2
ik = det(n,k,p2)
il = det(n,l,p2)
do m=1,nact2
ik = det(m,k,p2)
il = det(m,l,p2)
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(jl,jk)
enddo
enddo
else if ( (exc(3) == 1).and.(exc(p) == 1) ) then
@ -170,16 +162,14 @@ END_PROVIDER
! Sum over only the sigma-sigma interactions involving the excitation
call get_single_excitation(k,l,ik,il,p)
do i=1,mo_closed_num
!- Open-closed shell interactions
do j=1,mo_closed_num
dtemp(1) += ( &
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(j,j) - &
mo_value_prod_p(j,ik)*mo_eplf_integral_matrix(j,il) )
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(j,j)
enddo
mo_value_prod_p(il,ik)*mo_eplf_integral_matrix(i,i) - &
mo_value_prod_p(i,ik)*mo_eplf_integral_matrix(i,il) )
dtemp(2) += mo_value_prod_p(ik,il)*mo_eplf_integral_matrix(i,i)
!- Closed-open shell interactions
do i=1,mo_closed_num
dtemp(1) += ( &
mo_value_prod_p(i,i)*mo_eplf_integral_matrix(jl,jk) - &
mo_value_prod_p(i,jl)*mo_eplf_integral_matrix(i,jk) )