scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-08-30 07:53:39 +02:00
Code Issues Releases Wiki Activity

Optimizing r2_cc

Browse Source
This commit is contained in:
Anthony Scemama 2019-09-17 23:25:40 +02:00
parent 1fa7c93458
commit 1a10877cdd
2 changed files with 77 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
devel/cc/curly_Fock.irp.f
View File

@ -3,14 +3,17 @@ BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo, (spin_occ_num,spin_
BEGIN_DOC BEGIN_DOC
! Curly F in Occupied-Occupied block ! Curly F in Occupied-Occupied block
END_DOC END_DOC
double precision,external :: Kronecker_Delta
integer :: i,j,m,n integer :: i,j,m,n
integer :: a,b,e,f integer :: a,b,e,f
do m=1,spin_occ_num do m=1,spin_occ_num
do i=1,spin_occ_num do i=1,spin_occ_num
c_spin_fock_matrix_mo_oo(m,i) = (1d0 - Kronecker_delta(m,i))*spin_fock_matrix_mo_oo(m,i) if (m /= i) then
c_spin_fock_matrix_mo_oo(m,i) = spin_fock_matrix_mo_oo(m,i)
else
c_spin_fock_matrix_mo_oo(m,i) = 0.d0
endif
do e=1,spin_vir_num do e=1,spin_vir_num
c_spin_fock_matrix_mo_oo(m,i) = c_spin_fock_matrix_mo_oo(m,i) + 0.5d0*t1_cc(i,e)*spin_fock_matrix_mo_ov(m,e) c_spin_fock_matrix_mo_oo(m,i) = c_spin_fock_matrix_mo_oo(m,i) + 0.5d0*t1_cc(i,e)*spin_fock_matrix_mo_ov(m,e)
@ -68,14 +71,17 @@ BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_vv, (spin_vir_num,spin_
! Curly F in Occupied-Virtual block ! Curly F in Occupied-Virtual block
END_DOC END_DOC
double precision,external :: Kronecker_Delta
integer :: i,j,m,n integer :: i,j,m,n
integer :: a,b,e,f integer :: a,b,e,f
do a=1,spin_vir_num do a=1,spin_vir_num
do e=1,spin_vir_num do e=1,spin_vir_num
c_spin_fock_matrix_mo_vv(a,e) = (1d0 - Kronecker_delta(a,e))*spin_fock_matrix_mo_vv(a,e) if (a /= e) then
c_spin_fock_matrix_mo_vv(a,e) = spin_fock_matrix_mo_vv(a,e)
else
c_spin_fock_matrix_mo_vv(a,e) = 0.d0
endif
do m=1,spin_occ_num do m=1,spin_occ_num
c_spin_fock_matrix_mo_vv(a,e) = c_spin_fock_matrix_mo_vv(a,e) - 0.5d0*t1_cc(m,a)*spin_fock_matrix_mo_ov(m,e) c_spin_fock_matrix_mo_vv(a,e) = c_spin_fock_matrix_mo_vv(a,e) - 0.5d0*t1_cc(m,a)*spin_fock_matrix_mo_ov(m,e)

71
devel/cc/r2_cc.irp.f
View File

@ -6,84 +6,37 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
integer :: i,j,m,n integer :: i,j,m,n
integer :: a,b,e,f integer :: a,b,e,f
double precision :: x double precision :: x
double precision, allocatable :: tmp_oo(:,:), tmp_oo2(:,:)
allocate ( tmp_oo(spin_occ_num,spin_occ_num) )
r2_cc(:,:,:,:) = OOVV(:,:,:,:) r2_cc(:,:,:,:) = OOVV(:,:,:,:)
do e=1,spin_vir_num do e=1,spin_vir_num
do b=1,spin_vir_num do b=1,spin_vir_num
do a=1,spin_vir_num do a=1,spin_vir_num
do j=1,spin_occ_num if (a == b) cycle
do i=1,spin_occ_num tmp_oo(:,:) = c_spin_fock_matrix_mo_vv(b,e) * t2_cc(:,:,a,e)
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t2_cc(i,j,a,e)*c_spin_fock_matrix_mo_vv(b,e)
end do
end do
end do
end do
end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(i,j,b,e)*c_spin_fock_matrix_mo_vv(a,e)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do e=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
x = 0.5d0*t2_cc(i,j,a,e)
if (x /= 0.d0) then
do m=1,spin_occ_num do m=1,spin_occ_num
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - x*t1_cc(m,b)*c_spin_fock_matrix_mo_ov(m,e) x = 0.5d0 * t1_cc(m,b) * c_spin_fock_matrix_mo_ov(m,e)
end do if (x == 0.d0) cycle
endif tmp_oo(:,:) = tmp_oo(:,:) - t2_cc(:,:,a,e)*x
end do
end do
end do
enddo enddo
r2_cc(:,:,a,b) = r2_cc(:,:,a,b) + tmp_oo(:,:)
r2_cc(:,:,b,a) = r2_cc(:,:,b,a) - tmp_oo(:,:)
end do end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
x = 0.5d0*t2_cc(i,j,b,e)
if (x /= 0.d0) then
do m=1,spin_occ_num do m=1,spin_occ_num
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + x*t1_cc(m,a)*c_spin_fock_matrix_mo_ov(m,e)
end do
endif
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num do j=1,spin_occ_num
do m=1,spin_occ_num
x = c_spin_fock_matrix_mo_oo(m,j) x = c_spin_fock_matrix_mo_oo(m,j)
do i=1,spin_occ_num r2_cc(:,j,b,e) = r2_cc(:,j,b,e) - t2_cc(:,m,b,e)*x
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(i,m,a,b)*x
end do
end do end do
end do end do
end do end do
end do end do
do b=1,spin_vir_num do b=1,spin_vir_num
do a=1,spin_vir_num do a=1,spin_vir_num
do j=1,spin_occ_num do j=1,spin_occ_num