mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-11-07 22:53:42 +01:00
51 lines
903 B
FortranFixed
51 lines
903 B
FortranFixed
|
subroutine form_g(nO,nV,hvv,hoo,t1,gvv,goo)
|
||
|
|
||
|
! Scuseria Eqs. (9), (10)
|
||
|
|
||
|
implicit none
|
||
|
|
||
|
! Input variables
|
||
|
|
||
|
integer,intent(in) :: nO,nV
|
||
|
|
||
|
double precision,intent(in) :: hvv(nV,nV)
|
||
|
double precision,intent(in) :: hoo(nO,nO)
|
||
|
|
||
|
double precision,intent(in) :: t1(nO,nV)
|
||
|
|
||
|
! Local variables
|
||
|
|
||
|
integer :: i,j,k,l
|
||
|
integer :: a,b,c,d
|
||
|
|
||
|
! Output variables
|
||
|
|
||
|
double precision,intent(out) :: gvv(nV,nV)
|
||
|
double precision,intent(out) :: goo(nO,nO)
|
||
|
|
||
|
gvv(:,:) = hvv(:,:)
|
||
|
|
||
|
do a=1,nV
|
||
|
do c=1,nV
|
||
|
do d=1,nV
|
||
|
do k=1,nO
|
||
|
gvv(c,a) = gvv(c,a) + VOVV(a,k,c,d)*t1(k,d)
|
||
|
end do
|
||
|
end do
|
||
|
end do
|
||
|
end do
|
||
|
|
||
|
goo(:,:) = hoo(:,:)
|
||
|
|
||
|
do k=1,nO
|
||
|
do i=1,nO
|
||
|
do c=1,nV
|
||
|
do l=1,nO
|
||
|
goo(i,k) = goo(i,k) + OOOV(k,l,i,c)*t1(l,c)
|
||
|
end do
|
||
|
end do
|
||
|
end do
|
||
|
end do
|
||
|
|
||
|
end subroutine form_g
|