LCPQ
/
eplf
mirror of https://gitlab.com/scemama/eplf
10
0
Fork 0
Code Issues Releases Wiki Activity

Acceleration

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 endif
enddo enddo
det_exc(k,l,p) *= (1-2*mod( nperm, 2 )) det_exc(k,l,p) *= (1-2*mod( nperm, 2 ))
enddo det_exc(l,k,p) = det_exc(k,l,p)
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)
enddo enddo
enddo enddo
enddo enddo

64
src/eplf_function.irp.f
View File

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