10
1
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:34:46 +01:00

starting modifying code for clotilde

This commit is contained in:
Pierre-Francois Loos 2020-03-15 08:23:01 +01:00
parent 0be0d5d8c3
commit 6cff7ad77a
5 changed files with 44 additions and 371 deletions

View File

@ -1,3 +1,5 @@
# Restricted or unrestricted KS calculation
RKS
# exchange rung: Hartree = 0, LDA = 1 (S51), GGA = 2(G96,B88), hybrid = 4, Hartree-Fock = 666
1 S51
# correlation rung: Hartree = 0, LDA = 1 (W38,VWN5,C16,LF19), GGA = 2(LYP), hybrid = 4(B3LYP), Hartree-Fock = 666

View File

@ -1,363 +0,0 @@
subroutine Kohn_Sham(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_KS(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 Kohn_Sham

View File

@ -21,6 +21,7 @@ program eDFT
double precision,allocatable :: S(:,:),T(:,:),V(:,:),Hc(:,:),X(:,:)
double precision,allocatable :: ERI(:,:,:,:)
character(len=7) :: method
integer :: x_rung,c_rung
character(len=12) :: x_DFA ,c_DFA
integer :: SGn
@ -85,7 +86,8 @@ program eDFT
! Allocate ensemble weights
allocate(wEns(maxEns))
call read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type)
call read_options(method,x_rung,x_DFA,c_rung,c_DFA,SGn, &
nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type)
!------------------------------------------------------------------------
! Read one- and two-electron integrals
@ -129,18 +131,39 @@ program eDFT
call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell,nGrid,root,AO,dAO)
!------------------------------------------------------------------------
! Compute KS energy
! Compute RKS energy
!------------------------------------------------------------------------
if(method == 'GOK-RKS') then
call cpu_time(start_KS)
call Kohn_Sham(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),maxSCF,thresh,max_diis,guess_type, &
call 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,EKS)
call cpu_time(end_KS)
t_KS = end_KS - start_KS
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RKS = ',t_KS,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Compute UKS energy
!------------------------------------------------------------------------
if(method == 'GOK-UKS') then
call cpu_time(start_KS)
call 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,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(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! End of eDFT
!------------------------------------------------------------------------

View File

@ -28,6 +28,10 @@ subroutine lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,Ex)
call S51_lda_exchange_energy(nGrid,weight,rho,Ex)
case ('MFL20')
call RMFL20_lda_exchange_energy(nEns,wEns,nGrid,weight,rho,Ex)
case default
call print_warning('!!! LDA exchange functional not available !!!')

View File

@ -1,4 +1,4 @@
subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type)
subroutine read_options(method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type)
! Read DFT options
@ -12,8 +12,9 @@ subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DI
! Output variables
character(len=7),intent(out) :: method
integer,intent(out) :: x_rung,c_rung
character(len=12),intent(out) :: x_DFA, c_DFA
character(len=3),intent(out) :: x_DFA, c_DFA
integer,intent(out) :: SGn
integer,intent(out) :: nEns
double precision,intent(out) :: wEns(maxEns)
@ -31,10 +32,11 @@ subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DI
! Open file with method specification
open(unit=1,file='input/dft')
open(unit=40,file='input/dft')
! Default values
method = 'GOK-RKS'
x_rung = 1
c_rung = 1
x_DFA = 'S51'
@ -42,6 +44,11 @@ subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DI
SGn = 0
wEns(:) = 0d0
! Restricted or unrestricted calculation
read(1,*)
read(1,*) method
! EXCHANGE: read rung of Jacob's ladder
read(1,*)
@ -101,6 +108,6 @@ subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DI
! Close file with options
close(unit=1)
close(unit=40)
end subroutine read_options