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

Small acceleration

This commit is contained in:
Anthony Scemama 2009-05-15 17:43:02 +02:00
parent 79949f7bca
commit 03565ea88b
1 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
eplf.irp.f
View File

@ -27,16 +27,25 @@ BEGIN_PROVIDER [ double precision, mo_eplf_integral_matrix, (mo_occ_num,mo_occ_n
! Array of all the <chi_i chi_j | exp(-gamma r^2)> 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) )