From 77ca64c612c1775f9416e4ee5d0b15fa4edb9d42 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 17 Dec 2010 11:39:42 +0100 Subject: [PATCH] Acceleration --- src/eplf_function.irp.f | 81 ++++++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 37 deletions(-) diff --git a/src/eplf_function.irp.f b/src/eplf_function.irp.f index 905f19e..4454c22 100644 --- a/src/eplf_function.irp.f +++ b/src/eplf_function.irp.f @@ -97,13 +97,14 @@ END_PROVIDER integer :: k,l,m,n,p,p2 integer :: ik,il,jk,jl double precision :: phase,dtemp(2) - integer :: exc(4) + integer :: exc(4), nactive, nactive2 PROVIDE det PROVIDE elec_num_2 + PROVIDE mo_value_prod_p do k=1,det_num - do l=1,det_num + do l=k,det_num exc(1) = abs(det_exc(k,l,1)) exc(2) = abs(det_exc(k,l,2)) @@ -118,47 +119,49 @@ END_PROVIDER dtemp(1) = 0.d0 dtemp(2) = 0.d0 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) if ( exc(3) == 0 ) then ! Closed-open shell interactions 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) il = det(n,l,p) - dtemp(1) += mo_value_p(ik)* ( & - mo_value_p(il)*mo_eplf_integral_matrix(j,j) - & - mo_value_p(j)*mo_eplf_integral_matrix(j,il) ) - dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(j,j) + 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,elec_num_2(p)-mo_closed_num + do m=1,nactive jk = det(m,k,p) jl = det(m,l,p) do i=1,mo_closed_num - dtemp(1) += mo_value_p(i)* ( & - mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) - & - mo_value_p(jl)*mo_eplf_integral_matrix(jk,i) ) - dtemp(2) += mo_value_p(i)*mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) + 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,elec_num_2(p)-mo_closed_num + do m=1,nactive jk = det(m,k,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) il = det(n,l,p) - dtemp(1) += mo_value_p(ik)* ( & - mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - & - mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) ) + 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,elec_num_2(p2)-mo_closed_num + do n=1,nactive2 ik = det(n,k,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 @@ -169,32 +172,32 @@ END_PROVIDER !- Open-closed shell interactions do j=1,mo_closed_num - dtemp(1) += mo_value_p(ik)* ( & - mo_value_p(il)*mo_eplf_integral_matrix(j,j) - & - mo_value_p(j)*mo_eplf_integral_matrix(j,il) ) - dtemp(2) += mo_value_p(ik)*mo_value_p(il)*mo_eplf_integral_matrix(j,j) + 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 - dtemp(1) += mo_value_p(i)* ( & - mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) - & - mo_value_p(jl)*mo_eplf_integral_matrix(jk,i) ) - dtemp(2) += mo_value_p(i)*mo_value_p(i)*mo_eplf_integral_matrix(jk,jl) + 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 !- Open-open shell interactions - do m=1,elec_num_2(p)-mo_closed_num + do m=1,nactive jk = det(m,k,p) jl = det(m,l,p) - dtemp(1) += mo_value_p(ik)* ( & - mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - & - mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) ) + 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 m=1,elec_num_2(p2)-mo_closed_num + do m=1,nactive2 jk = det(m,k,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 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 call get_double_excitation(k,l,ik,il,jk,jl,p) - dtemp(1) += mo_value_p(ik)* ( & - mo_value_p(il)*mo_eplf_integral_matrix(jk,jl) - & - mo_value_p(jl)*mo_eplf_integral_matrix(jk,il) ) + 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) ) 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,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 enddo @@ -220,6 +223,10 @@ END_PROVIDER phase = dble(exc(4)) eplf_up_up += phase * det_coef(k)*det_coef(l) * dtemp(1) 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