qp_plugins_scemama/deprecated/cc/curly_Fock.irp.f

133 lines
3.7 KiB
Fortran

BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo, (spin_occ_num,spin_occ_num) ]
implicit none
BEGIN_DOC
! Curly F in Occupied-Occupied block
END_DOC
integer :: i,j,m,n
integer :: a,b,e,f
do i=1,spin_occ_num
do m=1,spin_occ_num
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
end do
end do
do e=1,spin_vir_num
do i=1,spin_occ_num
do n=1,spin_occ_num
do m=1,spin_occ_num
c_spin_fock_matrix_mo_oo(m,i) = c_spin_fock_matrix_mo_oo(m,i) +&
OOOV(m,n,i,e) * t1_cc(n,e)
end do
end do
end do
end do
call dgemm('N','T', &
spin_occ_num, spin_occ_num, spin_vir_num, &
0.5d0, spin_fock_matrix_mo_ov, spin_occ_num, &
t1_cc, spin_occ_num, &
1.d0, c_spin_fock_matrix_mo_oo, spin_occ_num)
call dgemm('N','T', &
spin_occ_num, spin_occ_num, spin_vir_num*spin_occ_num*spin_vir_num,&
0.5d0, OOVV, spin_occ_num, &
taus, spin_occ_num, &
1.d0, c_spin_fock_matrix_mo_oo, spin_occ_num)
END_PROVIDER
BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo_transp, (spin_occ_num,spin_occ_num) ]
implicit none
BEGIN_DOC
! Transpose of c_spin_fock_matrix_mo_oo
END_DOC
integer :: i,j
do i=1,spin_occ_num
do j=1,spin_occ_num
c_spin_fock_matrix_mo_oo_transp(j,i) = c_spin_fock_matrix_mo_oo(i,j)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_ov, (spin_occ_num,spin_vir_num) ]
implicit none
BEGIN_DOC
! Curly F in Occupied-Virtual block
END_DOC
integer :: i,j,m,n
integer :: a,b,e,f
c_spin_fock_matrix_mo_ov(:,:) = spin_fock_matrix_mo_ov(:,:)
do m=1,spin_occ_num
do e=1,spin_vir_num
do n=1,spin_occ_num
do f=1,spin_vir_num
c_spin_fock_matrix_mo_ov(m,e) = c_spin_fock_matrix_mo_ov(m,e) + t1_cc(n,f)*OOVV(m,n,e,f)
end do
end do
end do
end do
END_PROVIDER
BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_vv, (spin_vir_num,spin_vir_num) ]
implicit none
BEGIN_DOC
! Curly F in Occupied-Virtual block
END_DOC
integer :: i,j,m,n
integer :: a,b,e,f
do a=1,spin_vir_num
do e=1,spin_vir_num
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
end do
end do
call dgemm('T','N', &
spin_vir_num, spin_vir_num, spin_occ_num, &
-0.5d0, t1_cc, size(t1_cc,1), &
spin_fock_matrix_mo_ov, size(spin_fock_matrix_mo_ov,1), &
1.d0, c_spin_fock_matrix_mo_vv, size(c_spin_fock_matrix_mo_vv,1))
do e=1,spin_vir_num
do a=1,spin_vir_num
do f=1,spin_vir_num
do m=1,spin_occ_num
c_spin_fock_matrix_mo_vv(a,e) = c_spin_fock_matrix_mo_vv(a,e) + &
t1_cc(m,f)*OVVV(m,a,f,e)
end do
end do
end do
end do
call dgemm('T','N', &
spin_vir_num, spin_vir_num, spin_occ_num*spin_occ_num*spin_vir_num,&
-0.5d0, taus, spin_occ_num*spin_occ_num*spin_vir_num, &
OOVV, spin_occ_num*spin_occ_num*spin_vir_num, &
1.d0, c_spin_fock_matrix_mo_vv, spin_vir_num)
END_PROVIDER