mirror of
https://github.com/pfloos/quack
synced 2025-01-09 20:48:51 +01:00
remove useless routines in utils
This commit is contained in:
parent
e6d68ea534
commit
b53a1505be
@ -1,33 +0,0 @@
|
|||||||
subroutine chem_to_phys_ERI(nBas,ERI)
|
|
||||||
|
|
||||||
! Antisymmetrize ERIs
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(inout):: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: p,q,r,s
|
|
||||||
double precision,allocatable :: pERI(:,:,:,:)
|
|
||||||
|
|
||||||
allocate(pERI(nBas,nBas,nBas,nBas))
|
|
||||||
|
|
||||||
do p=1,nBas
|
|
||||||
do q=1,nBas
|
|
||||||
do r=1,nBas
|
|
||||||
do s=1,nBas
|
|
||||||
|
|
||||||
pERI(p,q,r,s) = ERI(p,r,q,s)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
ERI(:,:,:,:) = pERI(:,:,:,:)
|
|
||||||
|
|
||||||
end subroutine
|
|
||||||
@ -1,66 +0,0 @@
|
|||||||
double precision function dfac(n)
|
|
||||||
implicit none
|
|
||||||
integer :: n
|
|
||||||
double precision, external :: fact
|
|
||||||
dfac = fact(n)
|
|
||||||
end
|
|
||||||
|
|
||||||
!-------------------
|
|
||||||
! The following functions were taken with from Quantum Package
|
|
||||||
! (https://github.com/QuantumPackage/qp2 , AGPL license)
|
|
||||||
|
|
||||||
double precision function fact(n)
|
|
||||||
implicit none
|
|
||||||
integer :: n
|
|
||||||
double precision, save :: memo(1:100)
|
|
||||||
integer, save :: memomax = 1
|
|
||||||
integer :: i
|
|
||||||
double precision :: logfact
|
|
||||||
|
|
||||||
if (n<=memomax) then
|
|
||||||
if (n<2) then
|
|
||||||
fact = 1.d0
|
|
||||||
else
|
|
||||||
fact = memo(n)
|
|
||||||
endif
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
memo(1) = 1.d0
|
|
||||||
do i=memomax+1,min(n,100)
|
|
||||||
memo(i) = memo(i-1)*dble(i)
|
|
||||||
enddo
|
|
||||||
memomax = min(n,100)
|
|
||||||
fact = dexp(logfact(n))
|
|
||||||
end function
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
double precision function logfact(n)
|
|
||||||
implicit none
|
|
||||||
integer :: n
|
|
||||||
double precision, save :: memo(1:100)
|
|
||||||
integer, save :: memomax = 1
|
|
||||||
integer :: i
|
|
||||||
|
|
||||||
if (n<=memomax) then
|
|
||||||
if (n<2) then
|
|
||||||
logfact = 0.d0
|
|
||||||
else
|
|
||||||
logfact = memo(n)
|
|
||||||
endif
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
memo(1) = 0.d0
|
|
||||||
do i=memomax+1,min(n,100)
|
|
||||||
memo(i) = memo(i-1)+dlog(dble(i))
|
|
||||||
enddo
|
|
||||||
memomax = min(n,100)
|
|
||||||
logfact = memo(memomax)
|
|
||||||
do i=101,n
|
|
||||||
logfact = logfact + dlog(dble(i))
|
|
||||||
enddo
|
|
||||||
end function
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,29 +0,0 @@
|
|||||||
function norm_coeff(alpha,a)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
double precision,intent(in) :: alpha
|
|
||||||
integer,intent(in) :: a(3)
|
|
||||||
|
|
||||||
! local variable
|
|
||||||
double precision :: pi,dfa(3),dfac
|
|
||||||
integer :: atot
|
|
||||||
|
|
||||||
! Output variable
|
|
||||||
double precision norm_coeff
|
|
||||||
|
|
||||||
pi = 4d0*atan(1d0)
|
|
||||||
atot = a(1) + a(2) + a(3)
|
|
||||||
|
|
||||||
dfa(1) = dfac(2*a(1))/(2d0**a(1)*dfac(a(1)))
|
|
||||||
dfa(2) = dfac(2*a(2))/(2d0**a(2)*dfac(a(2)))
|
|
||||||
dfa(3) = dfac(2*a(3))/(2d0**a(3)*dfac(a(3)))
|
|
||||||
|
|
||||||
|
|
||||||
norm_coeff = (2d0*alpha/pi)**(3d0/2d0)*(4d0*alpha)**atot
|
|
||||||
norm_coeff = norm_coeff/(dfa(1)*dfa(2)*dfa(3))
|
|
||||||
norm_coeff = sqrt(norm_coeff)
|
|
||||||
|
|
||||||
end function norm_coeff
|
|
||||||
@ -1,40 +0,0 @@
|
|||||||
subroutine overlap(nBas,bra,ket)
|
|
||||||
|
|
||||||
! Compute the overlap between two sets of coefficients
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: bra(nBas,nBas),ket(nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision,allocatable :: s(:),Ov(:,:)
|
|
||||||
|
|
||||||
! Allocate
|
|
||||||
|
|
||||||
allocate(s(nBas),Ov(nBas,nBas))
|
|
||||||
|
|
||||||
! Compute overlap
|
|
||||||
|
|
||||||
Ov = matmul(transpose(bra),ket)
|
|
||||||
|
|
||||||
call diagonalize_matrix(nBas,Ov,s)
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A50)') ' Overlap '
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
call matout(nBas,nBas,Ov)
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A50)') ' Eigenvalues of overlap matrix'
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
call matout(nBas,1,s)
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
end subroutine overlap
|
|
||||||
@ -1,33 +0,0 @@
|
|||||||
subroutine phys_to_chem_ERI(nBas,ERI)
|
|
||||||
|
|
||||||
! Antisymmetrize ERIs
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(inout):: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: p,q,r,s
|
|
||||||
double precision,allocatable :: cERI(:,:,:,:)
|
|
||||||
|
|
||||||
allocate(cERI(nBas,nBas,nBas,nBas))
|
|
||||||
|
|
||||||
do p=1,nBas
|
|
||||||
do q=1,nBas
|
|
||||||
do r=1,nBas
|
|
||||||
do s=1,nBas
|
|
||||||
|
|
||||||
cERI(p,q,r,s) = ERI(p,r,q,s)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
ERI(:,:,:,:) = cERI(:,:,:,:)
|
|
||||||
|
|
||||||
end subroutine phys_to_chem_ERI
|
|
||||||
@ -1,169 +0,0 @@
|
|||||||
subroutine read_F12_integrals(nBas,S,C,F,Y,FC)
|
|
||||||
|
|
||||||
! Read one- and two-electron integrals from files
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
logical :: debug
|
|
||||||
integer :: mu,nu,la,si,ka,ta
|
|
||||||
double precision :: ERI,F12,Yuk,F13C12,ExpS
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: C(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(out) :: F(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(out) :: Y(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(out) :: FC(nBas,nBas,nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
debug = .false.
|
|
||||||
|
|
||||||
! Open file with integrals
|
|
||||||
|
|
||||||
open(unit=21,file='int/ERI.dat')
|
|
||||||
open(unit=22,file='int/F12.dat')
|
|
||||||
open(unit=23,file='int/Yuk.dat')
|
|
||||||
open(unit=31,file='int/3eInt_Type1.dat')
|
|
||||||
|
|
||||||
! Read 1/r12 integrals
|
|
||||||
|
|
||||||
C = 0d0
|
|
||||||
do
|
|
||||||
read(21,*,end=21) mu,nu,la,si,ERI
|
|
||||||
! <12|34>
|
|
||||||
C(mu,nu,la,si) = ERI
|
|
||||||
! <32|14>
|
|
||||||
C(la,nu,mu,si) = ERI
|
|
||||||
! <14|32>
|
|
||||||
C(mu,si,la,nu) = ERI
|
|
||||||
! <34|12>
|
|
||||||
C(la,si,mu,nu) = ERI
|
|
||||||
! <41|23>
|
|
||||||
C(si,mu,nu,la) = ERI
|
|
||||||
! <23|41>
|
|
||||||
C(nu,la,si,mu) = ERI
|
|
||||||
! <21|43>
|
|
||||||
C(nu,mu,si,la) = ERI
|
|
||||||
! <43|21>
|
|
||||||
C(si,la,nu,mu) = ERI
|
|
||||||
enddo
|
|
||||||
21 close(unit=21)
|
|
||||||
|
|
||||||
! Read f12 integrals
|
|
||||||
|
|
||||||
F = 0d0
|
|
||||||
do
|
|
||||||
read(22,*,end=22) mu,nu,la,si,F12
|
|
||||||
! <12|34>
|
|
||||||
F(mu,nu,la,si) = F12
|
|
||||||
! <32|14>
|
|
||||||
F(la,nu,mu,si) = F12
|
|
||||||
! <14|32>
|
|
||||||
F(mu,si,la,nu) = F12
|
|
||||||
! <34|12>
|
|
||||||
F(la,si,mu,nu) = F12
|
|
||||||
! <41|23>
|
|
||||||
F(si,mu,nu,la) = F12
|
|
||||||
! <23|41>
|
|
||||||
F(nu,la,si,mu) = F12
|
|
||||||
! <21|43>
|
|
||||||
F(nu,mu,si,la) = F12
|
|
||||||
! <43|21>
|
|
||||||
F(si,la,nu,mu) = F12
|
|
||||||
enddo
|
|
||||||
22 close(unit=22)
|
|
||||||
|
|
||||||
! Read f12/r12 integrals
|
|
||||||
|
|
||||||
Y = 0d0
|
|
||||||
do
|
|
||||||
read(23,*,end=23) mu,nu,la,si,Yuk
|
|
||||||
! <12|34>
|
|
||||||
Y(mu,nu,la,si) = Yuk
|
|
||||||
! <32|14>
|
|
||||||
Y(la,nu,mu,si) = Yuk
|
|
||||||
! <14|32>
|
|
||||||
Y(mu,si,la,nu) = Yuk
|
|
||||||
! <34|12>
|
|
||||||
Y(la,si,mu,nu) = Yuk
|
|
||||||
! <41|23>
|
|
||||||
Y(si,mu,nu,la) = Yuk
|
|
||||||
! <23|41>
|
|
||||||
Y(nu,la,si,mu) = Yuk
|
|
||||||
! <21|43>
|
|
||||||
Y(nu,mu,si,la) = Yuk
|
|
||||||
! <43|21>
|
|
||||||
Y(si,la,nu,mu) = Yuk
|
|
||||||
enddo
|
|
||||||
23 close(unit=23)
|
|
||||||
|
|
||||||
! Read f13/r12 integrals
|
|
||||||
|
|
||||||
FC = 0d0
|
|
||||||
do
|
|
||||||
read(31,*,end=31) mu,nu,la,si,ka,ta,F13C12
|
|
||||||
FC(mu,nu,la,si,ka,ta) = F13C12
|
|
||||||
enddo
|
|
||||||
31 close(unit=31)
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
|
|
||||||
if(debug) then
|
|
||||||
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Electron repulsion integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
do la=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
call matout(nBas,nBas,C(1,1,la,si))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'F12 integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
do la=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
call matout(nBas,nBas,F(1,1,la,si))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Yukawa integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
do la=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
call matout(nBas,nBas,Y(1,1,la,si))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Read exponent of Slater geminal
|
|
||||||
open(unit=4,file='input/geminal')
|
|
||||||
read(4,*) ExpS
|
|
||||||
close(unit=4)
|
|
||||||
|
|
||||||
! Transform two-electron integrals
|
|
||||||
|
|
||||||
! do mu=1,nBas
|
|
||||||
! do nu=1,nBas
|
|
||||||
! do la=1,nBas
|
|
||||||
! do si=1,nBas
|
|
||||||
! F(mu,nu,la,si) = (S(mu,la)*S(nu,si) - F(mu,nu,la,si))/ExpS
|
|
||||||
! Y(mu,nu,la,si) = (C(mu,nu,la,si) - Y(mu,nu,la,si))/ExpS
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
end subroutine read_F12_integrals
|
|
||||||
@ -1,56 +0,0 @@
|
|||||||
subroutine read_LR(nBas,G)
|
|
||||||
|
|
||||||
! Read the long-range two-electron integrals from files
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: mu,nu,la,si
|
|
||||||
double precision :: ERI
|
|
||||||
double precision :: lambda
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: G(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Open file with integrals
|
|
||||||
|
|
||||||
lambda = 1d0
|
|
||||||
|
|
||||||
print*, 'Scaling integrals by ',lambda
|
|
||||||
|
|
||||||
open(unit=11,file='int/ERI_lr.dat')
|
|
||||||
|
|
||||||
! Read two-electron integrals
|
|
||||||
|
|
||||||
G(:,:,:,:) = 0d0
|
|
||||||
do
|
|
||||||
read(11,*,end=11) mu,nu,la,si,ERI
|
|
||||||
|
|
||||||
ERI = lambda*ERI
|
|
||||||
! <12|34>
|
|
||||||
G(mu,nu,la,si) = ERI
|
|
||||||
! <32|14>
|
|
||||||
G(la,nu,mu,si) = ERI
|
|
||||||
! <14|32>
|
|
||||||
G(mu,si,la,nu) = ERI
|
|
||||||
! <34|12>
|
|
||||||
G(la,si,mu,nu) = ERI
|
|
||||||
! <41|23>
|
|
||||||
G(si,mu,nu,la) = ERI
|
|
||||||
! <23|41>
|
|
||||||
G(nu,la,si,mu) = ERI
|
|
||||||
! <21|43>
|
|
||||||
G(nu,mu,si,la) = ERI
|
|
||||||
! <43|21>
|
|
||||||
G(si,la,nu,mu) = ERI
|
|
||||||
enddo
|
|
||||||
11 close(unit=11)
|
|
||||||
|
|
||||||
end subroutine read_LR
|
|
||||||
Loading…
Reference in New Issue
Block a user