mirror of
https://github.com/pfloos/quack
synced 2024-12-22 20:34:46 +01:00
R or U
This commit is contained in:
parent
6cff7ad77a
commit
e14e8ac278
329
src/eDFT/GOK_RKS.f90
Normal file
329
src/eDFT/GOK_RKS.f90
Normal file
@ -0,0 +1,329 @@
|
||||
subroutine GOK_RKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nGrid,weight,maxSCF,thresh,max_diis,guess_type, &
|
||||
nBas,AO,dAO,nO,nV,S,T,V,Hc,ERI,X,ENuc,Ew)
|
||||
|
||||
! Perform restricted Kohn-Sham calculation for ensembles
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: x_rung,c_rung
|
||||
character(len=12),intent(in) :: x_DFA,c_DFA
|
||||
integer,intent(in) :: nEns
|
||||
double precision,intent(in) :: wEns(nEns)
|
||||
integer,intent(in) :: nGrid
|
||||
double precision,intent(in) :: weight(nGrid)
|
||||
integer,intent(in) :: maxSCF,max_diis,guess_type
|
||||
double precision,intent(in) :: thresh
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: AO(nBas,nGrid)
|
||||
double precision,intent(in) :: dAO(ncart,nBas,nGrid)
|
||||
|
||||
integer,intent(in) :: nO,nV
|
||||
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 :: xc_rung
|
||||
integer :: nSCF,nBasSq
|
||||
integer :: n_diis
|
||||
double precision :: conv
|
||||
double precision :: rcond
|
||||
double precision :: ET
|
||||
double precision :: EV
|
||||
double precision :: EJ
|
||||
double precision :: Ex
|
||||
double precision :: Ec
|
||||
double precision :: Ew
|
||||
|
||||
double precision,allocatable :: eps(:)
|
||||
double precision,allocatable :: c(:,:)
|
||||
double precision,allocatable :: cp(:,:)
|
||||
double precision,allocatable :: J(:,:)
|
||||
double precision,allocatable :: F(:,:)
|
||||
double precision,allocatable :: Fp(:,:)
|
||||
double precision,allocatable :: Fx(:,:)
|
||||
double precision,allocatable :: FxHF(:,:)
|
||||
double precision,allocatable :: Fc(:,:)
|
||||
double precision,allocatable :: err(:,:)
|
||||
double precision,allocatable :: err_diis(:,:)
|
||||
double precision,allocatable :: F_diis(:,:)
|
||||
double precision,external :: trace_matrix
|
||||
double precision,external :: electron_number
|
||||
|
||||
double precision,allocatable :: Pw(:,:)
|
||||
double precision,allocatable :: rhow(:)
|
||||
double precision,allocatable :: drhow(:,:)
|
||||
double precision :: nEl
|
||||
|
||||
double precision,allocatable :: P(:,:,:)
|
||||
double precision,allocatable :: rho(:,:)
|
||||
double precision,allocatable :: drho(:,:,:)
|
||||
|
||||
double precision :: E(nEns)
|
||||
double precision :: Om(nEns)
|
||||
|
||||
integer :: iEns
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)'* Restricted Kohn-Sham calculation *'
|
||||
write(*,*)'* *** for ensembles *** *'
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)
|
||||
|
||||
! Useful stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Rung of Jacob's ladder
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Select rung for exchange
|
||||
|
||||
write(*,*)
|
||||
write(*,*) '*******************************************************************'
|
||||
write(*,*) '* Exchange rung *'
|
||||
write(*,*) '*******************************************************************'
|
||||
|
||||
call select_rung(x_rung,x_DFA)
|
||||
|
||||
! Select rung for correlation
|
||||
|
||||
write(*,*)
|
||||
write(*,*) '*******************************************************************'
|
||||
write(*,*) '* Correlation rung *'
|
||||
write(*,*) '*******************************************************************'
|
||||
|
||||
call select_rung(c_rung,c_DFA)
|
||||
|
||||
! Overall rung
|
||||
|
||||
xc_rung = max(x_rung,c_rung)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eps(nBas),c(nBas,nBas),cp(nBas,nBas), &
|
||||
J(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
Fx(nBas,nBas),FxHF(nBas,nBas),Fc(nBas,nBas),err(nBas,nBas), &
|
||||
Pw(nBas,nBas),rhow(nGrid),drhow(ncart,nGrid), &
|
||||
err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis), &
|
||||
P(nBas,nBas,nEns),rho(nGrid,nEns),drho(ncart,nGrid,nEns))
|
||||
|
||||
! Guess coefficients and eigenvalues
|
||||
|
||||
if(guess_type == 1) then
|
||||
|
||||
F(:,:) = Hc(:,:)
|
||||
|
||||
else if(guess_type == 2) then
|
||||
|
||||
call random_number(F(:,:))
|
||||
|
||||
end if
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
conv = 1d0
|
||||
|
||||
nEl = 0d0
|
||||
Ex = 0d0
|
||||
Ec = 0d0
|
||||
|
||||
Fx(:,:) = 0d0
|
||||
FxHF(:,:) = 0d0
|
||||
Fc(:,:) = 0d0
|
||||
|
||||
n_diis = 0
|
||||
F_diis(:,:) = 0d0
|
||||
err_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)') &
|
||||
'|','#','|','E(KS)','|','Ex(KS)','|','Ec(KS)','|','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(:,:),eps(:))
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
c(:,:) = matmul(X(:,:),cp(:,:))
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute density matrix
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call density_matrix(nBas,nEns,nO,c(:,:),P(:,:,:))
|
||||
|
||||
! Weight-dependent density matrix
|
||||
|
||||
Pw(:,:) = 0d0
|
||||
do iEns=1,nEns
|
||||
Pw(:,:) = Pw(:,:) + wEns(iEns)*P(:,:,iEns)
|
||||
end do
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute one-electron density and its gradient if necessary
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
do iEns=1,nEns
|
||||
call density(nGrid,nBas,P(:,:,iEns),AO(:,:),rho(:,iEns))
|
||||
end do
|
||||
|
||||
! Weight-dependent one-electron density
|
||||
|
||||
rhow(:) = 0d0
|
||||
do iEns=1,nEns
|
||||
rhow(:) = rhow(:) + wEns(iEns)*rho(:,iEns)
|
||||
end do
|
||||
|
||||
if(xc_rung > 1 .and. xc_rung /= 666) then
|
||||
|
||||
! Ground state density
|
||||
|
||||
do iEns=1,nEns
|
||||
call gradient_density(nGrid,nBas,P(:,:,iEns),AO(:,:),dAO(:,:,:),drho(:,:,iEns))
|
||||
end do
|
||||
|
||||
! Weight-dependent one-electron density
|
||||
|
||||
drhow(:,:) = 0d0
|
||||
do iEns=1,nEns
|
||||
drhow(:,:) = drhow(:,:) + wEns(iEns)*drho(:,:,iEns)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
! Build Coulomb repulsion
|
||||
|
||||
call hartree_coulomb(nBas,Pw(:,:),ERI(:,:,:,:),J(:,:))
|
||||
|
||||
! Compute exchange potential
|
||||
|
||||
call exchange_potential(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas,Pw(:,:),ERI(:,:,:,:), &
|
||||
AO(:,:),dAO(:,:,:),rhow(:),drhow(:,:),Fx(:,:),FxHF(:,:))
|
||||
|
||||
! Compute correlation potential
|
||||
|
||||
call correlation_potential(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),dAO(:,:,:),rhow(:),drhow(:,:),Fc(:,:))
|
||||
|
||||
! Build Fock operator
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + J(:,:) + Fx(:,:) + Fc(:,:)
|
||||
|
||||
! Check convergence
|
||||
|
||||
err(:,:) = matmul(F(:,:),matmul(Pw(:,:),S(:,:))) - matmul(matmul(S(:,:),Pw(:,:)),F(:,:))
|
||||
|
||||
conv = maxval(abs(err(:,:)))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis(:,:),F_diis(:,:),err(:,:),F(:,:))
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(abs(rcond) < 1d-15) n_diis = 0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute KS energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(Pw(:,:),T(:,:)))
|
||||
|
||||
! Potential energy
|
||||
|
||||
EV = trace_matrix(nBas,matmul(Pw(:,:),V(:,:)))
|
||||
|
||||
! Coulomb energy
|
||||
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:),J(:,:)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
call exchange_energy(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas, &
|
||||
Pw(:,:),FxHF(:,:),rhow(:),drhow(:,:),Ex)
|
||||
|
||||
! Correlation energy
|
||||
|
||||
call correlation_energy(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rhow(:),drhow(:,:),Ec)
|
||||
|
||||
! Total energy
|
||||
|
||||
Ew = ET + EV + EJ + Ex + Ec
|
||||
|
||||
! Check the grid accuracy by computing the number of electrons
|
||||
|
||||
nEl = electron_number(nGrid,weight(:),rhow(:))
|
||||
|
||||
! 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,'|',Ew + ENuc,'|',Ex,'|',Ec,'|',conv,'|',nEl,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'------------------------------------------------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Compute final KS energy
|
||||
|
||||
call print_RKS(nBas,nO,eps(:),c(:,:),ENuc,ET,EV,EJ,Ex,Ec,Ew)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute individual energies from ensemble energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call individual_energy(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas, &
|
||||
AO(:,:),dAO(:,:,:),nO,nV,T(:,:),V(:,:),ERI(:,:,:,:),ENuc, &
|
||||
Pw(:,:),rhow(:),drhow(:,:),J(:,:),Fx(:,:),FxHF(:,:), &
|
||||
Fc(:,:),P(:,:,:),rho(:,:),drho(:,:,:),E(:),Om(:))
|
||||
|
||||
end subroutine GOK_RKS
|
||||
363
src/eDFT/GOK_UKS.f90
Normal file
363
src/eDFT/GOK_UKS.f90
Normal file
@ -0,0 +1,363 @@
|
||||
subroutine GOK_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nGrid,weight,maxSCF,thresh,max_diis,guess_type, &
|
||||
nBas,AO,dAO,nO,nV,S,T,V,Hc,ERI,X,ENuc,Ew)
|
||||
|
||||
! Perform unrestricted Kohn-Sham calculation for ensembles
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: x_rung,c_rung
|
||||
character(len=12),intent(in) :: x_DFA,c_DFA
|
||||
integer,intent(in) :: nEns
|
||||
double precision,intent(in) :: wEns(nEns)
|
||||
integer,intent(in) :: nGrid
|
||||
double precision,intent(in) :: weight(nGrid)
|
||||
integer,intent(in) :: maxSCF,max_diis,guess_type
|
||||
double precision,intent(in) :: thresh
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: AO(nBas,nGrid)
|
||||
double precision,intent(in) :: dAO(ncart,nBas,nGrid)
|
||||
|
||||
integer,intent(in) :: nO(nspin),nV(nspin)
|
||||
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 :: xc_rung
|
||||
integer :: nSCF,nBasSq
|
||||
integer :: n_diis
|
||||
double precision :: conv
|
||||
double precision :: rcond(nspin)
|
||||
double precision :: ET(nspin)
|
||||
double precision :: EV(nspin)
|
||||
double precision :: EJ(nsp)
|
||||
double precision :: Ex(nspin)
|
||||
double precision :: Ec(nsp)
|
||||
double precision :: Ew
|
||||
|
||||
double precision,allocatable :: eps(:,:)
|
||||
double precision,allocatable :: c(:,:,:)
|
||||
double precision,allocatable :: cp(:,:,:)
|
||||
double precision,allocatable :: J(:,:,:)
|
||||
double precision,allocatable :: F(:,:,:)
|
||||
double precision,allocatable :: Fp(:,:,:)
|
||||
double precision,allocatable :: Fx(:,:,:)
|
||||
double precision,allocatable :: FxHF(:,:,:)
|
||||
double precision,allocatable :: Fc(:,:,:)
|
||||
double precision,allocatable :: err(:,:,:)
|
||||
double precision,allocatable :: err_diis(:,:,:)
|
||||
double precision,allocatable :: F_diis(:,:,:)
|
||||
double precision,external :: trace_matrix
|
||||
double precision,external :: electron_number
|
||||
|
||||
double precision,allocatable :: Pw(:,:,:)
|
||||
double precision,allocatable :: rhow(:,:)
|
||||
double precision,allocatable :: drhow(:,:,:)
|
||||
double precision :: nEl(nspin)
|
||||
|
||||
double precision,allocatable :: P(:,:,:,:)
|
||||
double precision,allocatable :: rho(:,:,:)
|
||||
double precision,allocatable :: drho(:,:,:,:)
|
||||
|
||||
double precision :: E(nEns)
|
||||
double precision :: Om(nEns)
|
||||
|
||||
integer :: ispin,iEns
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)'* Unrestricted Kohn-Sham calculation *'
|
||||
write(*,*)'* *** for ensembles *** *'
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)
|
||||
|
||||
! Useful stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Rung of Jacob's ladder
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Select rung for exchange
|
||||
|
||||
write(*,*)
|
||||
write(*,*) '*******************************************************************'
|
||||
write(*,*) '* Exchange rung *'
|
||||
write(*,*) '*******************************************************************'
|
||||
|
||||
call select_rung(x_rung,x_DFA)
|
||||
|
||||
! Select rung for correlation
|
||||
|
||||
write(*,*)
|
||||
write(*,*) '*******************************************************************'
|
||||
write(*,*) '* Correlation rung *'
|
||||
write(*,*) '*******************************************************************'
|
||||
|
||||
call select_rung(c_rung,c_DFA)
|
||||
|
||||
! Overall rung
|
||||
|
||||
xc_rung = max(x_rung,c_rung)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eps(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin), &
|
||||
J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), &
|
||||
Fx(nBas,nBas,nspin),FxHF(nBas,nBas,nspin),Fc(nBas,nBas,nspin),err(nBas,nBas,nspin), &
|
||||
Pw(nBas,nBas,nspin),rhow(nGrid,nspin),drhow(ncart,nGrid,nspin), &
|
||||
err_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin), &
|
||||
P(nBas,nBas,nspin,nEns),rho(nGrid,nspin,nEns),drho(ncart,nGrid,nspin,nEns))
|
||||
|
||||
! Guess coefficients and eigenvalues
|
||||
|
||||
if(guess_type == 1) then
|
||||
|
||||
do ispin=1,nspin
|
||||
F(:,:,ispin) = Hc(:,:)
|
||||
end do
|
||||
|
||||
else if(guess_type == 2) then
|
||||
|
||||
do ispin=1,nspin
|
||||
call random_number(F(:,:,ispin))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
conv = 1d0
|
||||
|
||||
nEl(:) = 0d0
|
||||
Ex(:) = 0d0
|
||||
Ec(:) = 0d0
|
||||
|
||||
Fx(:,:,:) = 0d0
|
||||
FxHF(:,:,:) = 0d0
|
||||
Fc(:,:,:) = 0d0
|
||||
|
||||
n_diis = 0
|
||||
F_diis(:,:,:) = 0d0
|
||||
err_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)') &
|
||||
'|','#','|','E(KS)','|','Ex(KS)','|','Ec(KS)','|','Conv','|','nEl','|'
|
||||
write(*,*)'------------------------------------------------------------------------------------------'
|
||||
|
||||
do while(conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
do ispin=1,nspin
|
||||
Fp(:,:,ispin) = matmul(transpose(X(:,:)),matmul(F(:,:,ispin),X(:,:)))
|
||||
end do
|
||||
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
cp(:,:,:) = Fp(:,:,:)
|
||||
do ispin=1,nspin
|
||||
call diagonalize_matrix(nBas,cp(:,:,ispin),eps(:,ispin))
|
||||
end do
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
do ispin=1,nspin
|
||||
c(:,:,ispin) = matmul(X(:,:),cp(:,:,ispin))
|
||||
end do
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute density matrix
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call density_matrix(nBas,nEns,nO(:),c(:,:,:),P(:,:,:,:))
|
||||
|
||||
! Weight-dependent density matrix
|
||||
|
||||
Pw(:,:,:) = 0d0
|
||||
do iEns=1,nEns
|
||||
Pw(:,:,:) = Pw(:,:,:) + wEns(iEns)*P(:,:,:,iEns)
|
||||
end do
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute one-electron density and its gradient if necessary
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
do ispin=1,nspin
|
||||
do iEns=1,nEns
|
||||
call density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),rho(:,ispin,iEns))
|
||||
end do
|
||||
end do
|
||||
|
||||
! Weight-dependent one-electron density
|
||||
|
||||
rhow(:,:) = 0d0
|
||||
do iEns=1,nEns
|
||||
rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns)
|
||||
end do
|
||||
|
||||
if(xc_rung > 1 .and. xc_rung /= 666) then
|
||||
|
||||
! Ground state density
|
||||
|
||||
do ispin=1,nspin
|
||||
do iEns=1,nEns
|
||||
! call gradient_density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),dAO(:,:,:),drho(:,:,ispin,iEns))
|
||||
end do
|
||||
end do
|
||||
|
||||
! Weight-dependent one-electron density
|
||||
|
||||
drhow(:,:,:) = 0d0
|
||||
do iEns=1,nEns
|
||||
drhow(:,:,:) = drhow(:,:,:) + wEns(iEns)*drho(:,:,:,iEns)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
! Build Coulomb repulsion
|
||||
|
||||
do ispin=1,nspin
|
||||
call hartree_coulomb(nBas,Pw(:,:,ispin),ERI(:,:,:,:),J(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Compute exchange potential
|
||||
|
||||
do ispin=1,nspin
|
||||
call exchange_potential(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas,Pw(:,:,ispin),ERI(:,:,:,:), &
|
||||
AO(:,:),dAO(:,:,:),rhow(:,ispin),drhow(:,:,ispin),Fx(:,:,ispin),FxHF(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Compute correlation potential
|
||||
|
||||
call correlation_potential(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),dAO(:,:,:),rhow(:,:),drhow(:,:,:),Fc(:,:,:))
|
||||
|
||||
! Build Fock operator
|
||||
do ispin=1,nspin
|
||||
F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + Fx(:,:,ispin) + Fc(:,:,ispin)
|
||||
end do
|
||||
|
||||
! Check convergence
|
||||
|
||||
do ispin=1,nspin
|
||||
err(:,:,ispin) = matmul(F(:,:,ispin),matmul(Pw(:,:,ispin),S(:,:))) - matmul(matmul(S(:,:),Pw(:,:,ispin)),F(:,:,ispin))
|
||||
end do
|
||||
|
||||
conv = maxval(abs(err(:,:,:)))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
do ispin=1,nspin
|
||||
call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis, &
|
||||
err_diis(:,:,ispin),F_diis(:,:,ispin),err(:,:,ispin),F(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(minval(rcond(:)) < 1d-15) n_diis = 0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute KS energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),V(:,:)))
|
||||
end do
|
||||
|
||||
! Coulomb energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
call exchange_energy(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas, &
|
||||
Pw(:,:,ispin),FxHF(:,:,ispin),rhow(:,ispin),drhow(:,:,ispin),Ex(ispin))
|
||||
end do
|
||||
|
||||
! Correlation energy
|
||||
|
||||
call correlation_energy(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),drhow(:,:,:),Ec)
|
||||
|
||||
! Total energy
|
||||
|
||||
Ew = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:))
|
||||
|
||||
! Check the grid accuracy by computing the number of electrons
|
||||
|
||||
do ispin=1,nspin
|
||||
nEl(ispin) = electron_number(nGrid,weight(:),rhow(:,ispin))
|
||||
end do
|
||||
|
||||
! 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,'|',Ew + ENuc,'|',sum(Ex(:)),'|',sum(Ec(:)),'|',conv,'|',sum(nEl(:)),'|'
|
||||
|
||||
end do
|
||||
write(*,*)'------------------------------------------------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Compute final KS energy
|
||||
|
||||
call print_UKS(nBas,nO(:),eps(:,:),c(:,:,:),ENuc,ET(:),EV(:),EJ(:),Ex(:),Ec(:),Ew)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute individual energies from ensemble energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call individual_energy(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas, &
|
||||
AO(:,:),dAO(:,:,:),nO(:),nV(:),T(:,:),V(:,:),ERI(:,:,:,:),ENuc, &
|
||||
Pw(:,:,:),rhow(:,:),drhow(:,:,:),J(:,:,:),Fx(:,:,:),FxHF(:,:,:), &
|
||||
Fc(:,:,:),P(:,:,:,:),rho(:,:,:),drho(:,:,:,:),E(:),Om(:))
|
||||
|
||||
end subroutine GOK_UKS
|
||||
50
src/eDFT/RMFL20_lda_exchange_energy.f90
Normal file
50
src/eDFT/RMFL20_lda_exchange_energy.f90
Normal file
@ -0,0 +1,50 @@
|
||||
subroutine RMFL20_lda_exchange_energy(nEns,wEns,nGrid,weight,rho,Ex)
|
||||
|
||||
! Compute restricted version of Marut-Fromager-Loos weight-dependent LDA exchange energy
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nEns
|
||||
double precision,intent(in) :: wEns(nEns)
|
||||
integer,intent(in) :: nGrid
|
||||
double precision,intent(in) :: weight(nGrid)
|
||||
double precision,intent(in) :: rho(nGrid)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: CxLDA
|
||||
double precision :: Cx2
|
||||
double precision :: Cxw
|
||||
double precision :: r
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision :: Ex
|
||||
|
||||
! Cx coefficient for Slater LDA exchange
|
||||
|
||||
CxLDA = -(4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
Cx2 = -(176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
|
||||
Cxw = (1d0 - wEns(2))*CxLDA + wEns(2)*(Cx2 - CxLDA)
|
||||
|
||||
! Compute LDA exchange energy
|
||||
|
||||
Ex = 0d0
|
||||
do iG=1,nGrid
|
||||
|
||||
r = max(0d0,rho(iG))
|
||||
|
||||
if(r > threshold) then
|
||||
|
||||
Ex = Ex + weight(iG)*Cxw*r**(4d0/3d0)
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
end subroutine RMFL20_lda_exchange_energy
|
||||
72
src/eDFT/print_RKS.f90
Normal file
72
src/eDFT/print_RKS.f90
Normal file
@ -0,0 +1,72 @@
|
||||
subroutine print_RKS(nBas,nO,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew)
|
||||
|
||||
! Print one- and two-electron energies and other stuff for KS calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO
|
||||
double precision,intent(in) :: eps(nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ET
|
||||
double precision,intent(in) :: EV
|
||||
double precision,intent(in) :: EJ
|
||||
double precision,intent(in) :: Ex
|
||||
double precision,intent(in) :: Ec
|
||||
double precision,intent(in) :: Ew
|
||||
|
||||
integer :: HOMO
|
||||
integer :: LUMO
|
||||
double precision :: Gap
|
||||
|
||||
! HOMO, LUMO, and Gap
|
||||
|
||||
HOMO = nO
|
||||
|
||||
LUMO = HOMO + 1
|
||||
|
||||
Gap = eps(LUMO) - eps(HOMO)
|
||||
|
||||
! Dump results
|
||||
|
||||
|
||||
write(*,*)
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40)') ' Summary '
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' One-electron energy: ',ET + EV,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Kinetic energy: ',ET,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Potential energy: ',EV,' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex + Ec,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Coulomb energy: ',EJ,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',Ew,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Kohn-Sham energy: ',Ew + ENuc,' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,F13.6,A3)') ' KS HOMO energy:',eps(HOMO)*HatoeV,' eV'
|
||||
write(*,'(A40,F13.6,A3)') ' KS LUMO energy:',eps(LUMO)*HatoeV,' eV'
|
||||
write(*,'(A40,F13.6,A3)') ' KS HOMO-LUMO gap:',Gap*HatoeV,' eV'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
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,eps(:))
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_RKS
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine print_KS(nBas,nO,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew)
|
||||
subroutine print_UKS(nBas,nO,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew)
|
||||
|
||||
! Print one- and two-electron energies and other stuff for KS calculation
|
||||
|
||||
@ -99,4 +99,4 @@ subroutine print_KS(nBas,nO,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew)
|
||||
call matout(nBas,1,eps(:,2))
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_KS
|
||||
end subroutine print_UKS
|
||||
Loading…
Reference in New Issue
Block a user