LCPQ
/
quack
mirror of https://github.com/pfloos/quack
4
1
Fork 0
Code Releases Activity

dgemm for GHF AOtoMO transformation

This commit is contained in:
Pierre-Francois Loos 2023-11-24 10:51:31 +01:00
parent a37cfb496e
commit 3f12eb8188
3 changed files with 72 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
src/AOtoMO/AOtoMO_ERI_GHF.f90
View File

@ -1,4 +1,4 @@
subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,ERI_AO_basis,ERI_MO_basis)
subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,ERI_AO,ERI_MO)
! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm
! bra and ket are the spin of (bra1 bra2|ket1 ket2)
@ -10,79 +10,89 @@ subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,ERI_AO_basis,ERI_MO_basis)
integer,intent(in) :: nBas
integer,intent(in) :: nBas2
double precision,intent(in) :: ERI_AO_basis(nBas,nBas,nBas,nBas)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
double precision,intent(in) :: c1(nBas,nBas2)
double precision,intent(in) :: c2(nBas,nBas2)
! Local variables
double precision,allocatable :: scr(:,:,:,:)
integer :: mu,nu,la,si,i,j,k,l
integer :: mu,nu,la,si
integer :: i,j,k,l
! Output variables
double precision,intent(out) :: ERI_MO_basis(nBas2,nBas2,nBas2,nBas2)
double precision,intent(out) :: ERI_MO(nBas2,nBas2,nBas2,nBas2)
! Memory allocation
allocate(scr(nBas2,nBas2,nBas2,nBas2))
call dgemm('T','N',nBas**3,nBas2,nBas,1d0,ERI_AO,nBas,c1(1,1),nBas,0d0,scr,nBas**3)
call dgemm('T','N',nBas**2*nBas2,nBas2,nBas,1d0,scr,nBas,c2(1,1),nBas,0d0,ERI_MO,nBas**2*nBas2)
call dgemm('T','N',nBas*nBas2**2,nBas2,nBas,1d0,ERI_MO,nBas,c1(1,1),nBas,0d0,scr,nBas*nBas2**2)
call dgemm('T','N',nBas2**3,nBas2,nBas,1d0,scr,nBas,c2(1,1),nBas,0d0,ERI_MO,nBas2**3)
! Four-index transform via semi-direct O(N^5) algorithm
scr(:,:,:,:) = 0d0
! scr(:,:,:,:) = 0d0
do l=1,nBas2
do si=1,nBas
do la=1,nBas
do nu=1,nBas
do mu=1,nBas
scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO_basis(mu,nu,la,si)*c2(si,l)
enddo
enddo
enddo
enddo
enddo
! do l=1,nBas2
! do si=1,nBas
! do la=1,nBas
! do nu=1,nBas
! do mu=1,nBas
! scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO(mu,nu,la,si)*c2(si,l)
! enddo
! enddo
! enddo
! enddo
! enddo
ERI_MO_basis(:,:,:,:) = 0d0
! ERI_MO(:,:,:,:) = 0d0
do l=1,nBas2
do la=1,nBas
do nu=1,nBas
do i=1,nBas2
do mu=1,nBas
ERI_MO_basis(i,nu,la,l) = ERI_MO_basis(i,nu,la,l) + c1(mu,i)*scr(mu,nu,la,l)
enddo
enddo
enddo
enddo
enddo
! do l=1,nBas2
! do la=1,nBas
! do nu=1,nBas
! do i=1,nBas2
! do mu=1,nBas
! ERI_MO(i,nu,la,l) = ERI_MO(i,nu,la,l) + c1(mu,i)*scr(mu,nu,la,l)
! enddo
! enddo
! enddo
! enddo
! enddo
scr(:,:,:,:) = 0d0
do l=1,nBas2
do k=1,nBas2
do la=1,nBas
do nu=1,nBas
do i=1,nBas2
scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO_basis(i,nu,la,l)*c1(la,k)
enddo
enddo
enddo
enddo
enddo
! scr(:,:,:,:) = 0d0
ERI_MO_basis(:,:,:,:) = 0d0
! do l=1,nBas2
! do k=1,nBas2
! do la=1,nBas
! do nu=1,nBas
! do i=1,nBas2
! scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO(i,nu,la,l)*c1(la,k)
! enddo
! enddo
! enddo
! enddo
! enddo
do l=1,nBas2
do k=1,nBas2
do j=1,nBas2
do i=1,nBas2
do nu=1,nBas
ERI_MO_basis(i,j,k,l) = ERI_MO_basis(i,j,k,l) + c2(nu,j)*scr(i,nu,k,l)
enddo
enddo
enddo
enddo
enddo
! ERI_MO(:,:,:,:) = 0d0
! do l=1,nBas2
! do k=1,nBas2
! do j=1,nBas2
! do i=1,nBas2
! do nu=1,nBas
! ERI_MO(i,j,k,l) = ERI_MO(i,j,k,l) + c2(nu,j)*scr(i,nu,k,l)
! enddo
! enddo
! enddo
! enddo
! enddo
end subroutine

8
src/AOtoMO/AOtoMO_ERI_RHF.f90
View File

@ -27,12 +27,12 @@ subroutine AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
! Four-index transform via semi-direct O(N^5) algorithm
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
end subroutine

11
src/AOtoMO/AOtoMO_ERI_UHF.f90
View File

@ -17,7 +17,8 @@ subroutine AOtoMO_ERI_UHF(bra,ket,nBas,c,ERI_AO,ERI_MO)
! Local variables
double precision,allocatable :: scr(:,:,:,:)
integer :: mu,nu,la,si,i,j,k,l
integer :: mu,nu,la,si
integer :: i,j,k,l
! Output variables
@ -29,12 +30,12 @@ subroutine AOtoMO_ERI_UHF(bra,ket,nBas,c,ERI_AO,ERI_MO)
! Four-index transform via semi-direct O(N^5) algorithm
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1,bra),size(c,1),0d0,scr,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1,bra),size(c,1),0d0,scr,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1,ket),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1,ket),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1,bra),size(c,1),0d0,scr,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1,bra),size(c,1),0d0,scr,nBas**3)
call dgemm ('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1,ket),size(c,1),0d0,ERI_MO,nBas**3)
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1,ket),size(c,1),0d0,ERI_MO,nBas**3)
end subroutine