diff --git a/src/eDFT/GOK_RKS.f90 b/src/eDFT/GOK_RKS.f90 new file mode 100644 index 0000000..c294628 --- /dev/null +++ b/src/eDFT/GOK_RKS.f90 @@ -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 diff --git a/src/eDFT/GOK_UKS.f90 b/src/eDFT/GOK_UKS.f90 new file mode 100644 index 0000000..0f1b4a9 --- /dev/null +++ b/src/eDFT/GOK_UKS.f90 @@ -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 diff --git a/src/eDFT/RMFL20_lda_exchange_energy.f90 b/src/eDFT/RMFL20_lda_exchange_energy.f90 new file mode 100644 index 0000000..fc5cd65 --- /dev/null +++ b/src/eDFT/RMFL20_lda_exchange_energy.f90 @@ -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 diff --git a/src/eDFT/print_RKS.f90 b/src/eDFT/print_RKS.f90 new file mode 100644 index 0000000..1cc19c1 --- /dev/null +++ b/src/eDFT/print_RKS.f90 @@ -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 diff --git a/src/eDFT/print_KS.f90 b/src/eDFT/print_UKS.f90 similarity index 98% rename from src/eDFT/print_KS.f90 rename to src/eDFT/print_UKS.f90 index 2c1d542..80be911 100644 --- a/src/eDFT/print_KS.f90 +++ b/src/eDFT/print_UKS.f90 @@ -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