mirror of
https://github.com/pfloos/quack
synced 2024-08-26 14:11:47 +02:00
remove xcDFT
This commit is contained in:
parent
86964672d7
commit
905a4821cd
@ -1,101 +0,0 @@
|
|||||||
subroutine AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
|
|
||||||
nGrid,root,AO,dAO)
|
|
||||||
|
|
||||||
! Compute values of the AOs and their derivatives with respect to the cartesian coordinates
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas,nShell
|
|
||||||
double precision,intent(in) :: CenterShell(maxShell,3)
|
|
||||||
integer,intent(in) :: TotAngMomShell(maxShell)
|
|
||||||
integer,intent(in) :: KShell(maxShell)
|
|
||||||
double precision,intent(in) :: DShell(maxShell,maxK)
|
|
||||||
double precision,intent(in) :: ExpShell(maxShell,maxK)
|
|
||||||
double precision,intent(in) :: root(3,nGrid)
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: atot,nShellFunction,a(3)
|
|
||||||
integer,allocatable :: ShellFunction(:,:)
|
|
||||||
double precision :: rASq,xA,yA,zA,NormCoeff,prim
|
|
||||||
|
|
||||||
integer :: iSh,iShF,iK,iG,iBas
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(out) :: dAO(3,nBas,nGrid)
|
|
||||||
|
|
||||||
! Initialization
|
|
||||||
|
|
||||||
iBas = 0
|
|
||||||
AO(:,:) = 0d0
|
|
||||||
dAO(:,:,:) = 0d0
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Loops over shells
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
do iSh=1,nShell
|
|
||||||
|
|
||||||
atot = TotAngMomShell(iSh)
|
|
||||||
nShellFunction = (atot*atot + 3*atot + 2)/2
|
|
||||||
allocate(ShellFunction(1:nShellFunction,1:3))
|
|
||||||
call generate_shell(atot,nShellFunction,ShellFunction)
|
|
||||||
|
|
||||||
do iShF=1,nShellFunction
|
|
||||||
|
|
||||||
iBas = iBas + 1
|
|
||||||
a(:) = ShellFunction(iShF,:)
|
|
||||||
|
|
||||||
do iG=1,nGrid
|
|
||||||
|
|
||||||
xA = root(1,iG) - CenterShell(iSh,1)
|
|
||||||
yA = root(2,iG) - CenterShell(iSh,2)
|
|
||||||
zA = root(3,iG) - CenterShell(iSh,3)
|
|
||||||
|
|
||||||
! Calculate distance for exponential
|
|
||||||
|
|
||||||
rASq = xA**2 + yA**2 + zA**2
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Loops over contraction degrees
|
|
||||||
!-------------------------------------------------------------------------
|
|
||||||
do iK=1,KShell(iSh)
|
|
||||||
|
|
||||||
! Calculate the exponential part
|
|
||||||
|
|
||||||
prim = DShell(iSh,iK)*NormCoeff(ExpShell(iSh,iK),a)*exp(-ExpShell(iSh,iK)*rASq)
|
|
||||||
AO(iBas,iG) = AO(iBas,iG) + prim
|
|
||||||
|
|
||||||
prim = -2d0*ExpShell(iSh,iK)*prim
|
|
||||||
dAO(:,iBas,iG) = dAO(:,iBas,iG) + prim
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
dAO(1,iBas,iG) = xA**(a(1)+1)*yA**a(2)*zA**a(3)*dAO(1,iBas,iG)
|
|
||||||
if(a(1) > 0) dAO(1,iBas,iG) = dAO(1,iBas,iG) + dble(a(1))*xA**(a(1)-1)*yA**a(2)*zA**a(3)*AO(iBas,iG)
|
|
||||||
|
|
||||||
dAO(2,iBas,iG) = xA**a(1)*yA**(a(2)+1)*zA**a(3)*dAO(2,iBas,iG)
|
|
||||||
if(a(2) > 0) dAO(2,iBas,iG) = dAO(2,iBas,iG) + dble(a(2))*xA**a(1)*yA**(a(2)-1)*zA**a(3)*AO(iBas,iG)
|
|
||||||
|
|
||||||
dAO(3,iBas,iG) = xA**a(1)*yA**a(2)*zA**(a(3)+1)*dAO(3,iBas,iG)
|
|
||||||
if(a(3) > 0) dAO(3,iBas,iG) = dAO(3,iBas,iG) + dble(a(3))*xA**a(1)*yA**a(2)*zA**(a(3)-1)*AO(iBas,iG)
|
|
||||||
|
|
||||||
! Calculate polynmial part
|
|
||||||
|
|
||||||
AO(iBas,iG) = xA**a(1)*yA**a(2)*zA**a(3)*AO(iBas,iG)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
deallocate(ShellFunction)
|
|
||||||
enddo
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! End loops over shells
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
end subroutine AO_values_grid
|
|
@ -1,52 +0,0 @@
|
|||||||
subroutine DIIS_extrapolation(n,n_diis,error,e,error_in,e_inout)
|
|
||||||
|
|
||||||
! Perform DIIS extrapolation
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: n,n_diis
|
|
||||||
double precision,intent(in) :: error(n,n_diis),e(n,n_diis),error_in(n)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision,allocatable :: A(:,:),b(:),w(:)
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(inout):: e_inout(n)
|
|
||||||
|
|
||||||
! Memory allocaiton
|
|
||||||
|
|
||||||
allocate(A(n_diis+1,n_diis+1),b(n_diis+1),w(n_diis+1))
|
|
||||||
|
|
||||||
! Update DIIS "history"
|
|
||||||
|
|
||||||
call prepend(n,n_diis,error,error_in)
|
|
||||||
call prepend(n,n_diis,e,e_inout)
|
|
||||||
|
|
||||||
! Build A matrix
|
|
||||||
|
|
||||||
A(1:n_diis,1:n_diis) = matmul(transpose(error),error)
|
|
||||||
|
|
||||||
A(1:n_diis,n_diis+1) = -1d0
|
|
||||||
A(n_diis+1,1:n_diis) = -1d0
|
|
||||||
A(n_diis+1,n_diis+1) = +0d0
|
|
||||||
|
|
||||||
! Build x matrix
|
|
||||||
|
|
||||||
b(1:n_diis) = +0d0
|
|
||||||
b(n_diis+1) = -1d0
|
|
||||||
|
|
||||||
! Solve linear system
|
|
||||||
|
|
||||||
call linear_solve(n_diis+1,A,b,w)
|
|
||||||
|
|
||||||
! Extrapolate
|
|
||||||
|
|
||||||
e_inout(:) = matmul(w(1:n_diis),transpose(e(:,1:n_diis)))
|
|
||||||
|
|
||||||
end subroutine DIIS_extrapolation
|
|
@ -1,34 +0,0 @@
|
|||||||
IDIR =../../include
|
|
||||||
BDIR =../../bin
|
|
||||||
ODIR = obj
|
|
||||||
SDIR =.
|
|
||||||
FC = gfortran -I$(IDIR)
|
|
||||||
ifeq ($(DEBUG),1)
|
|
||||||
FFLAGS = -Wall -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
|
|
||||||
else
|
|
||||||
FFLAGS = -Wall -Wno-unused -Wno-unused-dummy-argument -O2
|
|
||||||
endif
|
|
||||||
|
|
||||||
LIBS = ~/Dropbox/quack/lib/*.a
|
|
||||||
#LIBS = -lblas -llapack
|
|
||||||
|
|
||||||
SRCF90 = $(wildcard *.f90)
|
|
||||||
|
|
||||||
SRC = $(wildcard *.f)
|
|
||||||
|
|
||||||
OBJ = $(patsubst %.f90,$(ODIR)/%.o,$(SRCF90)) $(patsubst %.f,$(ODIR)/%.o,$(SRC))
|
|
||||||
|
|
||||||
$(ODIR)/%.o: %.f90
|
|
||||||
$(FC) -c -o $@ $< $(FFLAGS)
|
|
||||||
|
|
||||||
$(ODIR)/%.o: %.f
|
|
||||||
$(FC) -c -o $@ $< $(FFLAGS)
|
|
||||||
|
|
||||||
$(BDIR)/xcDFT: $(OBJ)
|
|
||||||
$(FC) -o $@ $^ $(FFLAGS) $(LIBS)
|
|
||||||
|
|
||||||
debug:
|
|
||||||
DEBUG=1 make clean $(BDIR)/xcDFT
|
|
||||||
|
|
||||||
clean:
|
|
||||||
rm -f $(ODIR)/*.o $(BDIR)/xcDFT $(BDIR)/debug
|
|
@ -1,31 +0,0 @@
|
|||||||
function NormCoeff(alpha,a)
|
|
||||||
|
|
||||||
! Compute normalization coefficients for cartesian gaussians
|
|
||||||
|
|
||||||
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 NormCoeff
|
|
||||||
|
|
||||||
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)))
|
|
||||||
|
|
||||||
|
|
||||||
NormCoeff = (2d0*alpha/pi)**(3d0/2d0)*(4d0*alpha)**atot
|
|
||||||
NormCoeff = NormCoeff/(dfa(1)*dfa(2)*dfa(3))
|
|
||||||
NormCoeff = sqrt(NormCoeff)
|
|
||||||
|
|
||||||
end function NormCoeff
|
|
@ -1,221 +0,0 @@
|
|||||||
subroutine RKS(rung,nGrid,weight,nBas,AO,dAO,nO,S,T,V,Hc,ERI,X,ENuc,EKS)
|
|
||||||
|
|
||||||
! Perform a restricted Kohn-Sham calculation
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: rung
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: dAO(3,nBas,nGrid)
|
|
||||||
|
|
||||||
integer,intent(in) :: nO
|
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
|
||||||
double precision,intent(in) :: Hc(nBas,nBas)
|
|
||||||
double precision,intent(in) :: X(nBas,nBas)
|
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(in) :: ENuc
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer,parameter :: maxSCF = 64
|
|
||||||
double precision,parameter :: thresh = 1d-5
|
|
||||||
integer,parameter :: n_diis = 1
|
|
||||||
integer :: nSCF
|
|
||||||
double precision :: Conv
|
|
||||||
double precision :: ET,EV,EJ
|
|
||||||
double precision :: Ex
|
|
||||||
double precision :: Ec
|
|
||||||
double precision,allocatable :: e(:)
|
|
||||||
double precision,allocatable :: c(:,:),cp(:,:)
|
|
||||||
double precision,allocatable :: P(:,:),Pa(:,:)
|
|
||||||
double precision,allocatable :: J(:,:)
|
|
||||||
double precision,allocatable :: F(:,:),Fp(:,:)
|
|
||||||
double precision,allocatable :: Fx(:,:),FxHF(:,:)
|
|
||||||
double precision,allocatable :: Fc(:,:)
|
|
||||||
double precision,allocatable :: error(:,:)
|
|
||||||
double precision,allocatable :: error_diis(:,:),F_diis(:,:)
|
|
||||||
double precision,external :: trace_matrix
|
|
||||||
double precision,external :: exchange_energy
|
|
||||||
double precision,external :: electron_number
|
|
||||||
|
|
||||||
double precision,allocatable :: rhoa(:)
|
|
||||||
double precision,allocatable :: drhoa(:,:)
|
|
||||||
double precision :: nEl
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: EKS
|
|
||||||
|
|
||||||
! Hello world
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)'************************************************'
|
|
||||||
write(*,*)'| Restricted Kohn-Sham calculation |'
|
|
||||||
write(*,*)'************************************************'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Rung of Jacob's ladder
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
call select_rung(rung)
|
|
||||||
|
|
||||||
! Memory allocation
|
|
||||||
|
|
||||||
allocate(e(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),Pa(nBas,nBas), &
|
|
||||||
J(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas),Fx(nBas,nBas),FxHF(nBas,nBas), &
|
|
||||||
Fc(nBas,nBas),error(nBas,nBas),rhoa(nGrid),drhoa(3,nGrid), &
|
|
||||||
error_diis(nBas*nBas,n_diis),F_diis(nBas*nBas,n_diis))
|
|
||||||
|
|
||||||
! Guess coefficients and eigenvalues
|
|
||||||
|
|
||||||
F(:,:) = Hc(:,:)
|
|
||||||
|
|
||||||
! Initialization
|
|
||||||
|
|
||||||
nSCF = 0
|
|
||||||
Conv = 1d0
|
|
||||||
nEl = 0d0
|
|
||||||
|
|
||||||
Ex = 0d0
|
|
||||||
Ec = 0d0
|
|
||||||
|
|
||||||
Fx(:,:) = 0d0
|
|
||||||
FxHF(:,:) = 0d0
|
|
||||||
Fc(:,:) = 0d0
|
|
||||||
|
|
||||||
F_diis(:,:) = 0d0
|
|
||||||
error_diis(:,:) = 0d0
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Main SCF loop
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)'------------------------------------------------------------------------------------------'
|
|
||||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
|
||||||
'|','#','|','EKS','|','ExKS','|','EcKS','|','Conv','|','nEl','|'
|
|
||||||
write(*,*)'------------------------------------------------------------------------------------------'
|
|
||||||
|
|
||||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
|
||||||
|
|
||||||
! Increment
|
|
||||||
|
|
||||||
nSCF = nSCF + 1
|
|
||||||
|
|
||||||
! Transform Fock matrix in orthogonal basis
|
|
||||||
|
|
||||||
Fp = matmul(transpose(X),matmul(F,X))
|
|
||||||
|
|
||||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
|
||||||
|
|
||||||
cp(:,:) = Fp(:,:)
|
|
||||||
call diagonalize_matrix(nBas,cp,e)
|
|
||||||
|
|
||||||
! Back-transform eigenvectors in non-orthogonal basis
|
|
||||||
|
|
||||||
c = matmul(X,cp)
|
|
||||||
|
|
||||||
! Compute density matrix
|
|
||||||
|
|
||||||
Pa(:,:) = matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
|
||||||
P(:,:) = 2d0*Pa(:,:)
|
|
||||||
|
|
||||||
! Compute one-electron density and its gradient if necessary
|
|
||||||
|
|
||||||
call density(nGrid,nBas,Pa,AO,rhoa)
|
|
||||||
if(rung > 1) call gradient_density(nGrid,nBas,Pa,AO,dAO,drhoa)
|
|
||||||
|
|
||||||
! Build Coulomb repulsion
|
|
||||||
|
|
||||||
call hartree_coulomb(nBas,P,ERI,J)
|
|
||||||
|
|
||||||
! Compute exchange potential
|
|
||||||
|
|
||||||
call exchange_potential(rung,nGrid,weight,nBas,Pa,ERI,AO,dAO,rhoa,drhoa,Fx,FxHF)
|
|
||||||
|
|
||||||
! Compute correlation potential
|
|
||||||
|
|
||||||
! call correlation_potential(rung,nGrid,weight,nBas,Pa,ERI,AO,dAO,rhoa,drhoa,Fc)
|
|
||||||
|
|
||||||
! Build Fock operator
|
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + Fx(:,:) + Fc(:,:)
|
|
||||||
|
|
||||||
! Check convergence
|
|
||||||
|
|
||||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
|
||||||
Conv = maxval(abs(error))
|
|
||||||
|
|
||||||
! DIIS extrapolation
|
|
||||||
|
|
||||||
call DIIS_extrapolation(nBas*nBas,min(n_diis,nSCF),error_diis,F_diis,error,F)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Compute KS energy
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
! Kinetic energy
|
|
||||||
|
|
||||||
ET = trace_matrix(nBas,matmul(P,T))
|
|
||||||
|
|
||||||
! Potential energy
|
|
||||||
|
|
||||||
EV = trace_matrix(nBas,matmul(P,V))
|
|
||||||
|
|
||||||
! Coulomb energy
|
|
||||||
|
|
||||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
|
||||||
|
|
||||||
! Exchange energy
|
|
||||||
|
|
||||||
Ex = exchange_energy(rung,nGrid,weight,nBas,Pa,FxHF,rhoa,drhoa)
|
|
||||||
|
|
||||||
! Correlation energy
|
|
||||||
|
|
||||||
! call correlation_energy(rung,nGrid,weight,nBas,Pa,rhoa,drhoa,Ec)
|
|
||||||
|
|
||||||
EKS = ET + EV + EJ + Ex + Ec
|
|
||||||
|
|
||||||
! Check the grid accuracy by computing the number of electrons
|
|
||||||
|
|
||||||
nEl = electron_number(nGrid,weight,rhoa)
|
|
||||||
|
|
||||||
! Dump results
|
|
||||||
|
|
||||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
|
||||||
'|',nSCF,'|',EKS+ENuc,'|',Ex,'|',Ec,'|',Conv,'|',nEl,'|'
|
|
||||||
|
|
||||||
enddo
|
|
||||||
write(*,*)'------------------------------------------------------------------------------------------'
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! End of SCF loop
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
! Did it actually converge?
|
|
||||||
|
|
||||||
if(nSCF == maxSCF) then
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
||||||
write(*,*)' Convergence failed '
|
|
||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
stop
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Compute final KS energy
|
|
||||||
|
|
||||||
call print_RKS(nBas,nO,e,C,ENuc,ET,EV,EJ,Ex,Ec,EKS)
|
|
||||||
|
|
||||||
end subroutine RKS
|
|
@ -1,38 +0,0 @@
|
|||||||
subroutine density(nGrid,nBas,P,AO,rho)
|
|
||||||
|
|
||||||
! Calculate one-electron density
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
double precision,parameter :: thresh = 1d-15
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: iG,mu,nu
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: rho(nGrid)
|
|
||||||
|
|
||||||
rho(:) = 0d0
|
|
||||||
do iG=1,nGrid
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! do iG=1,nGrid
|
|
||||||
! rho(iG) = max(rho(iG),thresh)
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
end subroutine density
|
|
3017
src/xcDFT/dft_grid.f
3017
src/xcDFT/dft_grid.f
File diff suppressed because it is too large
Load Diff
@ -1,20 +0,0 @@
|
|||||||
function electron_number(nGrid,w,rho) result(nEl)
|
|
||||||
|
|
||||||
! Compute the number of electrons via integration of the one-electron density
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: w(nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision :: nEl
|
|
||||||
|
|
||||||
nEl = 2d0*dot_product(w,rho)
|
|
||||||
|
|
||||||
end function electron_number
|
|
@ -1,171 +0,0 @@
|
|||||||
function element_number(element_name)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer,parameter :: nelement_max = 103
|
|
||||||
character(len=2),intent(in) :: element_name
|
|
||||||
integer :: element_number
|
|
||||||
character(len=2),parameter :: element_list(nelement_max) = &
|
|
||||||
(/' H', 'He', & ! 2
|
|
||||||
'Li','Be', ' B',' C',' N',' O',' F','Ne', & ! 10
|
|
||||||
'Na','Mg', 'Al','Si',' P',' S','Cl','Ar', & ! 18
|
|
||||||
' K','Ca','Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se','Br','Kr', & ! 36
|
|
||||||
'Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn','Sb','Te',' I','Xe', & ! 54
|
|
||||||
'Cs','Ba', & ! 56
|
|
||||||
'La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb', & ! 70
|
|
||||||
'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb','Bi','Po','At','Rn', & ! 86
|
|
||||||
'Fr','Ra', & ! 88
|
|
||||||
'Ac','Th','Pa',' U','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No', & ! 102
|
|
||||||
'Lr' & ! 103
|
|
||||||
/)
|
|
||||||
|
|
||||||
!=====
|
|
||||||
integer :: ielement
|
|
||||||
!=====
|
|
||||||
|
|
||||||
ielement=1
|
|
||||||
do while( ADJUSTL(element_name) /= ADJUSTL(element_list(ielement)) )
|
|
||||||
if( ielement == nelement_max ) then
|
|
||||||
write(*,'(a,a)') ' Input symbol ',element_name
|
|
||||||
write(*,'(a,i3,a)') ' Element symbol is not one of first ',nelement_max,' elements'
|
|
||||||
write(*,*) '!!! element symbol not understood !!!'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
ielement = ielement + 1
|
|
||||||
enddo
|
|
||||||
|
|
||||||
element_number = ielement
|
|
||||||
|
|
||||||
end function element_number
|
|
||||||
|
|
||||||
function element_core(zval,zatom)
|
|
||||||
implicit none
|
|
||||||
double precision,intent(in) :: zval
|
|
||||||
double precision,intent(in) :: zatom
|
|
||||||
integer :: element_core
|
|
||||||
!=====
|
|
||||||
|
|
||||||
!
|
|
||||||
! If zval /= zatom, this is certainly an effective core potential
|
|
||||||
! and no core states should be frozen.
|
|
||||||
if( ABS(zval - zatom) > 1d0-3 ) then
|
|
||||||
element_core = 0
|
|
||||||
else
|
|
||||||
|
|
||||||
if( zval <= 4.00001d0 ) then ! up to Be
|
|
||||||
element_core = 0
|
|
||||||
else if( zval <= 12.00001d0 ) then ! up to Mg
|
|
||||||
element_core = 1
|
|
||||||
else if( zval <= 30.00001d0 ) then ! up to Ca
|
|
||||||
element_core = 5
|
|
||||||
else if( zval <= 48.00001d0 ) then ! up to Sr
|
|
||||||
element_core = 9
|
|
||||||
else
|
|
||||||
write(*,*) '!!! not imlemented in element_core !!!'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
end function element_core
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
function element_covalent_radius(zatom)
|
|
||||||
|
|
||||||
! Return covalent radius of an atom
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
integer,intent(in) :: zatom
|
|
||||||
double precision :: element_covalent_radius
|
|
||||||
|
|
||||||
!
|
|
||||||
! Data from Cambridge Structural Database
|
|
||||||
! http://en.wikipedia.org/wiki/Covalent_radius
|
|
||||||
!
|
|
||||||
! Values are first given in picometer
|
|
||||||
! They will be converted in bohr just after
|
|
||||||
select case(zatom)
|
|
||||||
case( 1)
|
|
||||||
element_covalent_radius = 31.
|
|
||||||
case( 2)
|
|
||||||
element_covalent_radius = 28.
|
|
||||||
case( 3)
|
|
||||||
element_covalent_radius = 128.
|
|
||||||
case( 4)
|
|
||||||
element_covalent_radius = 96.
|
|
||||||
case( 5)
|
|
||||||
element_covalent_radius = 84.
|
|
||||||
case( 6)
|
|
||||||
element_covalent_radius = 73.
|
|
||||||
case( 7)
|
|
||||||
element_covalent_radius = 71.
|
|
||||||
case( 8)
|
|
||||||
element_covalent_radius = 66.
|
|
||||||
case( 9)
|
|
||||||
element_covalent_radius = 57.
|
|
||||||
case(10) ! Ne.
|
|
||||||
element_covalent_radius = 58.
|
|
||||||
case(11)
|
|
||||||
element_covalent_radius = 166.
|
|
||||||
case(12)
|
|
||||||
element_covalent_radius = 141.
|
|
||||||
case(13)
|
|
||||||
element_covalent_radius = 121.
|
|
||||||
case(14)
|
|
||||||
element_covalent_radius = 111.
|
|
||||||
case(15)
|
|
||||||
element_covalent_radius = 107.
|
|
||||||
case(16)
|
|
||||||
element_covalent_radius = 105.
|
|
||||||
case(17)
|
|
||||||
element_covalent_radius = 102.
|
|
||||||
case(18) ! Ar.
|
|
||||||
element_covalent_radius = 106.
|
|
||||||
case(19)
|
|
||||||
element_covalent_radius = 203.
|
|
||||||
case(20)
|
|
||||||
element_covalent_radius = 176.
|
|
||||||
case(21)
|
|
||||||
element_covalent_radius = 170.
|
|
||||||
case(22)
|
|
||||||
element_covalent_radius = 160.
|
|
||||||
case(23)
|
|
||||||
element_covalent_radius = 153.
|
|
||||||
case(24)
|
|
||||||
element_covalent_radius = 139.
|
|
||||||
case(25)
|
|
||||||
element_covalent_radius = 145.
|
|
||||||
case(26)
|
|
||||||
element_covalent_radius = 145.
|
|
||||||
case(27)
|
|
||||||
element_covalent_radius = 140.
|
|
||||||
case(28)
|
|
||||||
element_covalent_radius = 124.
|
|
||||||
case(29)
|
|
||||||
element_covalent_radius = 132.
|
|
||||||
case(30)
|
|
||||||
element_covalent_radius = 122.
|
|
||||||
case(31)
|
|
||||||
element_covalent_radius = 120.
|
|
||||||
case(32)
|
|
||||||
element_covalent_radius = 119.
|
|
||||||
case(34)
|
|
||||||
element_covalent_radius = 120.
|
|
||||||
case(35)
|
|
||||||
element_covalent_radius = 120.
|
|
||||||
case(36) ! Kr.
|
|
||||||
element_covalent_radius = 116.
|
|
||||||
case default
|
|
||||||
write(*,*) '!!! covalent radius not available !!!'
|
|
||||||
stop
|
|
||||||
end select
|
|
||||||
|
|
||||||
! pm to bohr conversion
|
|
||||||
element_covalent_radius = element_covalent_radius*pmtoau
|
|
||||||
|
|
||||||
|
|
||||||
end function element_covalent_radius
|
|
||||||
|
|
@ -1,79 +0,0 @@
|
|||||||
function exchange_energy(rung,nGrid,weight,nBas,P,FxHF,rho,drho) result(Ex)
|
|
||||||
|
|
||||||
! Compute the exchange energy
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: rung
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: FxHF(nBas,nBas)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
double precision,intent(in) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision :: ExLDA,ExGGA,ExHF
|
|
||||||
double precision :: cX,aX,aC
|
|
||||||
double precision :: Ex
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
! Memory allocation
|
|
||||||
|
|
||||||
Ex = 0d0
|
|
||||||
ExLDA = 0d0
|
|
||||||
ExGGA = 0d0
|
|
||||||
ExHF = 0d0
|
|
||||||
|
|
||||||
select case (rung)
|
|
||||||
|
|
||||||
! Hartree calculation
|
|
||||||
case(0)
|
|
||||||
|
|
||||||
Ex = 0d0
|
|
||||||
|
|
||||||
! LDA functionals
|
|
||||||
case(1)
|
|
||||||
|
|
||||||
call lda_exchange_energy(nGrid,weight,rho,ExLDA)
|
|
||||||
|
|
||||||
Ex = ExLDA
|
|
||||||
|
|
||||||
! GGA functionals
|
|
||||||
case(2)
|
|
||||||
|
|
||||||
call gga_exchange_energy(nGrid,weight,rho,drho,ExGGA)
|
|
||||||
|
|
||||||
Ex = ExGGA
|
|
||||||
|
|
||||||
! Hybrid functionals
|
|
||||||
case(4)
|
|
||||||
|
|
||||||
cX = 0.20d0
|
|
||||||
aX = 0.72d0
|
|
||||||
aC = 0.81d0
|
|
||||||
|
|
||||||
call lda_exchange_energy(nGrid,weight,rho,ExLDA)
|
|
||||||
call gga_exchange_energy(nGrid,weight,rho,drho,ExGGA)
|
|
||||||
call fock_exchange_energy(nBas,P,FxHF,ExHF)
|
|
||||||
|
|
||||||
Ex = ExLDA &
|
|
||||||
+ cX*(ExHF - ExLDA) &
|
|
||||||
+ aX*(ExGGA - ExLDA)
|
|
||||||
|
|
||||||
! Hartree-Fock calculation
|
|
||||||
case(666)
|
|
||||||
|
|
||||||
call fock_exchange_energy(nBas,P,FxHF,ExHF)
|
|
||||||
|
|
||||||
Ex = ExHF
|
|
||||||
|
|
||||||
end select
|
|
||||||
|
|
||||||
end function exchange_energy
|
|
@ -1,82 +0,0 @@
|
|||||||
subroutine exchange_potential(rung,nGrid,weight,nBas,P,ERI,AO,dAO,rho,drho,Fx,FxHF)
|
|
||||||
|
|
||||||
! Compute the exchange potential
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: rung
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: dAO(3,nBas,nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
double precision,intent(in) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision,allocatable :: FxLDA(:,:),FxGGA(:,:)
|
|
||||||
double precision :: cX,aX,aC
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: Fx(nBas,nBas),FxHF(nBas,nBas)
|
|
||||||
|
|
||||||
! Memory allocation
|
|
||||||
|
|
||||||
allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas))
|
|
||||||
|
|
||||||
FxLDA(:,:) = 0d0
|
|
||||||
FxGGA(:,:) = 0d0
|
|
||||||
|
|
||||||
select case (rung)
|
|
||||||
|
|
||||||
! Hartree calculation
|
|
||||||
case(0)
|
|
||||||
|
|
||||||
Fx(:,:) = 0d0
|
|
||||||
|
|
||||||
! LDA functionals
|
|
||||||
case(1)
|
|
||||||
|
|
||||||
call lda_exchange_potential(nGrid,weight,nBas,AO,rho,FxLDA)
|
|
||||||
|
|
||||||
Fx(:,:) = FxLDA(:,:)
|
|
||||||
|
|
||||||
! GGA functionals
|
|
||||||
case(2)
|
|
||||||
|
|
||||||
call gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA)
|
|
||||||
|
|
||||||
Fx(:,:) = FxGGA(:,:)
|
|
||||||
|
|
||||||
! Hybrid functionals
|
|
||||||
case(4)
|
|
||||||
|
|
||||||
cX = 0.20d0
|
|
||||||
aX = 0.72d0
|
|
||||||
aC = 0.81d0
|
|
||||||
|
|
||||||
call lda_exchange_potential(nGrid,weight,nBas,AO,rho,FxLDA)
|
|
||||||
call gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA)
|
|
||||||
call fock_exchange_potential(nBas,P,ERI,FxHF)
|
|
||||||
|
|
||||||
Fx(:,:) = FxLDA(:,:) &
|
|
||||||
+ cX*(FxHF(:,:) - FxLDA(:,:)) &
|
|
||||||
+ aX*(FxGGA(:,:) - FxLDA(:,:))
|
|
||||||
|
|
||||||
! Hartree-Fock calculation
|
|
||||||
case(666)
|
|
||||||
|
|
||||||
call fock_exchange_potential(nBas,P,ERI,FxHF)
|
|
||||||
|
|
||||||
Fx(:,:) = FxHF(:,:)
|
|
||||||
|
|
||||||
end select
|
|
||||||
|
|
||||||
end subroutine exchange_potential
|
|
@ -1,25 +0,0 @@
|
|||||||
subroutine fock_exchange_energy(nBas,P,Fx,Ex)
|
|
||||||
|
|
||||||
! Compute the (exact) Fock exchange energy
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: Fx(nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision,external :: trace_matrix
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: Ex
|
|
||||||
|
|
||||||
! Compute HF exchange energy
|
|
||||||
|
|
||||||
Ex = trace_matrix(nBas,matmul(P,Fx))
|
|
||||||
|
|
||||||
end subroutine fock_exchange_energy
|
|
@ -1,34 +0,0 @@
|
|||||||
subroutine fock_exchange_potential(nBas,P,ERI,Fx)
|
|
||||||
|
|
||||||
! Compute the Fock exchange potential
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: mu,nu,la,si
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: Fx(nBas,nBas)
|
|
||||||
|
|
||||||
! Compute HF exchange matrix
|
|
||||||
|
|
||||||
Fx(:,:) = 0d0
|
|
||||||
do nu=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
do la=1,nBas
|
|
||||||
do mu=1,nBas
|
|
||||||
Fx(mu,nu) = Fx(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine fock_exchange_potential
|
|
@ -1,32 +0,0 @@
|
|||||||
subroutine generate_shell(atot,nShellFunction,ShellFunction)
|
|
||||||
|
|
||||||
! Generate shells for a given total angular momemtum
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: atot,nShellFunction
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: ax,ay,az,ia
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
integer,intent(out) :: ShellFunction(nShellFunction,3)
|
|
||||||
|
|
||||||
ia = 0
|
|
||||||
do ax=atot,0,-1
|
|
||||||
do az=0,atot
|
|
||||||
ay = atot - ax - az
|
|
||||||
if(ay >= 0) then
|
|
||||||
ia = ia + 1
|
|
||||||
ShellFunction(ia,1) = ax
|
|
||||||
ShellFunction(ia,2) = ay
|
|
||||||
ShellFunction(ia,3) = az
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine generate_shell
|
|
@ -1,44 +0,0 @@
|
|||||||
subroutine gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
|
||||||
|
|
||||||
! Compute GGA exchange energy
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
double precision,intent(in) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: iG
|
|
||||||
double precision :: alpha,beta
|
|
||||||
double precision :: r,g
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision :: Ex
|
|
||||||
|
|
||||||
! Coefficients for G96 GGA exchange functional
|
|
||||||
|
|
||||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
|
||||||
beta = 1d0/137d0
|
|
||||||
|
|
||||||
! Compute GGA exchange energy
|
|
||||||
|
|
||||||
Ex = 0d0
|
|
||||||
do iG=1,nGrid
|
|
||||||
|
|
||||||
r = rho(iG)
|
|
||||||
g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2
|
|
||||||
|
|
||||||
Ex = Ex + weight(iG)*r**(4d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
Ex = 2d0*Ex
|
|
||||||
|
|
||||||
end subroutine gga_exchange_energy
|
|
@ -1,62 +0,0 @@
|
|||||||
subroutine gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
|
||||||
|
|
||||||
! Compute GGA exchange potential
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: dAO(3,nBas,nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
double precision,intent(in) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision,parameter :: thresh = 1d-15
|
|
||||||
|
|
||||||
integer :: mu,nu,iG
|
|
||||||
double precision :: alpha,beta
|
|
||||||
double precision :: r,g,vAO,gAO
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: Fx(nBas,nBas)
|
|
||||||
|
|
||||||
! Coefficients for G96 GGA exchange functional
|
|
||||||
|
|
||||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
|
||||||
beta = +1d0/137d0
|
|
||||||
beta = 0d0
|
|
||||||
|
|
||||||
! Compute GGA exchange matrix in the AO basis
|
|
||||||
|
|
||||||
Fx(:,:) = 0d0
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
do iG=1,nGrid
|
|
||||||
|
|
||||||
r = rho(iG)
|
|
||||||
g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2
|
|
||||||
|
|
||||||
vAO = weight(iG)*AO(mu,iG)*AO(nu,iG)
|
|
||||||
Fx(mu,nu) = Fx(mu,nu) &
|
|
||||||
+ vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) &
|
|
||||||
+ 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0))
|
|
||||||
|
|
||||||
gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) &
|
|
||||||
+ drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) &
|
|
||||||
+ drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG))
|
|
||||||
gAO = weight(iG)*gAO
|
|
||||||
|
|
||||||
Fx(mu,nu) = Fx(mu,nu) - 2d0*gAO*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine gga_exchange_potential
|
|
@ -1,45 +0,0 @@
|
|||||||
subroutine gradient_density(nGrid,nBas,P,AO,dAO,drho)
|
|
||||||
|
|
||||||
! Calculate gradient of the one-electron density
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
double precision,parameter :: thresh = 1d-15
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: dAO(3,nBas,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: ixyz,iG,mu,nu
|
|
||||||
double precision,external :: trace_matrix
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
drho(:,:) = 0d0
|
|
||||||
do iG=1,nGrid
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
do ixyz=1,3
|
|
||||||
drho(ixyz,iG) = drho(ixyz,iG) &
|
|
||||||
+ P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do iG=1,nGrid
|
|
||||||
do ixyz=1,3
|
|
||||||
if(abs(drho(ixyz,iG)) < thresh) drho(ixyz,iG) = thresh
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine gradient_density
|
|
@ -1,33 +0,0 @@
|
|||||||
subroutine hartree_coulomb(nBas,P,ERI,J)
|
|
||||||
|
|
||||||
! Compute Coulomb matrix
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: mu,nu,la,si
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: J(nBas,nBas)
|
|
||||||
|
|
||||||
J = 0d0
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
do la=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
J(mu,nu) = J(mu,nu) + P(la,si)*ERI(mu,la,nu,si)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
end subroutine hartree_coulomb
|
|
@ -1,36 +0,0 @@
|
|||||||
subroutine lda_exchange_energy(nGrid,weight,rho,Ex)
|
|
||||||
|
|
||||||
! Compute LDA exchange energy
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: iG
|
|
||||||
double precision :: alpha
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision :: Ex
|
|
||||||
|
|
||||||
! Cx coefficient for Slater LDA exchange
|
|
||||||
|
|
||||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
|
||||||
|
|
||||||
! Compute LDA exchange energy
|
|
||||||
|
|
||||||
Ex = 0d0
|
|
||||||
do iG=1,nGrid
|
|
||||||
Ex = Ex + weight(iG)*alpha*rho(iG)**(4d0/3d0)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
Ex = 2d0*Ex
|
|
||||||
|
|
||||||
end subroutine lda_exchange_energy
|
|
@ -1,46 +0,0 @@
|
|||||||
subroutine lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx)
|
|
||||||
|
|
||||||
! Compute LDA exchange potential
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
double precision,intent(in) :: weight(nGrid)
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: rho(nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: mu,nu,iG
|
|
||||||
double precision :: alpha
|
|
||||||
double precision :: r,vAO
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: Fx(nBas,nBas)
|
|
||||||
|
|
||||||
! Cx coefficient for Slater LDA exchange
|
|
||||||
|
|
||||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
|
||||||
|
|
||||||
! Compute LDA exchange matrix in the AO basis
|
|
||||||
|
|
||||||
Fx(:,:) = 0d0
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
do iG=1,nGrid
|
|
||||||
r = rho(iG)
|
|
||||||
|
|
||||||
vAO = weight(iG)*AO(mu,iG)*AO(nu,iG)
|
|
||||||
Fx(mu,nu) = Fx(mu,nu) &
|
|
||||||
+ vAO*4d0/3d0*alpha*r**(1d0/3d0)
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine lda_exchange_potential
|
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,47 +0,0 @@
|
|||||||
subroutine one_electron_density(nGrid,nBas,P,AO,dAO,rho,drho)
|
|
||||||
|
|
||||||
! Calculate one-electron density
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nGrid
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: P(nBas,nBas)
|
|
||||||
double precision,intent(in) :: AO(nBas,nGrid)
|
|
||||||
double precision,intent(in) :: dAO(3,nBas,nGrid)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: ixyz,iG,mu,nu
|
|
||||||
double precision,external :: trace_matrix
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: rho(nGrid)
|
|
||||||
double precision,intent(out) :: drho(3,nGrid)
|
|
||||||
|
|
||||||
rho(:) = 0d0
|
|
||||||
do iG=1,nGrid
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
drho(:,:) = 0d0
|
|
||||||
do ixyz=1,3
|
|
||||||
do iG=1,nGrid
|
|
||||||
do mu=1,nBas
|
|
||||||
do nu=1,nBas
|
|
||||||
drho(ixyz,iG) = drho(ixyz,iG) &
|
|
||||||
+ P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine one_electron_density
|
|
@ -1,63 +0,0 @@
|
|||||||
subroutine orthogonalization_matrix(nBas,S,X)
|
|
||||||
|
|
||||||
! Compute the orthogonalization matrix X = S^(-1/2)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
logical :: debug
|
|
||||||
double precision,allocatable :: UVec(:,:),Uval(:)
|
|
||||||
double precision,parameter :: thresh = 1d-6
|
|
||||||
|
|
||||||
integer :: i
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: X(nBas,nBas)
|
|
||||||
|
|
||||||
debug = .false.
|
|
||||||
|
|
||||||
allocate(Uvec(nBas,nBas),Uval(nBas))
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) ' *** Lowdin orthogonalization X = S^(-1/2) *** '
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
Uvec = S
|
|
||||||
call diagonalize_matrix(nBas,Uvec,Uval)
|
|
||||||
|
|
||||||
do i=1,nBas
|
|
||||||
|
|
||||||
if(Uval(i) > thresh) then
|
|
||||||
|
|
||||||
Uval(i) = 1d0/sqrt(Uval(i))
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
write(*,*) 'Eigenvalue',i,'too small for Lowdin orthogonalization'
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
call ADAt(nBas,Uvec,Uval,X)
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
|
|
||||||
if(debug) then
|
|
||||||
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Orthogonalization matrix'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
call matout(nBas,nBas,X)
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine orthogonalization_matrix
|
|
@ -1,61 +0,0 @@
|
|||||||
subroutine print_RKS(nBas,nO,e,C,ENuc,ET,EV,EJ,Ex,Ec,EKS)
|
|
||||||
|
|
||||||
! Print one- and two-electron energies and other stuff for RKS calculation
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas,nO
|
|
||||||
double precision,intent(in) :: e(nBas),c(nBas,nBas),ENuc,ET,EV,EJ,Ex,Ec,EKS
|
|
||||||
|
|
||||||
integer :: HOMO,LUMO
|
|
||||||
double precision :: Gap
|
|
||||||
|
|
||||||
! HOMO and LUMO
|
|
||||||
|
|
||||||
HOMO = nO
|
|
||||||
LUMO = HOMO + 1
|
|
||||||
Gap = e(LUMO) - e(HOMO)
|
|
||||||
|
|
||||||
! Dump results
|
|
||||||
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A32)') ' Summary '
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A32,1X,F16.10)') ' One-electron energy ',ET + EV
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Kinetic energy ',ET
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Potential energy ',EV
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Two-electron energy ',EJ + Ex + Ec
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Coulomb energy ',EJ
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Exchange energy ',Ex
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Correlation energy ',Ec
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Electronic energy ',EKS
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Nuclear repulsion ',ENuc
|
|
||||||
write(*,'(A32,1X,F16.10)') ' Kohn-Sham energy ',EKS + ENuc
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A36,F13.6)') ' KS HOMO energy (eV):',e(HOMO)*HatoeV
|
|
||||||
write(*,'(A36,F13.6)') ' KS LUMO energy (eV):',e(LUMO)*Hatoev
|
|
||||||
write(*,'(A36,F13.6)') ' KS HOMO-LUMO gap (eV):',Gap*Hatoev
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A50)') 'Kohn-Sham orbital coefficients '
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
call matout(nBas,nBas,C)
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
write(*,'(A50)') ' Kohn-Sham orbital energies '
|
|
||||||
write(*,'(A50)') '---------------------------------------'
|
|
||||||
call matout(nBas,1,e)
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
end subroutine print_RKS
|
|
||||||
|
|
||||||
|
|
@ -1,77 +0,0 @@
|
|||||||
subroutine quadrature_grid(nRad,nAng,nGrid,root,weight)
|
|
||||||
|
|
||||||
! Build roots and weights of quadrature grid
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nRad,nAng,nGrid
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: i,j,k
|
|
||||||
double precision :: scale
|
|
||||||
double precision,allocatable :: Radius(:)
|
|
||||||
double precision,allocatable :: RadWeight(:)
|
|
||||||
double precision,allocatable :: XYZ(:,:)
|
|
||||||
double precision,allocatable :: XYZWeight(:)
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: root(3,nGrid)
|
|
||||||
double precision,intent(out) :: weight(nGrid)
|
|
||||||
|
|
||||||
! Memory allocation
|
|
||||||
|
|
||||||
allocate(Radius(nRad),RadWeight(nRad),XYZ(3,nAng),XYZWeight(nAng))
|
|
||||||
|
|
||||||
! Findthe radial grid
|
|
||||||
|
|
||||||
scale = 1d0
|
|
||||||
call EulMac(Radius,RadWeight,nRad,scale)
|
|
||||||
|
|
||||||
write(*,20)
|
|
||||||
write(*,30)
|
|
||||||
write(*,20)
|
|
||||||
do i = 1,nRad
|
|
||||||
write(*,40) i,Radius(i),RadWeight(i)
|
|
||||||
end do
|
|
||||||
write(*,20)
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
! Find the angular grid
|
|
||||||
|
|
||||||
call Lebdev(XYZ,XYZWeight,nAng)
|
|
||||||
|
|
||||||
write(*,20)
|
|
||||||
write(*,50)
|
|
||||||
write(*,20)
|
|
||||||
do j = 1,nAng
|
|
||||||
write(*,60) j,(XYZ(k,j),k=1,3), XYZWeight(j)
|
|
||||||
end do
|
|
||||||
write(*,20)
|
|
||||||
|
|
||||||
! Form the roots and weights
|
|
||||||
|
|
||||||
k = 0
|
|
||||||
do i=1,nRad
|
|
||||||
do j=1,nAng
|
|
||||||
k = k + 1
|
|
||||||
root(:,k) = Radius(i)*XYZ(:,j)
|
|
||||||
weight(k) = RadWeight(i)*XYZWeight(j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Compute values of the basis functions (and the its gradient if required) at each grid point
|
|
||||||
|
|
||||||
20 format(T2,58('-'))
|
|
||||||
30 format(T20,'Radial Quadrature',/, &
|
|
||||||
T6,'I',T26,'Radius',T50,'Weight')
|
|
||||||
40 format(T3,I4,T18,F17.10,T35,F25.10)
|
|
||||||
50 format(T20,'Angular Quadrature',/, &
|
|
||||||
T6,'I',T19,'X',T29,'Y',T39,'Z',T54,'Weight')
|
|
||||||
60 format(T3,I4,T13,3F10.5,T50,F10.5)
|
|
||||||
|
|
||||||
end subroutine quadrature_grid
|
|
@ -1,117 +0,0 @@
|
|||||||
subroutine read_basis(nAt,rAt,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell)
|
|
||||||
|
|
||||||
! Read basis set information
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nAt,nO
|
|
||||||
double precision,intent(in) :: rAt(nAt,3)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: nShAt,iAt,iShell
|
|
||||||
integer :: i,j,k
|
|
||||||
character :: shelltype
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
integer,intent(out) :: nShell,nBas,nV
|
|
||||||
double precision,intent(out) :: CenterShell(maxShell,3)
|
|
||||||
integer,intent(out) :: TotAngMomShell(maxShell),KShell(maxShell)
|
|
||||||
double precision,intent(out) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Primary basis set information
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
! Open file with basis set specification
|
|
||||||
|
|
||||||
open(unit=2,file='input/basis')
|
|
||||||
|
|
||||||
! Read basis information
|
|
||||||
|
|
||||||
write(*,'(A28)') 'Gaussian basis set'
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
|
|
||||||
nShell = 0
|
|
||||||
do i=1,nAt
|
|
||||||
read(2,*) iAt,nShAt
|
|
||||||
write(*,'(A28,1X,I16)') 'Atom n. ',iAt
|
|
||||||
write(*,'(A28,1X,I16)') 'number of shells ',nShAt
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
|
|
||||||
! Basis function centers
|
|
||||||
|
|
||||||
do j=1,nShAt
|
|
||||||
nShell = nShell + 1
|
|
||||||
do k=1,3
|
|
||||||
CenterShell(nShell,k) = rAt(iAt,k)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Shell type and contraction degree
|
|
||||||
|
|
||||||
read(2,*) shelltype,KShell(nShell)
|
|
||||||
if(shelltype == "S") then
|
|
||||||
TotAngMomShell(nShell) = 0
|
|
||||||
write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "P") then
|
|
||||||
TotAngMomShell(nShell) = 1
|
|
||||||
write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "D") then
|
|
||||||
TotAngMomShell(nShell) = 2
|
|
||||||
write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "F") then
|
|
||||||
TotAngMomShell(nShell) = 3
|
|
||||||
write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "G") then
|
|
||||||
TotAngMomShell(nShell) = 4
|
|
||||||
write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "H") then
|
|
||||||
TotAngMomShell(nShell) = 5
|
|
||||||
write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell)
|
|
||||||
elseif(shelltype == "I") then
|
|
||||||
TotAngMomShell(nShell) = 6
|
|
||||||
write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell)
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Read exponents and contraction coefficients
|
|
||||||
|
|
||||||
write(*,'(A28,1X,A16,A16)') '','Exponents','Contraction'
|
|
||||||
do k=1,Kshell(nShell)
|
|
||||||
read(2,*) ExpShell(nShell,k),DShell(nShell,k)
|
|
||||||
write(*,'(A28,1X,F16.10,F16.10)') '',ExpShell(nShell,k),DShell(nShell,k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Total number of shells
|
|
||||||
|
|
||||||
write(*,'(A28,1X,I16)') 'Number of shells',nShell
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
! Close file with basis set specification
|
|
||||||
|
|
||||||
close(unit=2)
|
|
||||||
|
|
||||||
! Calculate number of basis functions
|
|
||||||
|
|
||||||
nBas = 0
|
|
||||||
do iShell=1,nShell
|
|
||||||
nBas = nBas + (TotAngMomShell(iShell)*TotAngMomShell(iShell) + 3*TotAngMomShell(iShell) + 2)/2
|
|
||||||
enddo
|
|
||||||
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,'(A28,1X,I16)') 'Number of basis functions',NBas
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
! Number of virtual orbitals
|
|
||||||
|
|
||||||
nV = nBas - nO
|
|
||||||
|
|
||||||
end subroutine read_basis
|
|
@ -1,58 +0,0 @@
|
|||||||
subroutine read_geometry(nAt,ZNuc,rA,ENuc)
|
|
||||||
|
|
||||||
! Read molecular geometry
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Ouput variables
|
|
||||||
integer,intent(in) :: nAt
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
integer :: i,j
|
|
||||||
double precision :: RAB
|
|
||||||
|
|
||||||
! Ouput variables
|
|
||||||
double precision,intent(out) :: ZNuc(NAt),rA(nAt,3),ENuc
|
|
||||||
|
|
||||||
|
|
||||||
! Open file with geometry specification
|
|
||||||
open(unit=1,file='input/molecule')
|
|
||||||
|
|
||||||
! Read number of atoms
|
|
||||||
read(1,*)
|
|
||||||
read(1,*)
|
|
||||||
read(1,*)
|
|
||||||
|
|
||||||
do i=1,nAt
|
|
||||||
read(1,*) ZNuc(i),rA(i,1),rA(i,2),rA(i,3)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Compute nuclear repulsion energy
|
|
||||||
ENuc = 0
|
|
||||||
|
|
||||||
do i=1,nAt-1
|
|
||||||
do j=i+1,nAt
|
|
||||||
RAB = (rA(i,1)-rA(j,1))**2 + (rA(i,2)-rA(j,2))**2 + (rA(i,3)-rA(j,3))**2
|
|
||||||
ENuc = ENuc + ZNuc(i)*ZNuc(j)/sqrt(RAB)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Close file with geometry specification
|
|
||||||
close(unit=1)
|
|
||||||
|
|
||||||
! Print geometry
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,'(A28)') 'Molecular geometry'
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
do i=1,NAt
|
|
||||||
write(*,'(A28,1X,I16)') 'Atom n. ',i
|
|
||||||
write(*,'(A28,1X,F16.10)') 'Z = ',ZNuc(i)
|
|
||||||
write(*,'(A28,1X,F16.10,F16.10,F16.10)') 'Atom coordinates:',(rA(i,j),j=1,3)
|
|
||||||
enddo
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,'(A28,1X,F16.10)') 'Nuclear repulsion energy = ',ENuc
|
|
||||||
write(*,'(A28)') '------------------'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
end subroutine read_geometry
|
|
@ -1,47 +0,0 @@
|
|||||||
subroutine read_grid(SGn,nRad,nAng,nGrid)
|
|
||||||
|
|
||||||
! Read grid type
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: SGn
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
integer,intent(out) :: nRad
|
|
||||||
integer,intent(out) :: nAng
|
|
||||||
integer,intent(out) :: nGrid
|
|
||||||
|
|
||||||
write(*,*)'----------------------------------------------------------'
|
|
||||||
write(*,'(A22,I1)')' Quadrature grid: SG-',SGn
|
|
||||||
write(*,*)'----------------------------------------------------------'
|
|
||||||
|
|
||||||
select case (SGn)
|
|
||||||
|
|
||||||
case(0)
|
|
||||||
nRad = 23
|
|
||||||
nAng = 170
|
|
||||||
|
|
||||||
case(1)
|
|
||||||
nRad = 50
|
|
||||||
nAng = 194
|
|
||||||
|
|
||||||
case(2)
|
|
||||||
nRad = 75
|
|
||||||
nAng = 302
|
|
||||||
|
|
||||||
case(3)
|
|
||||||
nRad = 99
|
|
||||||
nAng = 590
|
|
||||||
|
|
||||||
case default
|
|
||||||
write(*,*) '!!! Quadrature grid not available !!!'
|
|
||||||
stop
|
|
||||||
|
|
||||||
end select
|
|
||||||
|
|
||||||
nGrid = nRad*nAng
|
|
||||||
|
|
||||||
end subroutine read_grid
|
|
@ -1,114 +0,0 @@
|
|||||||
subroutine read_integrals(nBas,S,T,V,Hc,G)
|
|
||||||
|
|
||||||
! Read one- and two-electron integrals from files
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
logical :: debug
|
|
||||||
integer :: mu,nu,la,si
|
|
||||||
double precision :: Ov,Kin,Nuc,ERI
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),G(nBas,nBas,nBas,nBas)
|
|
||||||
|
|
||||||
! Open file with integrals
|
|
||||||
|
|
||||||
debug = .false.
|
|
||||||
|
|
||||||
open(unit=8 ,file='int/Ov.dat')
|
|
||||||
open(unit=9 ,file='int/Kin.dat')
|
|
||||||
open(unit=10,file='int/Nuc.dat')
|
|
||||||
open(unit=11,file='int/ERI.dat')
|
|
||||||
|
|
||||||
! Read overlap integrals
|
|
||||||
|
|
||||||
S = 0d0
|
|
||||||
do
|
|
||||||
read(8,*,end=8) mu,nu,Ov
|
|
||||||
S(mu,nu) = Ov
|
|
||||||
enddo
|
|
||||||
8 close(unit=8)
|
|
||||||
|
|
||||||
! Read kinetic integrals
|
|
||||||
|
|
||||||
T = 0d0
|
|
||||||
do
|
|
||||||
read(9,*,end=9) mu,nu,Kin
|
|
||||||
T(mu,nu) = Kin
|
|
||||||
enddo
|
|
||||||
9 close(unit=9)
|
|
||||||
|
|
||||||
! Read nuclear integrals
|
|
||||||
|
|
||||||
V = 0d0
|
|
||||||
do
|
|
||||||
read(10,*,end=10) mu,nu,Nuc
|
|
||||||
V(mu,nu) = Nuc
|
|
||||||
enddo
|
|
||||||
10 close(unit=10)
|
|
||||||
|
|
||||||
! Define core Hamiltonian
|
|
||||||
|
|
||||||
Hc = T + V
|
|
||||||
|
|
||||||
! Read nuclear integrals
|
|
||||||
|
|
||||||
G = 0d0
|
|
||||||
do
|
|
||||||
read(11,*,end=11) mu,nu,la,si,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)
|
|
||||||
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
if(debug) then
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Overlap integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
call matout(nBas,nBas,S)
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Kinetic integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
call matout(nBas,nBas,T)
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Nuclear integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
call matout(nBas,nBas,V)
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28)') 'Electron repulsion integrals'
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
do la=1,nBas
|
|
||||||
do si=1,nBas
|
|
||||||
call matout(nBas,nBas,G(1,1,la,si))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
write(*,*)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine read_integrals
|
|
@ -1,42 +0,0 @@
|
|||||||
subroutine read_molecule(nAt,nEl,nO)
|
|
||||||
|
|
||||||
! Read number of atoms nAt and number of electrons nEl
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
integer,intent(out) :: nAt,nEl,nO
|
|
||||||
|
|
||||||
! Open file with geometry specification
|
|
||||||
|
|
||||||
open(unit=1,file='input/molecule')
|
|
||||||
|
|
||||||
! Read number of atoms and number of electrons
|
|
||||||
|
|
||||||
read(1,*)
|
|
||||||
read(1,*) nAt,nEl
|
|
||||||
|
|
||||||
! Number of occupied orbitals
|
|
||||||
|
|
||||||
if(mod(nEl,2) /= 0) then
|
|
||||||
write(*,*) 'closed-shell system required!'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
nO = nEl/2
|
|
||||||
|
|
||||||
! Print results
|
|
||||||
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28,1X,I16)') 'Number of atoms',nAt
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,*)
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,'(A28,1X,I16)') 'Number of electrons',nEl
|
|
||||||
write(*,'(A28)') '----------------------'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
! Close file with geometry specification
|
|
||||||
|
|
||||||
close(unit=1)
|
|
||||||
|
|
||||||
end subroutine read_molecule
|
|
@ -1,31 +0,0 @@
|
|||||||
subroutine read_options(rung,SGn)
|
|
||||||
|
|
||||||
! Read DFT options
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(out) :: rung
|
|
||||||
integer,intent(out) :: SGn
|
|
||||||
|
|
||||||
! Open file with method specification
|
|
||||||
|
|
||||||
open(unit=1,file='input/options')
|
|
||||||
|
|
||||||
! Default values
|
|
||||||
|
|
||||||
rung = 1
|
|
||||||
SGn = 0
|
|
||||||
|
|
||||||
! Read rung of Jacob's ladder
|
|
||||||
|
|
||||||
read(1,*)
|
|
||||||
read(1,*) rung
|
|
||||||
|
|
||||||
! Read SG-n grid
|
|
||||||
|
|
||||||
read(1,*)
|
|
||||||
read(1,*) SGn
|
|
||||||
|
|
||||||
end subroutine read_options
|
|
@ -1,45 +0,0 @@
|
|||||||
subroutine select_rung(rung)
|
|
||||||
|
|
||||||
! Select rung of Jacob's ladder
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: rung
|
|
||||||
|
|
||||||
select case (rung)
|
|
||||||
|
|
||||||
! Hartree calculation
|
|
||||||
case(0)
|
|
||||||
write(*,*) " *** 0th rung of Jacob's ladder: Hartree calculation *** "
|
|
||||||
|
|
||||||
! LDA functionals
|
|
||||||
case(1)
|
|
||||||
write(*,*) " *** 1st rung of Jacob's ladder: local-density approximation (LDA) *** "
|
|
||||||
|
|
||||||
! GGA functionals
|
|
||||||
case(2)
|
|
||||||
write(*,*) " *** 2nd rung of Jacob's ladder: generalized gradient approximation (GGA) *** "
|
|
||||||
|
|
||||||
! meta-GGA functionals
|
|
||||||
case(3)
|
|
||||||
write(*,*) " *** 3rd rung of Jacob's ladder: meta-GGA functional (MGGA) *** "
|
|
||||||
|
|
||||||
! Hybrid functionals
|
|
||||||
case(4)
|
|
||||||
write(*,*) " *** 4th rung of Jacob's ladder: hybrid functional *** "
|
|
||||||
|
|
||||||
! Hartree-Fock calculation
|
|
||||||
case(666)
|
|
||||||
write(*,*) " *** rung 666: Hartree-Fock calculation *** "
|
|
||||||
|
|
||||||
! Default
|
|
||||||
case default
|
|
||||||
write(*,*) "!!! rung not available !!!"
|
|
||||||
stop
|
|
||||||
|
|
||||||
end select
|
|
||||||
|
|
||||||
end subroutine select_rung
|
|
@ -1,246 +0,0 @@
|
|||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine matout(m,n,A)
|
|
||||||
|
|
||||||
! Print the MxN array A
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer,parameter :: ncol = 5
|
|
||||||
double precision,parameter :: small = 1d-10
|
|
||||||
integer,intent(in) :: m,n
|
|
||||||
double precision,intent(in) :: A(m,n)
|
|
||||||
double precision :: B(ncol)
|
|
||||||
integer :: ilower,iupper,num,i,j
|
|
||||||
|
|
||||||
do ilower=1,n,ncol
|
|
||||||
iupper = min(ilower + ncol - 1,n)
|
|
||||||
num = iupper - ilower + 1
|
|
||||||
write(*,'(3X,10(9X,I6))') (j,j=ilower,iupper)
|
|
||||||
do i=1,m
|
|
||||||
do j=ilower,iupper
|
|
||||||
B(j-ilower+1) = A(i,j)
|
|
||||||
enddo
|
|
||||||
do j=1,num
|
|
||||||
if(abs(B(j)) < small) B(j) = 0d0
|
|
||||||
enddo
|
|
||||||
write(*,'(I7,10F15.8)') i,(B(j),j=1,num)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine matout
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
function trace_matrix(n,A) result(Tr)
|
|
||||||
|
|
||||||
! Calculate the trace of the square matrix A
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: n
|
|
||||||
double precision,intent(in) :: A(n,n)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: i
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision :: Tr
|
|
||||||
|
|
||||||
Tr = 0d0
|
|
||||||
do i=1,n
|
|
||||||
Tr = Tr + A(i,i)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end function trace_matrix
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine prepend(N,M,A,b)
|
|
||||||
|
|
||||||
! Prepend the vector b of size N into the matrix A of size NxM
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: N,M
|
|
||||||
double precision,intent(in) :: b(N)
|
|
||||||
|
|
||||||
! Local viaruabkes
|
|
||||||
|
|
||||||
integer :: i,j
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: A(N,M)
|
|
||||||
|
|
||||||
|
|
||||||
! print*,'b in append'
|
|
||||||
! call matout(N,1,b)
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=M-1,1,-1
|
|
||||||
A(i,j+1) = A(i,j)
|
|
||||||
enddo
|
|
||||||
A(i,1) = b(i)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine prepend
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine append(N,M,A,b)
|
|
||||||
|
|
||||||
! Append the vector b of size N into the matrix A of size NxM
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: N,M
|
|
||||||
double precision,intent(in) :: b(N)
|
|
||||||
|
|
||||||
! Local viaruabkes
|
|
||||||
|
|
||||||
integer :: i,j
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: A(N,M)
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=2,M
|
|
||||||
A(i,j-1) = A(i,j)
|
|
||||||
enddo
|
|
||||||
A(i,M) = b(i)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine append
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine AtDA(N,A,D,B)
|
|
||||||
|
|
||||||
! Perform B = At.D.A where A is a NxN matrix and D is a diagonal matrix given
|
|
||||||
! as a vector of length N
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
double precision,intent(in) :: A(N,N),D(N)
|
|
||||||
|
|
||||||
! Local viaruabkes
|
|
||||||
|
|
||||||
integer :: i,j,k
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: B(N,N)
|
|
||||||
|
|
||||||
B = 0d0
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=1,N
|
|
||||||
do k=1,N
|
|
||||||
B(i,k) = B(i,k) + A(j,i)*D(j)*A(j,k)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine AtDA
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine ADAt(N,A,D,B)
|
|
||||||
|
|
||||||
! Perform B = A.D.At where A is a NxN matrix and D is a diagonal matrix given
|
|
||||||
! as a vector of length N
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
double precision,intent(in) :: A(N,N),D(N)
|
|
||||||
|
|
||||||
! Local viaruabkes
|
|
||||||
|
|
||||||
integer :: i,j,k
|
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: B(N,N)
|
|
||||||
|
|
||||||
B = 0d0
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=1,N
|
|
||||||
do k=1,N
|
|
||||||
B(i,k) = B(i,k) + A(i,j)*D(j)*A(k,j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine ADAt
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine DA(N,D,A)
|
|
||||||
|
|
||||||
! Perform A <- D.A where A is a NxN matrix and D is a diagonal matrix given
|
|
||||||
! as a vector of length N
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
integer :: i,j
|
|
||||||
double precision,intent(in) :: D(N)
|
|
||||||
double precision,intent(inout):: A(N,N)
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=1,N
|
|
||||||
A(i,j) = D(i)*A(i,j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine DA
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
subroutine AD(N,A,D)
|
|
||||||
|
|
||||||
! Perform A <- A.D where A is a NxN matrix and D is a diagonal matrix given
|
|
||||||
! as a vector of length N
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
integer :: i,j
|
|
||||||
double precision,intent(in) :: D(N)
|
|
||||||
double precision,intent(inout):: A(N,N)
|
|
||||||
|
|
||||||
do i=1,N
|
|
||||||
do j=1,N
|
|
||||||
A(i,j) = A(i,j)*D(j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end subroutine AD
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
recursive function fac(n) result(fact)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer :: fact
|
|
||||||
integer, intent(in) :: n
|
|
||||||
|
|
||||||
if (n == 0) then
|
|
||||||
fact = 1
|
|
||||||
else
|
|
||||||
fact = n * fac(n-1)
|
|
||||||
end if
|
|
||||||
|
|
||||||
end function fac
|
|
||||||
|
|
||||||
function dfac(n) result(fact)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
double precision :: fact
|
|
||||||
integer, intent(in) :: n
|
|
||||||
integer :: fac
|
|
||||||
|
|
||||||
fact = dble(fac(n))
|
|
||||||
|
|
||||||
end function dfac
|
|
@ -1,147 +0,0 @@
|
|||||||
subroutine diagonalize_matrix(N,A,e)
|
|
||||||
|
|
||||||
! Diagonalize a square matrix
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
double precision,intent(inout):: A(N,N)
|
|
||||||
double precision,intent(out) :: e(N)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
integer :: lwork,info
|
|
||||||
double precision,allocatable :: work(:)
|
|
||||||
|
|
||||||
! Memory allocation
|
|
||||||
|
|
||||||
allocate(work(3*N))
|
|
||||||
lwork = size(work)
|
|
||||||
|
|
||||||
call dsyev('V','U',N,A,N,e,work,lwork,info)
|
|
||||||
|
|
||||||
if(info /= 0) then
|
|
||||||
print*,'Problem in diagonalize_matrix (dsyev)!!'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine diagonalize_matrix
|
|
||||||
|
|
||||||
subroutine svd(N,A,U,D,Vt)
|
|
||||||
|
|
||||||
! Compute A = U.D.Vt
|
|
||||||
! Dimension of A is NxN
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer, intent(in) :: N
|
|
||||||
double precision,intent(in) :: A(N,N)
|
|
||||||
double precision,intent(out) :: U(N,N)
|
|
||||||
double precision,intent(out) :: Vt(N,N)
|
|
||||||
double precision,intent(out) :: D(N)
|
|
||||||
double precision,allocatable :: work(:)
|
|
||||||
integer :: info,lwork
|
|
||||||
|
|
||||||
double precision,allocatable :: scr(:,:)
|
|
||||||
|
|
||||||
allocate (scr(N,N))
|
|
||||||
|
|
||||||
scr(:,:) = A(:,:)
|
|
||||||
|
|
||||||
! Find optimal size for temporary arrays
|
|
||||||
|
|
||||||
allocate(work(1))
|
|
||||||
|
|
||||||
lwork = -1
|
|
||||||
call dgesvd('A','A',N,N,scr,N,D,U,N,Vt,N,work,lwork,info)
|
|
||||||
lwork = int(work(1))
|
|
||||||
|
|
||||||
deallocate(work)
|
|
||||||
|
|
||||||
allocate(work(lwork))
|
|
||||||
|
|
||||||
call dgesvd('A','A',N,N,scr,N,D,U,N,Vt,N,work,lwork,info)
|
|
||||||
|
|
||||||
deallocate(work,scr)
|
|
||||||
|
|
||||||
if (info /= 0) then
|
|
||||||
print *, info, ': SVD failed'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine inverse_matrix(N,A,B)
|
|
||||||
|
|
||||||
! Returns the inverse of the square matrix A in B
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
double precision, intent(in) :: A(N,N)
|
|
||||||
double precision, intent(out) :: B(N,N)
|
|
||||||
|
|
||||||
integer :: info,lwork
|
|
||||||
integer, allocatable :: ipiv(:)
|
|
||||||
double precision,allocatable :: work(:)
|
|
||||||
|
|
||||||
allocate (ipiv(N),work(N*N))
|
|
||||||
lwork = size(work)
|
|
||||||
|
|
||||||
B(1:N,1:N) = A(1:N,1:N)
|
|
||||||
|
|
||||||
call dgetrf(N,N,B,N,ipiv,info)
|
|
||||||
|
|
||||||
if (info /= 0) then
|
|
||||||
|
|
||||||
print*,info
|
|
||||||
stop 'error in inverse (dgetrf)!!'
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
call dgetri(N,B,N,ipiv,work,lwork,info)
|
|
||||||
|
|
||||||
if (info /= 0) then
|
|
||||||
|
|
||||||
print *, info
|
|
||||||
stop 'error in inverse (dgetri)!!'
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
deallocate(ipiv,work)
|
|
||||||
|
|
||||||
end subroutine inverse_matrix
|
|
||||||
|
|
||||||
subroutine linear_solve(N,A,b,x)
|
|
||||||
|
|
||||||
! Solve the linear system A.x = b where A is a NxN matrix
|
|
||||||
! and x and x are vectors of size N
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer,intent(in) :: N
|
|
||||||
double precision,intent(in) :: A(N,N),b(N)
|
|
||||||
double precision,intent(out) :: x(N)
|
|
||||||
|
|
||||||
integer :: info,lwork
|
|
||||||
integer,allocatable :: ipiv(:)
|
|
||||||
double precision,allocatable :: work(:)
|
|
||||||
|
|
||||||
allocate(ipiv(N),work(N*N))
|
|
||||||
lwork = size(work)
|
|
||||||
|
|
||||||
x = b
|
|
||||||
|
|
||||||
call dsysv('U',N,1,A,N,ipiv,x,N,work,lwork,info)
|
|
||||||
|
|
||||||
if (info /= 0) then
|
|
||||||
|
|
||||||
print *, info
|
|
||||||
stop 'error in linear_solve (dsysv)!!'
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine linear_solve
|
|
||||||
|
|
@ -1,120 +0,0 @@
|
|||||||
program xcDFT
|
|
||||||
|
|
||||||
! exchange-correlation density-functional theory calculations
|
|
||||||
|
|
||||||
include 'parameters.h'
|
|
||||||
|
|
||||||
integer :: nAt,nBas,nEl,nO,nV
|
|
||||||
double precision :: ENuc,EKS
|
|
||||||
|
|
||||||
double precision,allocatable :: ZNuc(:),rAt(:,:)
|
|
||||||
|
|
||||||
integer :: nShell
|
|
||||||
integer,allocatable :: TotAngMomShell(:)
|
|
||||||
integer,allocatable :: KShell(:)
|
|
||||||
double precision,allocatable :: CenterShell(:,:)
|
|
||||||
double precision,allocatable :: DShell(:,:)
|
|
||||||
double precision,allocatable :: ExpShell(:,:)
|
|
||||||
|
|
||||||
double precision,allocatable :: S(:,:),T(:,:),V(:,:),Hc(:,:),X(:,:)
|
|
||||||
double precision,allocatable :: ERI(:,:,:,:)
|
|
||||||
|
|
||||||
integer :: rung
|
|
||||||
integer :: SGn
|
|
||||||
integer :: nRad,nAng,nGrid
|
|
||||||
double precision,allocatable :: root(:,:)
|
|
||||||
double precision,allocatable :: weight(:)
|
|
||||||
double precision,allocatable :: AO(:,:)
|
|
||||||
double precision,allocatable :: dAO(:,:,:)
|
|
||||||
|
|
||||||
double precision :: start_KS,end_KS,t_KS
|
|
||||||
|
|
||||||
! Hello World
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '********************************'
|
|
||||||
write(*,*) '* TCCM winter school 2008: DFT *'
|
|
||||||
write(*,*) '********************************'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Read input information
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
! Read number of atoms, number of electrons of the system
|
|
||||||
! nO = number of occupied orbitals
|
|
||||||
! nV = number of virtual orbitals (see below)
|
|
||||||
! nBas = number of basis functions (see below)
|
|
||||||
! = nO + nV
|
|
||||||
|
|
||||||
call read_molecule(nAt,nEl,nO)
|
|
||||||
allocate(ZNuc(nAt),rAt(nAt,3))
|
|
||||||
|
|
||||||
! Read geometry
|
|
||||||
|
|
||||||
call read_geometry(nAt,ZNuc,rAt,ENuc)
|
|
||||||
|
|
||||||
allocate(CenterShell(maxShell,3),TotAngMomShell(maxShell),KShell(maxShell), &
|
|
||||||
DShell(maxShell,maxK),ExpShell(maxShell,maxK))
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Read basis set information
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
call read_basis(nAt,rAt,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Read one- and two-electron integrals
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
! Memory allocation for one- and two-electron integrals
|
|
||||||
|
|
||||||
allocate(S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas), &
|
|
||||||
ERI(nBas,nBas,nBas,nBas))
|
|
||||||
|
|
||||||
! Read integrals
|
|
||||||
|
|
||||||
call read_integrals(nBas,S,T,V,Hc,ERI)
|
|
||||||
|
|
||||||
! Orthogonalization X = S^(-1/2)
|
|
||||||
|
|
||||||
call orthogonalization_matrix(nBas,S,X)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! DFT options
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
call read_options(rung,SGn)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Construct quadrature grid
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
call read_grid(SGn,nRad,nAng,nGrid)
|
|
||||||
|
|
||||||
allocate(root(3,nGrid),weight(nGrid))
|
|
||||||
call quadrature_grid(nRad,nAng,nGrid,root,weight)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Calculate AO values at grid points
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
allocate(AO(nBas,nGrid),dAO(3,nBas,nGrid))
|
|
||||||
call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
|
|
||||||
nGrid,root,AO,dAO)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Compute KS energy
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
|
|
||||||
call cpu_time(start_KS)
|
|
||||||
call RKS(rung,nGrid,weight,nBas,AO,dAO,nO,S,T,V,Hc,ERI,X,ENuc,EKS)
|
|
||||||
call cpu_time(end_KS)
|
|
||||||
|
|
||||||
t_KS = end_KS - start_KS
|
|
||||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for KS = ',t_KS,' seconds'
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! End of xcDFT
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
end program xcDFT
|
|
Loading…
Reference in New Issue
Block a user