From 03565ea88b6d26173d1d6f922ce23578d638729a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 15 May 2009 17:43:02 +0200 Subject: [PATCH] Small acceleration --- eplf.irp.f | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/eplf.irp.f b/eplf.irp.f index 956d24b..1368039 100644 --- a/eplf.irp.f +++ b/eplf.irp.f @@ -27,16 +27,25 @@ BEGIN_PROVIDER [ double precision, mo_eplf_integral_matrix, (mo_occ_num,mo_occ_n ! Array of all the for EPLF END_DOC integer :: i, j, k, l - double precision :: ao_eplf_integral + PROVIDE ao_eplf_integral_matrix + PROVIDE mo_coef do i=1,mo_occ_num do j=i,mo_occ_num mo_eplf_integral_matrix(j,i) = 0. - do k=1,ao_num - do l=1,ao_num - mo_eplf_integral_matrix(j,i) = mo_eplf_integral_matrix(j,i) + & - mo_coef(k,i)*mo_coef(l,j)*ao_eplf_integral_matrix(k,l) + enddo + + do k=1,ao_num + if (mo_coef(k,i) /= 0.) then + do j=i,mo_occ_num + do l=1,ao_num + mo_eplf_integral_matrix(j,i) = mo_eplf_integral_matrix(j,i) + & + mo_coef(k,i)*mo_coef(l,j)*ao_eplf_integral_matrix(k,l) + enddo enddo - enddo + endif + enddo + + do j=i,mo_occ_num mo_eplf_integral_matrix(i,j) = mo_eplf_integral_matrix(j,i) enddo enddo @@ -58,16 +67,22 @@ END_PROVIDER PROVIDE mo_coef_transp - do j=1,elec_alpha_num - do i=1,elec_alpha_num + do j=1,elec_beta_num + do i=1,elec_beta_num + eplf_up_up = eplf_up_up + 2.d0*mo_value_p(i)* ( & + mo_value_p(i)*mo_eplf_integral_matrix(j,j) - & + mo_value_p(j)*mo_eplf_integral_matrix(i,j) ) + enddo + + do i=elec_beta_num+1,elec_alpha_num eplf_up_up = eplf_up_up + mo_value_p(i)* ( & mo_value_p(i)*mo_eplf_integral_matrix(j,j) - & mo_value_p(j)*mo_eplf_integral_matrix(i,j) ) enddo enddo - do j=1,elec_beta_num - do i=1,elec_beta_num + do j=elec_beta_num+1,elec_alpha_num + do i=1,elec_alpha_num eplf_up_up = eplf_up_up + mo_value_p(i)* ( & mo_value_p(i)*mo_eplf_integral_matrix(j,j) - & mo_value_p(j)*mo_eplf_integral_matrix(i,j) )