scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-11-07 14:43:41 +01:00
Code Issues Releases Wiki Activity

Dgemmized CC

Browse Source
This commit is contained in:
Anthony Scemama 2019-09-23 17:47:55 +02:00
parent e39a069fd5
commit 444ea0206b
2 changed files with 55 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
devel/cc/curly_W.irp.f
View File

@ -8,8 +8,8 @@ BEGIN_PROVIDER [ double precision, cWoooo, (spin_occ_num,spin_occ_num,spin_occ_n
cWoooo(:,:,:,:) = OOOO(:,:,:,:) cWoooo(:,:,:,:) = OOOO(:,:,:,:)
do e=1,spin_vir_num
do j=1,spin_occ_num do j=1,spin_occ_num
do e=1,spin_vir_num
do i=1,spin_occ_num do i=1,spin_occ_num
do n=1,spin_occ_num do n=1,spin_occ_num
do m=1,spin_occ_num do m=1,spin_occ_num
@ -22,21 +22,13 @@ BEGIN_PROVIDER [ double precision, cWoooo, (spin_occ_num,spin_occ_num,spin_occ_n
end do end do
end do end do
double precision :: x call dgemm('N','T', &
do f=1,spin_vir_num spin_occ_num*spin_occ_num, spin_occ_num*spin_occ_num, &
do e=1,spin_vir_num spin_vir_num*spin_vir_num, &
do j=1,spin_occ_num 0.25d0, OOVV, spin_occ_num*spin_occ_num, &
do i=1,spin_occ_num tau_cc, spin_occ_num*spin_occ_num, &
x = 0.25d0*tau_cc(i,j,e,f) 1.d0, cWoooo, spin_occ_num*spin_occ_num)
do n=1,spin_occ_num
do m=1,spin_occ_num
cWoooo(m,n,i,j) = cWoooo(m,n,i,j) + x*OOVV(m,n,e,f)
end do
end do
end do
end do
end do
end do
END_PROVIDER END_PROVIDER
@ -104,36 +96,46 @@ BEGIN_PROVIDER [ double precision, cWvvvv, (spin_vir_num,spin_vir_num,spin_vir_n
integer :: a,b,e,f integer :: a,b,e,f
double precision :: x double precision :: x
cWvvvv(:,:,:,:) = VVVV(:,:,:,:) double precision, allocatable :: mat_A(:,:), mat_C(:,:)
! OMP PRIVATE(mat_A,mat_C,a,b,m,e,f) &
! OMP SHARED(spin_vir_num, spin_occ_num, t1_cc, cWvvvv, OVVV, VVVV)
allocate (mat_A(spin_vir_num, spin_occ_num), mat_C(spin_vir_num,spin_vir_num))
! OMP DO
do f=1,spin_vir_num do f=1,spin_vir_num
do e=1,spin_vir_num do e=1,spin_vir_num
do m=1,spin_occ_num
do a=1,spin_vir_num
mat_A(a,m) = OVVV(m,a,f,e)
enddo
enddo
call dgemm('N','N', &
spin_vir_num, spin_vir_num, spin_occ_num, &
1.d0, mat_A, size(mat_A,1), &
t1_cc, size(t1_cc,1), &
0.d0, mat_C, size(mat_C,1) )
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 m=1,spin_occ_num cWvvvv(a,b,e,f) = VVVV(a,b,e,f) - mat_C(a,b) + mat_C(b,a)
cWvvvv(a,b,e,f) = cWvvvv(a,b,e,f) - t1_cc(m,b)*VOVV(a,m,e,f) + t1_cc(m,a)*VOVV(b,m,e,f)
end do
enddo enddo
enddo enddo
end do end do
end do end do
! OMP END DO
do f=1,spin_vir_num deallocate (mat_A, mat_C)
do e=1,spin_vir_num ! OMP END PARALLEL
do b=1,spin_vir_num
do a=1,spin_vir_num call dgemm('T','N', &
x = 0.d0 spin_vir_num*spin_vir_num, spin_vir_num*spin_vir_num, &
do n=1,spin_occ_num spin_occ_num*spin_occ_num, &
do m=1,spin_occ_num 0.25d0, tau_cc, spin_occ_num*spin_occ_num, &
x = x + tau_cc(m,n,a,b)*OOVV(m,n,e,f) OOVV, spin_occ_num*spin_occ_num, &
end do 1.d0, cWvvvv, spin_vir_num*spin_vir_num)
end do
cWvvvv(a,b,e,f) = cWvvvv(a,b,e,f) + 0.25d0*x
end do
end do
end do
end do
END_PROVIDER END_PROVIDER

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

@ -142,31 +142,6 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
deallocate(tmp,tmp2) deallocate(tmp,tmp2)
allocate( mat_A(spin_vir_num,spin_occ_num), mat_C(spin_occ_num,spin_occ_num) ) allocate( mat_A(spin_vir_num,spin_occ_num), mat_C(spin_occ_num,spin_occ_num) )
!
! do b=1,spin_vir_num
! do a=1,spin_vir_num
!
! do j=1,spin_occ_num
! do e=1,spin_vir_num
! mat_A(e,j) = VVVO(a,b,e,j)
! enddo
! enddo
!
! call dgemm('N', 'N', &
! spin_occ_num, spin_occ_num, spin_vir_num, &
! 1.0d0, t1_cc, spin_occ_num, &
! mat_A, size(mat_A,1), &
! 0.d0, mat_C, spin_occ_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) + mat_C(i,j) - mat_C(j,i)
! enddo
! endd
!
! enddo
! enddo
do b=1,spin_vir_num do b=1,spin_vir_num
do a=1,spin_vir_num do a=1,spin_vir_num
@ -190,20 +165,31 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
end do end do
end do end do
deallocate( mat_A, mat_C )
allocate(tmp (spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num) )
call dgemm('N','N', &
spin_occ_num*spin_occ_num*spin_vir_num, &
spin_vir_num, spin_occ_num, &
1.d0, OOVO, spin_occ_num*spin_occ_num*spin_vir_num, &
t1_cc, spin_occ_num, &
0.d0, tmp, spin_occ_num*spin_occ_num*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 do j=1,spin_occ_num
do i=1,spin_occ_num do i=1,spin_occ_num
do m=1,spin_occ_num r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + tmp(i,j,b,a)
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t1_cc(m,a)*OVOO(m,b,i,j) r2_cc(i,j,b,a) = r2_cc(i,j,b,a) - tmp(i,j,b,a)
r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t1_cc(m,b)*OVOO(m,a,i,j)
end do
end do end do
end do end do
end do end do
end do end do
deallocate(tmp)
! Final expression of the t2 residue ! Final expression of the t2 residue