2021-11-29 13:21:45 +01:00
|
|
|
subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,AO,dAO, &
|
2021-12-01 10:54:51 +01:00
|
|
|
T,V,ERI,ENuc,eKS,Pw,rhow,drhow,J,Fx,FxHF,Fc,P,rho,drho,occnum,Cx_choice,doNcentered,Ew)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
! Compute unrestricted individual energies as well as excitation energies
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
include 'parameters.h'
|
|
|
|
|
|
|
|
! Input variables
|
|
|
|
|
|
|
|
integer,intent(in) :: x_rung,c_rung
|
2021-10-25 12:20:25 +02:00
|
|
|
integer,intent(in) :: x_DFA,c_DFA
|
2020-07-02 14:27:38 +02:00
|
|
|
logical,intent(in) :: LDA_centered
|
|
|
|
integer,intent(in) :: nEns
|
|
|
|
double precision,intent(in) :: wEns(nEns)
|
2021-11-29 13:21:45 +01:00
|
|
|
integer,intent(in) :: nCC
|
|
|
|
double precision,intent(in) :: aCC(nCC,nEns-1)
|
2020-07-02 14:27:38 +02:00
|
|
|
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(ncart,nBas,nGrid)
|
|
|
|
|
|
|
|
double precision,intent(in) :: T(nBas,nBas)
|
|
|
|
double precision,intent(in) :: V(nBas,nBas)
|
|
|
|
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
|
|
double precision,intent(in) :: ENuc
|
|
|
|
|
2021-12-01 10:54:51 +01:00
|
|
|
double precision,intent(in) :: eKS(nBas,nspin)
|
2020-07-04 14:32:06 +02:00
|
|
|
double precision,intent(in) :: Pw(nBas,nBas,nspin)
|
2020-07-02 14:27:38 +02:00
|
|
|
double precision,intent(in) :: rhow(nGrid,nspin)
|
|
|
|
double precision,intent(in) :: drhow(ncart,nGrid,nspin)
|
|
|
|
|
|
|
|
double precision,intent(in) :: P(nBas,nBas,nspin,nEns)
|
|
|
|
double precision,intent(in) :: rho(nGrid,nspin,nEns)
|
|
|
|
double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns)
|
|
|
|
|
2021-11-30 13:43:37 +01:00
|
|
|
double precision,intent(inout):: J(nBas,nBas,nspin)
|
|
|
|
double precision,intent(inout):: Fx(nBas,nBas,nspin)
|
|
|
|
double precision,intent(inout):: FxHF(nBas,nBas,nspin)
|
|
|
|
double precision,intent(inout):: Fc(nBas,nBas,nspin)
|
2021-11-29 23:32:49 +01:00
|
|
|
double precision,intent(in) :: Ew
|
2020-09-11 11:55:04 +02:00
|
|
|
double precision,intent(in) :: occnum(nBas,nspin,nEns)
|
2020-08-02 13:09:30 +02:00
|
|
|
integer,intent(in) :: Cx_choice
|
2020-09-29 11:47:18 +02:00
|
|
|
logical,intent(in) :: doNcentered
|
2020-08-01 11:45:17 +02:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
! Local variables
|
|
|
|
|
|
|
|
double precision :: ET(nspin,nEns)
|
|
|
|
double precision :: EV(nspin,nEns)
|
2021-11-30 13:43:37 +01:00
|
|
|
double precision :: EH(nsp,nEns)
|
2020-07-02 14:27:38 +02:00
|
|
|
double precision :: Ex(nspin,nEns)
|
|
|
|
double precision :: Ec(nsp,nEns)
|
2021-12-06 15:27:39 +01:00
|
|
|
double precision :: LZH(nsp)
|
|
|
|
double precision :: LZx(nspin)
|
2021-11-30 13:43:37 +01:00
|
|
|
double precision :: LZc(nsp)
|
2020-07-02 15:40:30 +02:00
|
|
|
double precision :: Eaux(nspin,nEns)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2020-07-02 15:40:30 +02:00
|
|
|
double precision :: ExDD(nspin,nEns)
|
2020-07-02 14:27:38 +02:00
|
|
|
double precision :: EcDD(nsp,nEns)
|
|
|
|
|
2021-11-30 13:43:37 +01:00
|
|
|
double precision :: OmH(nEns)
|
|
|
|
double precision :: Omx(nEns)
|
|
|
|
double precision :: Omc(nEns)
|
2020-07-02 15:40:30 +02:00
|
|
|
double precision :: Omaux(nEns)
|
2021-11-30 13:43:37 +01:00
|
|
|
double precision :: OmxDD(nEns)
|
|
|
|
double precision :: OmcDD(nEns)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
double precision,external :: trace_matrix
|
|
|
|
|
2020-09-29 09:43:01 +02:00
|
|
|
integer :: ispin,iEns,iBas
|
|
|
|
double precision,allocatable :: nEl(:)
|
2020-09-29 11:47:18 +02:00
|
|
|
double precision,allocatable :: kappa(:)
|
2020-09-29 09:43:01 +02:00
|
|
|
|
2021-11-29 23:32:49 +01:00
|
|
|
double precision :: E(nEns)
|
|
|
|
double precision :: Om(nEns)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-11-29 23:32:49 +01:00
|
|
|
double precision,external :: electron_number
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-11-29 23:32:49 +01:00
|
|
|
! Compute scaling factor for N-centered ensembles
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2020-09-29 11:47:18 +02:00
|
|
|
allocate(nEl(nEns),kappa(nEns))
|
|
|
|
|
2020-09-29 09:43:01 +02:00
|
|
|
nEl(:) = 0d0
|
|
|
|
do iEns=1,nEns
|
|
|
|
do iBas=1,nBas
|
2021-10-12 14:40:40 +02:00
|
|
|
do ispin=1,nspin
|
|
|
|
nEl(iEns) = nEl(iEns) + occnum(iBas,ispin,iEns)
|
|
|
|
end do
|
2020-09-29 09:43:01 +02:00
|
|
|
end do
|
2020-09-29 11:47:18 +02:00
|
|
|
kappa(iEns) = nEl(iEns)/nEl(1)
|
2020-09-29 09:43:01 +02:00
|
|
|
end do
|
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Kinetic energy
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-11-30 13:43:37 +01:00
|
|
|
do ispin=1,nspin
|
|
|
|
do iEns=1,nEns
|
|
|
|
ET(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),T(:,:)))
|
|
|
|
end do
|
|
|
|
end do
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Potential energy
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-11-30 13:43:37 +01:00
|
|
|
do iEns=1,nEns
|
|
|
|
do ispin=1,nspin
|
|
|
|
EV(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),V(:,:)))
|
|
|
|
end do
|
|
|
|
end do
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Individual Hartree energy
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
LZH(:) = 0d0
|
2021-12-01 10:54:51 +01:00
|
|
|
EH(:,:) = 0d0
|
2021-12-06 15:27:39 +01:00
|
|
|
call unrestricted_hartree_individual_energy(nBas,nEns,Pw,P,ERI,LZH,EH)
|
2021-01-26 21:28:05 +01:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Individual exchange energy
|
|
|
|
!------------------------------------------------------------------------
|
2020-07-06 15:42:21 +02:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
LZx(:) = 0d0
|
2021-12-01 10:54:51 +01:00
|
|
|
Ex(:,:) = 0d0
|
|
|
|
call unrestricted_exchange_individual_energy(x_rung,x_DFA,LDA_centered,nEns,wEns,nCC,aCC,nGrid,weight,nBas,ERI, &
|
2021-12-06 15:27:39 +01:00
|
|
|
Pw,rhow,drhow,P,rho,drho,Cx_choice,doNcentered,LZx,Ex)
|
2020-07-06 12:19:49 +02:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Individual correlation energy
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-12-01 10:54:51 +01:00
|
|
|
LZc(:) = 0d0
|
|
|
|
Ec(:,:) = 0d0
|
|
|
|
call unrestricted_correlation_individual_energy(c_rung,c_DFA,LDA_centered,nEns,wEns,nGrid,weight, &
|
2021-12-06 15:27:39 +01:00
|
|
|
rhow,drhow,rho,drho,LZc,Ec)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Compute auxiliary energies
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
call unrestricted_auxiliary_energy(nBas,nEns,eKS,occnum,Eaux)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Compute derivative discontinuities
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2020-07-02 15:40:30 +02:00
|
|
|
do ispin=1,nspin
|
2021-11-29 13:21:45 +01:00
|
|
|
call unrestricted_exchange_derivative_discontinuity(x_rung,x_DFA,nEns,wEns,nCC,aCC,nGrid,weight, &
|
2021-12-16 21:42:58 +01:00
|
|
|
rhow(:,ispin),drhow(:,:,ispin),Cx_choice,doNcentered,kappa,ExDD(ispin,:))
|
2020-07-02 15:40:30 +02:00
|
|
|
end do
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
call unrestricted_correlation_derivative_discontinuity(c_rung,c_DFA,nEns,wEns,nGrid,weight,rhow,drhow,EcDD)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-12-07 09:57:09 +01:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Total energy
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
if(doNcentered) then
|
2021-12-06 10:03:28 +01:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
do iEns=1,nEns
|
|
|
|
E(iEns) = sum(Eaux(:,iEns)) &
|
|
|
|
+ kappa(iEns)*(sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:))) &
|
|
|
|
+ sum(ExDD(:,iEns)) + sum(EcDD(:,iEns))
|
|
|
|
end do
|
2021-12-06 10:03:28 +01:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
else
|
2021-12-06 10:03:28 +01:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
do iEns=1,nEns
|
|
|
|
E(iEns) = sum(Eaux(:,iEns)) &
|
|
|
|
+ sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)) &
|
|
|
|
+ sum(ExDD(:,iEns)) + sum(EcDD(:,iEns))
|
|
|
|
end do
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
end if
|
|
|
|
|
2021-12-07 09:41:14 +01:00
|
|
|
! do iEns=1,nEns
|
|
|
|
! E(iEns) = sum(ET(:,iEns)) + sum(EV(:,iEns)) &
|
|
|
|
! + sum(EH(:,iEns)) + sum(Ex(:,iEns)) + sum(Ec(:,iEns)) &
|
|
|
|
! + sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)) &
|
|
|
|
! + sum(ExDD(:,iEns)) + sum(EcDD(:,iEns))
|
|
|
|
! end do
|
2021-12-01 10:54:51 +01:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Excitation energies
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
|
|
|
do iEns=1,nEns
|
2021-12-06 15:27:39 +01:00
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
Om(iEns) = E(iEns) - E(1)
|
|
|
|
|
2021-12-07 09:41:14 +01:00
|
|
|
OmH(iEns) = sum(EH(:,iEns)) - sum(EH(:,1))
|
|
|
|
Omx(iEns) = sum(Ex(:,iEns)) - sum(Ex(:,1))
|
|
|
|
Omc(iEns) = sum(Ec(:,iEns)) - sum(Ec(:,1))
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-12-07 09:41:14 +01:00
|
|
|
Omaux(iEns) = sum(Eaux(:,iEns)) - sum(Eaux(:,1))
|
2020-07-02 14:27:38 +02:00
|
|
|
|
2021-12-07 09:41:14 +01:00
|
|
|
OmxDD(iEns) = sum(ExDD(:,iEns)) - sum(ExDD(:,1))
|
|
|
|
OmcDD(iEns) = sum(EcDD(:,iEns)) - sum(EcDD(:,1))
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
end do
|
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
if(doNcentered) then
|
|
|
|
|
|
|
|
do iEns=1,nEns
|
2021-12-07 09:41:14 +01:00
|
|
|
OmH(iEns) = OmH(iEns) + (kappa(iEns) - kappa(1))*sum(LZH(:))
|
|
|
|
Omx(iEns) = Omx(iEns) + (kappa(iEns) - kappa(1))*sum(LZx(:))
|
|
|
|
Omc(iEns) = Omc(iEns) + (kappa(iEns) - kappa(1))*sum(LZc(:))
|
2021-12-06 15:27:39 +01:00
|
|
|
|
2021-12-07 09:41:14 +01:00
|
|
|
Omaux(iEns) = Omaux(iEns) &
|
|
|
|
+ (kappa(iEns) - kappa(1))*(sum(LZH(:)) + sum(LZx(:)) + sum(LZc(:)))
|
2021-12-06 15:27:39 +01:00
|
|
|
|
|
|
|
end do
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
2020-07-02 14:27:38 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Dump results
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
2021-12-06 15:27:39 +01:00
|
|
|
call print_unrestricted_individual_energy(nEns,ENuc,Ew,ET,EV,EH,Ex,Ec,Eaux,ExDD,EcDD,E,Om,OmH,Omx,Omc,Omaux,OmxDD,OmcDD)
|
2020-07-02 14:27:38 +02:00
|
|
|
|
|
|
|
end subroutine unrestricted_individual_energy
|