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

Optimized r1_cc

Browse Source
This commit is contained in:
Anthony Scemama 2019-09-23 18:35:53 +02:00
parent 444ea0206b
commit dc915d31d7
1 changed files with 44 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
devel/cc/r1_cc.irp.f
View File

@ -9,47 +9,56 @@ BEGIN_PROVIDER [ double precision, r1_cc, (spin_occ_num,spin_vir_num) ]
r1_cc(:,:) = spin_fock_matrix_mo_ov(:,:) r1_cc(:,:) = spin_fock_matrix_mo_ov(:,:)
do i=1,spin_occ_num call dgemm('N','T', &
do a=1,spin_vir_num spin_occ_num, spin_vir_num, spin_vir_num, &
1.d0, t1_cc, size(t1_cc,1), &
c_spin_fock_matrix_mo_vv, size(c_spin_fock_matrix_mo_vv,1), &
1.d0, r1_cc, size(r1_cc,1))
do e=1,spin_vir_num call dgemm('T','N', &
r1_cc(i,a) = r1_cc(i,a) + t1_cc(i,e)*c_spin_fock_matrix_mo_vv(a,e) spin_occ_num, spin_vir_num, spin_occ_num, &
end do -1.d0, c_spin_fock_matrix_mo_oo, size(c_spin_fock_matrix_mo_oo,1),&
t1_cc, size(t1_cc,1), &
1.d0, r1_cc, size(r1_cc,1))
do m=1,spin_occ_num
r1_cc(i,a) = r1_cc(i,a) - t1_cc(m,a)*c_spin_fock_matrix_mo_oo(m,i)
end do
do m=1,spin_occ_num call dgemv('T', spin_occ_num*spin_vir_num, &
do e=1,spin_vir_num spin_occ_num*spin_vir_num, &
r1_cc(i,a) = r1_cc(i,a) + t2_cc(i,m,a,e)*c_spin_fock_matrix_mo_ov(m,e) 1.d0, t2_cc2, spin_occ_num*spin_vir_num, &
end do c_spin_fock_matrix_mo_ov, 1, &
end do 1.d0, r1_cc, 1)
do n=1,spin_occ_num
do f=1,spin_vir_num do f=1,spin_vir_num
do a=1,spin_vir_num
do i=1,spin_occ_num
do n=1,spin_occ_num
r1_cc(i,a) = r1_cc(i,a) - t1_cc(n,f)*OVOV(n,a,i,f) r1_cc(i,a) = r1_cc(i,a) - t1_cc(n,f)*OVOV(n,a,i,f)
end do end do
end do end do
end do
end do
call dgemv('T', spin_occ_num*spin_vir_num, &
spin_occ_num*spin_vir_num, &
-1.d0, OVOV, spin_occ_num*spin_vir_num, &
t1_cc, 1, &
1.d0, r1_cc, 1)
do m=1,spin_occ_num
do e=1,spin_vir_num do e=1,spin_vir_num
do f=1,spin_vir_num do f=1,spin_vir_num
r1_cc(i,a) = r1_cc(i,a) - 0.5d0*t2_cc(i,m,e,f)*OVVV(m,a,e,f) call dgemm('N','N', &
end do spin_occ_num, spin_vir_num, spin_occ_num, &
end do -0.5d0, t2_cc(1,1,e,f), spin_occ_num, &
end do OVVV(1,1,e,f), spin_occ_num, &
1.d0, r1_cc, spin_occ_num)
enddo
enddo
do m=1,spin_occ_num call dgemm('T','N', &
do n=1,spin_occ_num spin_occ_num, spin_vir_num, spin_occ_num*spin_occ_num*spin_vir_num, &
do e=1,spin_vir_num -0.5d0, OOVO, spin_occ_num*spin_occ_num*spin_vir_num, &
r1_cc(i,a) = r1_cc(i,a) - 0.5d0*t2_cc(m,n,a,e)*OOVO(n,m,e,i) t2_cc, spin_occ_num*spin_occ_num*spin_vir_num, &
end do 1.d0, r1_cc, spin_occ_num)
end do
end do
end do
end do
! Final expression for t1 residue ! Final expression for t1 residue