BEGIN_PROVIDER [ double precision, cWoooo, (spin_occ_num,spin_occ_num,spin_occ_num,spin_occ_num) ] implicit none BEGIN_DOC ! Curly W in occ-occ-occ-occ block END_DOC integer :: i,j,m,n integer :: a,b,e,f cWoooo(:,:,:,:) = OOOO(:,:,:,:) do j=1,spin_occ_num do e=1,spin_vir_num do i=1,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) + & t1_cc(j,e)*OOOV(m,n,i,e) - & t1_cc(i,e)*OOOV(m,n,j,e) end do end do end do end do end do call dgemm('N','T', & spin_occ_num*spin_occ_num, spin_occ_num*spin_occ_num, & spin_vir_num*spin_vir_num, & 0.25d0, OOVV, spin_occ_num*spin_occ_num, & tau_cc, spin_occ_num*spin_occ_num, & 1.d0, cWoooo, spin_occ_num*spin_occ_num) END_PROVIDER BEGIN_PROVIDER [ double precision, cWovvo, (spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num) ] implicit none BEGIN_DOC ! Curly W in occ-vir-vir-occ block END_DOC integer :: i,j,m,n integer :: a,b,e,f double precision :: x cWovvo(:,:,:,:) = OVVO(:,:,:,:) call dgemm('N','T', & spin_occ_num*spin_vir_num*spin_vir_num, spin_occ_num, spin_vir_num, & 1.d0, OVVV, spin_occ_num*spin_vir_num*spin_vir_num, & t1_cc, spin_occ_num, & 1.d0, cWovvo, spin_occ_num*spin_vir_num*spin_vir_num) do j=1,spin_occ_num do e=1,spin_vir_num call dgemm('N','N', & spin_occ_num, spin_vir_num, spin_occ_num, & -1.d0, OOVO(1,1,e,j), spin_occ_num, & t1_cc, spin_occ_num, & 1.d0, cWovvo(1,1,e,j), spin_occ_num) end do end do double precision, allocatable :: tmp(:,:,:) allocate ( tmp(spin_occ_num,spin_vir_num,spin_vir_num) ) do j=1,spin_occ_num do f=1,spin_vir_num do b=1,spin_vir_num do n=1,spin_occ_num tmp(n,b,f) = - 0.5d0*t2_cc(j,n,f,b) - t1_cc(j,f)*t1_cc(n,b) enddo enddo enddo do f=1,spin_vir_num do e=1,spin_vir_num call dgemm('N','N', & spin_occ_num, spin_vir_num, spin_occ_num, & 1.d0, OOVV(1,1,e,f), spin_occ_num, & tmp(1,1,f), spin_occ_num, & 1.d0, cWovvo(1,1,e,j), spin_occ_num) enddo enddo enddo END_PROVIDER BEGIN_PROVIDER [ double precision, cWovvo_prime, (spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num) ] implicit none BEGIN_DOC ! Curly W in occ-vir-vir-occ block END_DOC integer :: m,b,e,j do j=1,spin_occ_num do b=1,spin_vir_num do e=1,spin_vir_num do m=1,spin_occ_num cWovvo_prime(m,e,b,j) = cWovvo(m,b,e,j) end do end do end do end do END_PROVIDER BEGIN_PROVIDER [ double precision, cWvvvv, (spin_vir_num,spin_vir_num,spin_vir_num,spin_vir_num) ] implicit none BEGIN_DOC ! Curly W in vir-vir-vir-vir block END_DOC integer :: i,j,m,n integer :: a,b,e,f double precision :: x 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 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 a=1,spin_vir_num cWvvvv(a,b,e,f) = VVVV(a,b,e,f) - mat_C(a,b) + mat_C(b,a) enddo enddo end do end do ! OMP END DO deallocate (mat_A, mat_C) ! OMP END PARALLEL call dgemm('T','N', & spin_vir_num*spin_vir_num, spin_vir_num*spin_vir_num, & spin_occ_num*spin_occ_num, & 0.25d0, tau_cc, spin_occ_num*spin_occ_num, & OOVV, spin_occ_num*spin_occ_num, & 1.d0, cWvvvv, spin_vir_num*spin_vir_num) END_PROVIDER