PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2025-01-03 18:16:03 +01:00
Code Releases Activity

remove unnecessary code in AOtoMO

Browse Source
This commit is contained in:
Pierre-Francois Loos 2024-09-10 17:05:03 +02:00
parent ba54a465a7
commit 66c59f85a1
5 changed files with 0 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/AOtoMO/AOtoMO_oooa.f90
View File

@ -1,85 +0,0 @@
subroutine AOtoMO_oooa(nBas,nO,nA,cO,cA,O,ooOoa)
! AO to MO transformation of two-electron integrals for the block oooa
! Semi-direct O(N^5) algorithm
implicit none
! Input variables
integer,intent(in) :: nBas,nO,nA
double precision,intent(in) :: cO(nBas,nO),cA(nBas,nA),O(nBas,nBas,nBas,nBas)
! Local variables
double precision,allocatable :: scr1(:,:,:,:),scr2(:,:,:,:)
integer :: mu,nu,la,si,i,j,k,x
! Output variables
double precision,intent(out) :: ooOoa(nO,nO,nO,nA)
! Memory allocation
allocate(scr1(nBas,nBas,nBas,nBas),scr2(nBas,nBas,nBas,nBas))
write(*,*)
write(*,'(A42)') '----------------------------------------'
write(*,'(A42)') ' AO to MO transformation for oooa block '
write(*,'(A42)') '----------------------------------------'
write(*,*)
scr1 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do si=1,nBas
do x=1,nA
scr1(mu,nu,la,x) = scr1(mu,nu,la,x) + O(mu,nu,la,si)*cA(si,x)
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do i=1,nO
do x=1,nA
scr2(i,nu,la,x) = scr2(i,nu,la,x) + cO(mu,i)*scr1(mu,nu,la,x)
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
do la=1,nBas
do i=1,nO
do k=1,nO
do x=1,nA
scr1(i,nu,k,x) = scr1(i,nu,k,x) + scr2(i,nu,la,x)*cO(la,k)
end do
end do
end do
end do
end do
ooOoa = 0d0
do nu=1,nBas
do i=1,nO
do j=1,nO
do k=1,nO
do x=1,nA
ooOoa(i,j,k,x) = ooOoa(i,j,k,x) + cO(nu,j)*scr1(i,nu,k,x)
end do
end do
end do
end do
end do
deallocate(scr1,scr2)
end subroutine

85
src/AOtoMO/AOtoMO_oooo.f90
View File

@ -1,85 +0,0 @@
subroutine AOtoMO_oooo(nBas,nO,cO,O,ooOoo)
! AO to MO transformation of two-electron integrals for the block oooo
! Semi-direct O(N^5) algorithm
implicit none
! Input variables
integer,intent(in) :: nBas,nO
double precision,intent(in) :: cO(nBas,nO),O(nBas,nBas,nBas,nBas)
! Local variables
double precision,allocatable :: scr1(:,:,:,:),scr2(:,:,:,:)
integer :: mu,nu,la,si,i,j,k,l
! Output variables
double precision,intent(out) :: ooOoo(nO,nO,nO,nO)
! Memory allocation
allocate(scr1(nBas,nBas,nBas,nBas),scr2(nBas,nBas,nBas,nBas))
write(*,*)
write(*,'(A42)') '----------------------------------------'
write(*,'(A42)') ' AO to MO transformation for oooo block '
write(*,'(A42)') '----------------------------------------'
write(*,*)
scr1 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do si=1,nBas
do l=1,nO
scr1(mu,nu,la,l) = scr1(mu,nu,la,l) + O(mu,nu,la,si)*cO(si,l)
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do i=1,nO
do l=1,nO
scr2(i,nu,la,l) = scr2(i,nu,la,l) + cO(mu,i)*scr1(mu,nu,la,l)
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
do la=1,nBas
do i=1,nO
do k=1,nO
do l=1,nO
scr1(i,nu,k,l) = scr1(i,nu,k,l) + scr2(i,nu,la,l)*cO(la,k)
end do
end do
end do
end do
end do
ooOoo = 0d0
do nu=1,nBas
do i=1,nO
do j=1,nO
do k=1,nO
do l=1,nO
ooOoo(i,j,k,l) = ooOoo(i,j,k,l) + cO(nu,j)*scr1(i,nu,k,l)
end do
end do
end do
end do
end do
deallocate(scr1,scr2)
end subroutine

77
src/AOtoMO/AOtoMO_oovv.f90
View File

@ -1,77 +0,0 @@
subroutine AOtoMO_oovv(nBas,nO,nV,cO,cV,O,ooOvv)
! AO to MO transformation of two-electron integrals for the block oovv
! Semi-direct O(N^5) algorithm
implicit none
! Input variables
integer,intent(in) :: nBas,nO,nV
double precision,intent(in) :: cO(nBas,nO),cV(nBas,nV),O(nBas,nBas,nBas,nBas)
! Local variables
double precision,allocatable :: scr1(:,:,:,:),scr2(:,:,:,:)
integer :: mu,nu,la,si,i,j,a,b
! Output variables
double precision,intent(out) :: ooOvv(nO,nO,nV,nV)
! Memory allocation
allocate(scr1(nBas,nBas,nBas,nBas),scr2(nBas,nBas,nBas,nBas))
scr1 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do si=1,nBas
do b=1,nV
scr1(mu,nu,la,b) = scr1(mu,nu,la,b) + O(mu,nu,la,si)*cV(si,b)
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
do nu=1,nBas
do la=1,nBas
do i=1,nO
do b=1,nV
scr2(i,nu,la,b) = scr2(i,nu,la,b) + cO(mu,i)*scr1(mu,nu,la,b)
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
do la=1,nBas
do i=1,nO
do a=1,nV
do b=1,nV
scr1(i,nu,a,b) = scr1(i,nu,a,b) + scr2(i,nu,la,b)*cV(la,a)
end do
end do
end do
end do
end do
ooOvv = 0d0
do nu=1,nBas
do i=1,nO
do j=1,nO
do a=1,nV
do b=1,nV
ooOvv(i,j,a,b) = ooOvv(i,j,a,b) + cO(nu,j)*scr1(i,nu,a,b)
end do
end do
end do
end do
end do
end subroutine

26
src/AOtoMO/Hartree_matrix_MO_basis.f90
View File

@ -1,26 +0,0 @@
subroutine Hartree_matrix_MO_basis(nBas,c,P,G,H)
! Compute Hartree matrix in the MO basis
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas)
double precision,intent(in) :: G(nBas,nBas,nBas,nBas)
! Output variables
double precision,intent(out) :: H(nBas,nBas)
! Compute Hartree matrix in the AO basis
call Hartree_matrix_AO_basis(nBas,P,G,H)
! Transform Hartree matrix in the MO basis
H = matmul(transpose(c),matmul(H,c))
end subroutine

26
src/AOtoMO/exchange_matrix_MO_basis.f90
View File

@ -1,26 +0,0 @@
subroutine exchange_matrix_MO_basis(nBas,c,P,G,K)
! Compute exchange matrix in the MO basis
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas)
double precision,intent(in) :: G(nBas,nBas,nBas,nBas)
! Output variables
double precision,intent(out) :: K(nBas,nBas)
! Compute Hartree Hamiltonian in the AO basis
call exchange_matrix_AO_basis(nBas,P,G,K)
! Transform Coulomb matrix in the MO basis
K = matmul(transpose(c),matmul(K,c))
end subroutine exchange_matrix_MO_basis