mirror of
https://github.com/pfloos/quack
synced 2024-12-22 20:34:46 +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