mirror of
https://github.com/pfloos/quack
synced 2025-01-03 10:05:49 +01:00
Merge branch 'master' of github.com:pfloos/QuAcK
This commit is contained in:
commit
abccd99f51
@ -1,7 +1,7 @@
|
||||
integer,parameter :: ncart = 3
|
||||
integer,parameter :: nspin = 2
|
||||
integer,parameter :: nsp = 3
|
||||
integer,parameter :: maxEns = 10
|
||||
integer,parameter :: maxEns = 3
|
||||
integer,parameter :: maxShell = 512
|
||||
integer,parameter :: maxL = 7
|
||||
integer,parameter :: n1eInt = 3
|
||||
@ -18,6 +18,5 @@
|
||||
double precision,parameter :: auToD = 2.5415802529d0
|
||||
|
||||
double precision,parameter :: CxLDA = - (3d0/4d0)*(3d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: CxLSDA = - (3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
|
||||
|
||||
44
input/dft
44
input/dft
@ -1,38 +1,38 @@
|
||||
# Restricted or unrestricted KS calculation
|
||||
eDFT-UKS
|
||||
# exchange rung:
|
||||
# Hartree = 0
|
||||
# LDA = 1: RS51,RMFL20
|
||||
# GGA = 2: RB88
|
||||
# Hybrid = 4
|
||||
# Hartree-Fock = 666
|
||||
# Hartree = 0: H
|
||||
# LDA = 1: S51,CC-S51
|
||||
# GGA = 2: B88,G96,PBE
|
||||
# MGGA = 3:
|
||||
# Hybrid = 4: HF,B3LYP,PBE
|
||||
1 S51
|
||||
# correlation rung:
|
||||
# Hartree = 0
|
||||
# LDA = 1: RVWN5,RMFL20
|
||||
# GGA = 2:
|
||||
# Hybrid = 4:
|
||||
# Hartree-Fock = 666
|
||||
# Hartree = 0: H
|
||||
# LDA = 1: PW92,VWN3,VWN5,eVWN5
|
||||
# GGA = 2: LYP,PBE
|
||||
# MGGA = 3:
|
||||
# Hybrid = 4: HF,B3LYP,PBE
|
||||
0 H
|
||||
# quadrature grid SG-n
|
||||
1
|
||||
# Number of states in ensemble (nEns)
|
||||
3
|
||||
# occupation numbers of orbitals nO and nO+1
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1
|
||||
# occupation numbers
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
|
||||
1 1 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
|
||||
# Ensemble weights: wEns(1),...,wEns(nEns-1)
|
||||
0.00 1.00
|
||||
0.0 0.0
|
||||
# N-centered?
|
||||
T
|
||||
F
|
||||
# Parameters for CC weight-dependent exchange functional
|
||||
0.445525 0.0901503 -0.286898
|
||||
0.191734 -0.0364788 -0.017035
|
||||
0.0 0.0 0.0
|
||||
0.0 0.0 0.0
|
||||
# choice of UCC exchange coefficient : 1 for Cx1, 2 for Cx2, 3 for Cx1*Cx2
|
||||
2
|
||||
|
||||
@ -1,17 +1,17 @@
|
||||
# RHF UHF KS MOM
|
||||
T F F F
|
||||
F F T F
|
||||
# MP2* MP3 MP2-F12
|
||||
F F F
|
||||
# CCD DCD CCSD CCSD(T)
|
||||
F F F F
|
||||
# drCCD rCCD lCCD pCCD
|
||||
F F F T
|
||||
# CIS* CIS(D) CID CISD
|
||||
F F F F
|
||||
# CIS* CIS(D) CID CISD FCI
|
||||
F F F F F
|
||||
# RPA* RPAx* ppRPA
|
||||
F F F
|
||||
# G0F2 evGF2 G0F3 evGF3
|
||||
F F F F
|
||||
# G0F2* evGF2* qsGF2* G0F3 evGF3
|
||||
F F F F F
|
||||
# G0W0* evGW* qsGW*
|
||||
F F F
|
||||
# G0T0 evGT qsGT
|
||||
|
||||
@ -1,17 +1,17 @@
|
||||
# HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess
|
||||
128 0.0000001 T 5 1 1 T
|
||||
# HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability
|
||||
1024 0.00001 F 5 1 1 F F
|
||||
# MP:
|
||||
|
||||
# CC: maxSCF thresh DIIS n_diis
|
||||
64 0.00001 T 5
|
||||
64 0.0000000001 T 5
|
||||
# spin: TDA singlet triplet spin_conserved spin_flip
|
||||
F T T T F
|
||||
T T T T T
|
||||
# GF: maxSCF thresh DIIS n_diis lin eta renorm
|
||||
256 0.00001 T 5 T 0.0 3
|
||||
# GW/GT: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0
|
||||
256 0.0000001 T 5 T 0.00367493 F F F F F
|
||||
256 0.00001 T 5 T 0.0 F F T F F
|
||||
# ACFDT: AC Kx XBS
|
||||
F F T
|
||||
T F T
|
||||
# BSE: BSE dBSE dTDA evDyn
|
||||
T F T F
|
||||
# MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
12
|
||||
Benzene,^1A_{1g},CC3,aug-cc-pVTZ
|
||||
|
||||
C 0.00000000 1.39250319 0.00000000
|
||||
C -1.20594314 0.69625160 0.00000000
|
||||
C -1.20594314 -0.69625160 0.00000000
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
10
|
||||
Butadiene,^1A_g,CC3,aug-cc-pVTZ
|
||||
|
||||
C 0.60673471 0.00000000 0.39936380
|
||||
C -0.60673471 0.00000000 -0.39936380
|
||||
C 1.84223863 0.00000000 -0.11897388
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
6
|
||||
Ethylene,^1A_g,CC3,aug-cc-pVTZ
|
||||
|
||||
C 0.00000000 0.66690396 0.00000000
|
||||
C 0.00000000 -0.66690396 0.00000000
|
||||
H 0.00000000 1.22952195 0.92229064
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
2
|
||||
|
||||
H 0.0 0.0 0.0
|
||||
H 0.0 0.0 0.740848
|
||||
H 0.0 0.0 0.7
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
3
|
||||
Water,^1A_1,CC3,aug-cc-pVTZ
|
||||
|
||||
O 0.00000000 0.00000000 -0.06990256
|
||||
H 0.00000000 0.75753241 0.51843495
|
||||
H 0.00000000 -0.75753241 0.51843495
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine exchange_matrix_AO_basis(nBas,P,G,K)
|
||||
subroutine exchange_matrix_AO_basis(nBas,P,ERI,K)
|
||||
|
||||
! Compute exchange matrix in the AO basis
|
||||
|
||||
@ -9,7 +9,7 @@ subroutine exchange_matrix_AO_basis(nBas,P,G,K)
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: P(nBas,nBas)
|
||||
double precision,intent(in) :: G(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -24,7 +24,7 @@ subroutine exchange_matrix_AO_basis(nBas,P,G,K)
|
||||
do si=1,nBas
|
||||
do la=1,nBas
|
||||
do mu=1,nBas
|
||||
K(mu,nu) = K(mu,nu) - P(la,si)*G(mu,la,si,nu)
|
||||
K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
31
src/CI/FCI.f90
Normal file
31
src/CI/FCI.f90
Normal file
@ -0,0 +1,31 @@
|
||||
subroutine FCI(nBas,nC,nO,nV,nR,ERI,e)
|
||||
|
||||
! Perform a full configuration interaction calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR
|
||||
double precision,intent(in) :: e(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'**********************************'
|
||||
write(*,*)'| Full Configuration Interaction |'
|
||||
write(*,*)'**********************************'
|
||||
write(*,*)
|
||||
|
||||
! Form FCI vector
|
||||
|
||||
! Form FCI matrix
|
||||
|
||||
! Diagonalize FCI matrix
|
||||
|
||||
|
||||
end subroutine FCI
|
||||
@ -56,6 +56,9 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,
|
||||
call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF,ERI, &
|
||||
OmBSE(:,ispin),rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin))
|
||||
call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int, &
|
||||
OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
|
||||
|
||||
! Compute dynamic correction for BSE via perturbation theory
|
||||
|
||||
@ -90,6 +93,8 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,
|
||||
call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF(:),ERI(:,:,:,:), &
|
||||
OmBSE(:,ispin),rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin))
|
||||
call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int, &
|
||||
OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
|
||||
! Compute dynamic correction for BSE via perturbation theory
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, &
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
|
||||
subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
|
||||
|
||||
! Perform a one-shot second-order Green function calculation
|
||||
|
||||
@ -13,8 +12,8 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, &
|
||||
logical,intent(in) :: dBSE
|
||||
logical,intent(in) :: dTDA
|
||||
logical,intent(in) :: evDyn
|
||||
logical,intent(in) :: singlet_manifold
|
||||
logical,intent(in) :: triplet_manifold
|
||||
logical,intent(in) :: singlet
|
||||
logical,intent(in) :: triplet
|
||||
logical,intent(in) :: linearize
|
||||
double precision,intent(in) :: eta
|
||||
integer,intent(in) :: nBas
|
||||
@ -31,15 +30,12 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, &
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision :: eps
|
||||
double precision :: V
|
||||
double precision :: Ec
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision,allocatable :: eGF2(:)
|
||||
double precision,allocatable :: Sig(:)
|
||||
double precision,allocatable :: SigC(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
|
||||
integer :: i,j,a,b,p
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
@ -50,7 +46,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, &
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(Sig(nBas),Z(nBas),eGF2(nBas))
|
||||
allocate(SigC(nBas),Z(nBas),eGF2(nBas))
|
||||
|
||||
if(linearize) then
|
||||
|
||||
@ -61,62 +57,28 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, &
|
||||
|
||||
! Frequency-dependent second-order contribution
|
||||
|
||||
Sig(:) = 0d0
|
||||
Z(:) = 0d0
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do j=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
|
||||
eps = eHF(p) + eHF(a) - eHF(i) - eHF(j)
|
||||
V = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
|
||||
|
||||
Sig(p) = Sig(p) + V*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - V*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do b=nO+1,nBas-nR
|
||||
|
||||
eps = eHF(p) + eHF(i) - eHF(a) - eHF(b)
|
||||
V = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
|
||||
|
||||
Sig(p) = Sig(p) + V*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - V*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
Z(:) = 1d0/(1d0 - Z(:))
|
||||
call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z)
|
||||
|
||||
if(linearize) then
|
||||
|
||||
eGF2(:) = eHF(:) + Z(:)*Sig(:)
|
||||
eGF2(:) = eHF(:) + Z(:)*SigC(:)
|
||||
|
||||
else
|
||||
|
||||
eGF2(:) = eHF(:) + Sig(:)
|
||||
eGF2(:) = eHF(:) + SigC(:)
|
||||
|
||||
end if
|
||||
|
||||
! Print results
|
||||
|
||||
call print_G0F2(nBas,nO,eHF,Sig,eGF2,Z)
|
||||
call MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF2,Ec)
|
||||
call print_G0F2(nBas,nO,eHF,SigC,eGF2,Z,ENuc,ERHF,Ec)
|
||||
|
||||
! Perform BSE2 calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE)
|
||||
call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE)
|
||||
|
||||
end if
|
||||
|
||||
122
src/GF/UG0F2.f90
Normal file
122
src/GF/UG0F2.f90
Normal file
@ -0,0 +1,122 @@
|
||||
subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, &
|
||||
S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF)
|
||||
|
||||
! Perform unrestricted G0W0 calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
include 'quadrature.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
logical,intent(in) :: BSE
|
||||
logical,intent(in) :: TDA
|
||||
logical,intent(in) :: dBSE
|
||||
logical,intent(in) :: dTDA
|
||||
logical,intent(in) :: evDyn
|
||||
logical,intent(in) :: spin_conserved
|
||||
logical,intent(in) :: spin_flip
|
||||
logical,intent(in) :: linearize
|
||||
double precision,intent(in) :: eta
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EUHF
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: is
|
||||
integer :: ispin
|
||||
double precision :: Ec(nsp)
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision,allocatable :: SigC(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
|
||||
double precision,allocatable :: eGF2lin(:,:)
|
||||
double precision,allocatable :: eGF2(:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)'| One-shot G0F2 calculation |'
|
||||
write(*,*)'| *** Unrestricted version *** |'
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)
|
||||
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated!'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
! Memory allocation
|
||||
|
||||
nS_aa = nS(1)
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(SigC(nBas,nspin),Z(nBas,nspin),eGF2(nBas,nspin),eGF2lin(nBas,nspin))
|
||||
|
||||
!---------------------!
|
||||
! Compute self-energy !
|
||||
!---------------------!
|
||||
|
||||
call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eHF,SigC,Z)
|
||||
|
||||
!-----------------------------------!
|
||||
! Solve the quasi-particle equation !
|
||||
!-----------------------------------!
|
||||
|
||||
eGF2lin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:)
|
||||
|
||||
if(linearize) then
|
||||
|
||||
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
|
||||
write(*,*)
|
||||
|
||||
eGF2(:,:) = eGF2lin(:,:)
|
||||
|
||||
else
|
||||
|
||||
! Find graphical solution of the QP equation
|
||||
|
||||
print*,'!!! Graphical solution NYI for UG0F2 !!!'
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Compute MP2 correlation energy
|
||||
|
||||
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec)
|
||||
|
||||
! Dump results
|
||||
|
||||
call print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
print*,'!!! BSE2 NYI for UG0F2 !!!'
|
||||
|
||||
end if
|
||||
|
||||
end subroutine UG0F2
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold,triplet_manifold, &
|
||||
subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, &
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
|
||||
|
||||
! Perform eigenvalue self-consistent second-order Green function calculation
|
||||
@ -16,8 +16,8 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
integer,intent(in) :: maxSCF
|
||||
double precision,intent(in) :: thresh
|
||||
integer,intent(in) :: max_diis
|
||||
logical,intent(in) :: singlet_manifold
|
||||
logical,intent(in) :: triplet_manifold
|
||||
logical,intent(in) :: singlet
|
||||
logical,intent(in) :: triplet
|
||||
logical,intent(in) :: linearize
|
||||
double precision,intent(in) :: eta
|
||||
integer,intent(in) :: nBas
|
||||
@ -36,20 +36,17 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
|
||||
integer :: nSCF
|
||||
integer :: n_diis
|
||||
double precision :: Ec
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: num
|
||||
double precision :: eps
|
||||
double precision :: Conv
|
||||
double precision :: rcond
|
||||
double precision,allocatable :: eGF2(:)
|
||||
double precision,allocatable :: eOld(:)
|
||||
double precision,allocatable :: Sig(:)
|
||||
double precision,allocatable :: SigC(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
double precision,allocatable :: error_diis(:,:)
|
||||
double precision,allocatable :: e_diis(:,:)
|
||||
|
||||
integer :: i,j,a,b,p
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
@ -60,7 +57,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(Sig(nBas),Z(nBas),eGF2(nBas),eOld(nBas),error_diis(nBas,max_diis),e_diis(nBas,max_diis))
|
||||
allocate(SigC(nBas),Z(nBas),eGF2(nBas),eOld(nBas),error_diis(nBas,max_diis),e_diis(nBas,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -80,50 +77,15 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
|
||||
! Frequency-dependent second-order contribution
|
||||
|
||||
Sig(:) = 0d0
|
||||
Z(:) = 0d0
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do j=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
|
||||
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
|
||||
|
||||
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do b=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
|
||||
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
|
||||
|
||||
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
Z(:) = 1d0/(1d0 - Z(:))
|
||||
call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z)
|
||||
|
||||
if(linearize) then
|
||||
|
||||
eGF2(:) = eHF(:) + Z(:)*Sig(:)
|
||||
eGF2(:) = eHF(:) + Z(:)*SigC(:)
|
||||
|
||||
else
|
||||
|
||||
eGF2(:) = eHF(:) + Sig(:)
|
||||
eGF2(:) = eHF(:) + SigC(:)
|
||||
|
||||
end if
|
||||
|
||||
@ -131,7 +93,8 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
|
||||
! Print results
|
||||
|
||||
call print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2)
|
||||
call MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF2,Ec)
|
||||
call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF2,ENuc,ERHF,Ec)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
@ -169,7 +132,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE)
|
||||
call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE)
|
||||
|
||||
end if
|
||||
|
||||
194
src/GF/evUGF2.f90
Normal file
194
src/GF/evUGF2.f90
Normal file
@ -0,0 +1,194 @@
|
||||
subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, &
|
||||
eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,cHF,eHF)
|
||||
|
||||
! Perform self-consistent eigenvalue-only GW calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: maxSCF
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EUHF
|
||||
logical,intent(in) :: BSE
|
||||
logical,intent(in) :: TDA
|
||||
logical,intent(in) :: dBSE
|
||||
logical,intent(in) :: dTDA
|
||||
logical,intent(in) :: evDyn
|
||||
logical,intent(in) :: spin_conserved
|
||||
logical,intent(in) :: spin_flip
|
||||
double precision,intent(in) :: eta
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: cHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
logical :: linear_mixing
|
||||
integer :: is
|
||||
integer :: ispin
|
||||
integer :: nSCF
|
||||
integer :: n_diis
|
||||
double precision :: rcond(nspin)
|
||||
double precision :: Conv
|
||||
double precision :: Ec(nsp)
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
double precision :: alpha
|
||||
double precision,allocatable :: error_diis(:,:,:)
|
||||
double precision,allocatable :: e_diis(:,:,:)
|
||||
double precision,allocatable :: eGF2(:,:)
|
||||
double precision,allocatable :: eOld(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision,allocatable :: SigC(:,:)
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'**************************************************'
|
||||
write(*,*)'| Self-consistent unrestricted evGF2 calculation |'
|
||||
write(*,*)'**************************************************'
|
||||
write(*,*)
|
||||
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated!'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
! Linear mixing
|
||||
|
||||
linear_mixing = .false.
|
||||
alpha = 0.2d0
|
||||
|
||||
! Memory allocation
|
||||
|
||||
nS_aa = nS(1)
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(eGF2(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin), &
|
||||
error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin))
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
ispin = 1
|
||||
n_diis = 0
|
||||
Conv = 1d0
|
||||
e_diis(:,:,:) = 0d0
|
||||
error_diis(:,:,:) = 0d0
|
||||
eGF2(:,:) = eHF(:,:)
|
||||
eOld(:,:) = eHF(:,:)
|
||||
Z(:,:) = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
do while(Conv > thresh .and. nSCF <= maxSCF)
|
||||
|
||||
!------------------------------------------------!
|
||||
! Compute self-energy and renormalization factor !
|
||||
!------------------------------------------------!
|
||||
|
||||
call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z)
|
||||
|
||||
!-----------------------------------!
|
||||
! Solve the quasi-particle equation !
|
||||
!-----------------------------------!
|
||||
|
||||
eGF2(:,:) = eHF(:,:) + SigC(:,:)
|
||||
|
||||
! Convergence criteria
|
||||
|
||||
Conv = maxval(abs(eGF2(:,:) - eOld(:,:)))
|
||||
|
||||
! Compute MP2 correlation energy
|
||||
|
||||
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec)
|
||||
|
||||
! Print results
|
||||
|
||||
call print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
|
||||
|
||||
! Linear mixing or DIIS extrapolation
|
||||
|
||||
if(linear_mixing) then
|
||||
|
||||
eGF2(:,:) = alpha*eGF2(:,:) + (1d0 - alpha)*eOld(:,:)
|
||||
|
||||
else
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
do is=1,nspin
|
||||
call DIIS_extrapolation(rcond(ispin),nBas,nBas,n_diis,error_diis(:,1:n_diis,is), &
|
||||
e_diis(:,1:n_diis,is),eGF2(:,is)-eOld(:,is),eGF2(:,is))
|
||||
end do
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(minval(rcond(:)) < 1d-15) n_diis = 0
|
||||
|
||||
endif
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
eOld(:,:) = eGF2(:,:)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
|
||||
enddo
|
||||
!------------------------------------------------------------------------
|
||||
! End main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF+1) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(eOld,Z,SigC,error_diis,e_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
print*,'!!! BSE2 NYI for evUGF2 !!!'
|
||||
|
||||
endif
|
||||
|
||||
end subroutine evUGF2
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z)
|
||||
subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z,ENuc,ERHF,Ec)
|
||||
|
||||
! Print one-electron energies and other stuff for G0F2
|
||||
|
||||
@ -11,6 +11,9 @@ subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z)
|
||||
double precision,intent(in) :: Sig(nBas)
|
||||
double precision,intent(in) :: eGF2(nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: Ec
|
||||
|
||||
integer :: p
|
||||
integer :: HOMO
|
||||
@ -38,10 +41,13 @@ subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z)
|
||||
enddo
|
||||
|
||||
write(*,*)'--------------------------------------------------------------------------'
|
||||
write(*,'(2X,A27,F15.6)') 'G0F2 HOMO energy (eV):',eGF2(HOMO)*HaToeV
|
||||
write(*,'(2X,A27,F15.6)') 'G0F2 LUMO energy (eV):',eGF2(LUMO)*HaToeV
|
||||
write(*,'(2X,A27,F15.6)') 'G0F2 HOMO-LUMO gap (eV):',Gap*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'G0F2 HOMO energy (eV):',eGF2(HOMO)*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'G0F2 LUMO energy (eV):',eGF2(LUMO)*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'G0F2 HOMO-LUMO gap (eV):',Gap*HaToeV
|
||||
write(*,*)'--------------------------------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'G0F2 total energy :',ENuc + ERHF + Ec,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'G0F2 correlation energy:',Ec,' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_G0F2
|
||||
73
src/GF/print_UG0F2.f90
Normal file
73
src/GF/print_UG0F2.f90
Normal file
@ -0,0 +1,73 @@
|
||||
subroutine print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
|
||||
|
||||
! Print one-electron energies and other stuff for G0W0
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO(nspin)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EUHF
|
||||
double precision,intent(in) :: Ec(nsp)
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: SigC(nBas,nspin)
|
||||
double precision,intent(in) :: Z(nBas,nspin)
|
||||
double precision,intent(in) :: eGF2(nBas,nspin)
|
||||
|
||||
integer :: p
|
||||
integer :: ispin
|
||||
double precision :: HOMO(nspin)
|
||||
double precision :: LUMO(nspin)
|
||||
double precision :: Gap(nspin)
|
||||
|
||||
! HOMO and LUMO
|
||||
|
||||
do ispin=1,nspin
|
||||
if(nO(ispin) > 0) then
|
||||
HOMO(ispin) = eGF2(nO(ispin),ispin)
|
||||
LUMO(ispin) = eGF2(nO(ispin)+1,ispin)
|
||||
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
|
||||
else
|
||||
HOMO(ispin) = 0d0
|
||||
LUMO(ispin) = eGF2(1,ispin)
|
||||
Gap(ispin) = 0d0
|
||||
end if
|
||||
end do
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,*)' Unrestricted one-shot G0F2 calculation (eV)'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
|
||||
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
|
||||
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
|
||||
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
|
||||
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', &
|
||||
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
|
||||
enddo
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'UG0F2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'UG0F2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'UG0F2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' UG0F2 total energy :',ENuc + EUHF + sum(Ec(:)),' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' UG0F2 correlation energy:',sum(Ec(:)),' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_UG0F2
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2)
|
||||
subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2,ENuc,ERHF,Ec)
|
||||
|
||||
! Print one-electron energies and other stuff for G0F2
|
||||
|
||||
@ -13,6 +13,9 @@ subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2)
|
||||
double precision,intent(in) :: Sig(nBas)
|
||||
double precision,intent(in) :: eGF2(nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: Ec
|
||||
|
||||
integer :: p
|
||||
integer :: HOMO
|
||||
@ -44,10 +47,13 @@ subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2)
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
|
||||
write(*,*)'--------------------------------------------------------------------------'
|
||||
write(*,'(2X,A27,F15.6)') 'evGF2 HOMO energy (eV):',eGF2(HOMO)*HaToeV
|
||||
write(*,'(2X,A27,F15.6)') 'evGF2 LUMO energy (eV):',eGF2(LUMO)*HaToeV
|
||||
write(*,'(2X,A27,F15.6)') 'evGF2 HOMO-LUMO gap (eV):',Gap*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'evGF2 HOMO energy (eV):',eGF2(HOMO)*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'evGF2 LUMO energy (eV):',eGF2(LUMO)*HaToeV
|
||||
write(*,'(2X,A30,F15.6)') 'evGF2 HOMO-LUMO gap (eV):',Gap*HaToeV
|
||||
write(*,*)'--------------------------------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'evGF2 total energy :',ENuc + ERHF + Ec,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'evGF2 correlation energy:',Ec,' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_evGF2
|
||||
81
src/GF/print_evUGF2.f90
Normal file
81
src/GF/print_evUGF2.f90
Normal file
@ -0,0 +1,81 @@
|
||||
subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
|
||||
|
||||
! Print one-electron energies and other stuff for evGF2
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EUHF
|
||||
double precision,intent(in) :: Ec(nsp)
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: SigC(nBas,nspin)
|
||||
double precision,intent(in) :: Z(nBas,nspin)
|
||||
double precision,intent(in) :: eGF2(nBas,nspin)
|
||||
|
||||
integer :: p
|
||||
integer :: ispin
|
||||
double precision :: HOMO(nspin)
|
||||
double precision :: LUMO(nspin)
|
||||
double precision :: Gap(nspin)
|
||||
|
||||
! HOMO and LUMO
|
||||
|
||||
do ispin=1,nspin
|
||||
if(nO(ispin) > 0) then
|
||||
HOMO(ispin) = eGF2(nO(ispin),ispin)
|
||||
LUMO(ispin) = eGF2(nO(ispin)+1,ispin)
|
||||
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
|
||||
else
|
||||
HOMO(ispin) = 0d0
|
||||
LUMO(ispin) = eGF2(1,ispin)
|
||||
Gap(ispin) = 0d0
|
||||
end if
|
||||
end do
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
if(nSCF < 10) then
|
||||
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent evG',nSCF,'F2',' calculation'
|
||||
else
|
||||
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent evG',nSCF,'F2',' calculation'
|
||||
endif
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
|
||||
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
|
||||
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
|
||||
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
|
||||
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', &
|
||||
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
|
||||
enddo
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'evGF2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'evGF2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'evGF2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' evGF2 total energy :',ENuc + EUHF + sum(Ec(:)),' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' evGF2 correlation energy:',sum(Ec(:)),' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_evUGF2
|
||||
119
src/GF/print_qsGF2.f90
Normal file
119
src/GF/print_qsGF2.f90
Normal file
@ -0,0 +1,119 @@
|
||||
subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigC,Z, &
|
||||
ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsGF2
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGF2(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: P(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas)
|
||||
double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas),SigC(nBas,nBas)
|
||||
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) :: EqsGF2
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: q,ixyz,HOMO,LUMO
|
||||
double precision :: Gap
|
||||
double precision,external :: trace_matrix
|
||||
|
||||
! Output variables
|
||||
|
||||
! HOMO and LUMO
|
||||
|
||||
HOMO = nO
|
||||
LUMO = HOMO + 1
|
||||
Gap = eGF2(LUMO)-eGF2(HOMO)
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
if(nSCF < 10) then
|
||||
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
|
||||
else
|
||||
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
|
||||
endif
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
|
||||
'|','#','|','e_HF (eV)','|','Sig_c (eV)','|','Z','|','e_QP (eV)','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
do q=1,nBas
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',q,'|',eHF(q)*HaToeV,'|',SigC(q,q)*HaToeV,'|',Z(q),'|',eGF2(q)*HaToeV,'|'
|
||||
enddo
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO energy:',eGF2(HOMO)*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGF2 LUMO energy:',eGF2(LUMO)*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO-LUMO gap :',Gap*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',ENuc + EqsGF2,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGF2 exchange energy:',Ex,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGF2 correlation energy:',Ec,' au'
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
! Dump results for final iteration
|
||||
|
||||
if(Conv < thresh) then
|
||||
|
||||
write(*,*)
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' Summary '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' One-electron energy: ',ET + EV,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Kinetic energy: ',ET,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Potential energy: ',EV,' au'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex + Ec,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Hartree energy: ',EJ,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2,' au'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A35)') ' Dipole moment (Debye) '
|
||||
write(*,'(10X,4A10)') 'X','Y','Z','Tot.'
|
||||
write(*,'(10X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGF2 MO coefficients'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
write(*,*)
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGF2 MO energies'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,1,eGF2)
|
||||
write(*,*)
|
||||
|
||||
endif
|
||||
|
||||
|
||||
end subroutine print_qsGF2
|
||||
178
src/GF/print_qsUGF2.f90
Normal file
178
src/GF/print_qsUGF2.f90
Normal file
@ -0,0 +1,178 @@
|
||||
subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, &
|
||||
ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,SigC,Z,dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsUGF2
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ET(nspin)
|
||||
double precision,intent(in) :: EV(nspin)
|
||||
double precision,intent(in) :: EJ(nsp)
|
||||
double precision,intent(in) :: Ex(nspin)
|
||||
double precision,intent(in) :: Ec(nsp)
|
||||
double precision,intent(in) :: EqsGF2
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: eGF2(nBas,nspin)
|
||||
double precision,intent(in) :: cGF2(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: PGF2(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: Ov(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: J(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: K(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: SigC(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: Z(nBas,nspin)
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: p
|
||||
integer :: ispin,ixyz
|
||||
double precision :: HOMO(nspin)
|
||||
double precision :: LUMO(nspin)
|
||||
double precision :: Gap(nspin)
|
||||
double precision :: S_exact,S2_exact
|
||||
double precision :: S,S2
|
||||
double precision,external :: trace_matrix
|
||||
|
||||
! HOMO and LUMO
|
||||
|
||||
do ispin=1,nspin
|
||||
if(nO(ispin) > 0) then
|
||||
HOMO(ispin) = eGF2(nO(ispin),ispin)
|
||||
LUMO(ispin) = eGF2(nO(ispin)+1,ispin)
|
||||
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
|
||||
else
|
||||
HOMO(ispin) = 0d0
|
||||
LUMO(ispin) = eGF2(1,ispin)
|
||||
Gap(ispin) = 0d0
|
||||
end if
|
||||
end do
|
||||
|
||||
S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0)
|
||||
S2 = S2_exact + nO(2) - sum(matmul(transpose(cGF2(:,1:nO(1),1)),matmul(Ov,cGF2(:,1:nO(2),2)))**2)
|
||||
|
||||
S_exact = 0.5d0*dble(nO(1) - nO(2))
|
||||
S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2)
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
if(nSCF < 10) then
|
||||
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
|
||||
else
|
||||
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
|
||||
endif
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
|
||||
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
|
||||
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
|
||||
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
|
||||
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,p,1)*HaToeV,SigC(p,p,2)*HaToeV,'|', &
|
||||
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
|
||||
enddo
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 total energy:',ENuc + EqsGF2,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 exchange energy:',sum(Ex(:)),' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 correlation energy:',sum(Ec(:)),' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
! Dump results for final iteration
|
||||
|
||||
if(Conv < thresh) then
|
||||
|
||||
write(*,*)
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40)') ' Summary '
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' One-electron energy: ',sum(ET(:)) + sum(EV(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' One-electron a energy: ',ET(1) + EV(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' One-electron b energy: ',ET(2) + EV(2),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Kinetic energy: ',sum(ET(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Kinetic a energy: ',ET(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Kinetic b energy: ',ET(2),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Potential energy: ',sum(EV(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Two-electron energy: ',sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1) + Ec(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2) + Ec(2),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2) + Ec(3),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Hartree energy: ',sum(EJ(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Hartree aa energy: ',EJ(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Hartree ab energy: ',EJ(2),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Hartree bb energy: ',EJ(3),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' qsUGF2 energy: ',ENuc + EqsGF2,' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0
|
||||
write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0
|
||||
write(*,'(A40,F13.6)') ' <S**2> (exact) :',S2_exact
|
||||
write(*,'(A40,F13.6)') ' <S**2> :',S2
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A45)') ' Dipole moment (Debye) '
|
||||
write(*,'(19X,4A10)') 'X','Y','Z','Tot.'
|
||||
write(*,'(19X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
! Print orbitals
|
||||
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,'(A50)') 'qsUGF2 spin-up orbital coefficients '
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
call matout(nBas,nBas,cGF2(:,:,1))
|
||||
write(*,*)
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,'(A50)') 'qsUGF2 spin-down orbital coefficients '
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
call matout(nBas,nBas,cGF2(:,:,2))
|
||||
write(*,*)
|
||||
|
||||
endif
|
||||
|
||||
end subroutine print_qsUGF2
|
||||
267
src/GF/qsGF2.f90
Normal file
267
src/GF/qsGF2.f90
Normal file
@ -0,0 +1,267 @@
|
||||
subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
|
||||
eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, &
|
||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GF2 calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: maxSCF
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
logical,intent(in) :: BSE
|
||||
logical,intent(in) :: TDA
|
||||
logical,intent(in) :: dBSE
|
||||
logical,intent(in) :: dTDA
|
||||
logical,intent(in) :: evDyn
|
||||
logical,intent(in) :: singlet
|
||||
logical,intent(in) :: triplet
|
||||
double precision,intent(in) :: eta
|
||||
|
||||
integer,intent(in) :: nNuc
|
||||
double precision,intent(in) :: ZNuc(nNuc)
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
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_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: ispin
|
||||
integer :: n_diis
|
||||
double precision :: EqsGF2
|
||||
double precision :: Conv
|
||||
double precision :: rcond
|
||||
double precision,external :: trace_matrix
|
||||
double precision :: dipole(ncart)
|
||||
double precision :: ET
|
||||
double precision :: EV
|
||||
double precision :: EJ
|
||||
double precision :: Ex
|
||||
double precision :: Ec
|
||||
double precision :: EcBSE(nspin)
|
||||
|
||||
double precision,allocatable :: error_diis(:,:)
|
||||
double precision,allocatable :: F_diis(:,:)
|
||||
double precision,allocatable :: c(:,:)
|
||||
double precision,allocatable :: cp(:,:)
|
||||
double precision,allocatable :: eGF2(:)
|
||||
double precision,allocatable :: eOld(:)
|
||||
double precision,allocatable :: P(:,:)
|
||||
double precision,allocatable :: F(:,:)
|
||||
double precision,allocatable :: Fp(:,:)
|
||||
double precision,allocatable :: J(:,:)
|
||||
double precision,allocatable :: K(:,:)
|
||||
double precision,allocatable :: SigC(:,:)
|
||||
double precision,allocatable :: SigCp(:,:)
|
||||
double precision,allocatable :: SigCm(:,:)
|
||||
double precision,allocatable :: Z(:)
|
||||
double precision,allocatable :: error(:,:)
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)'| Self-consistent qsGF2 calculation |'
|
||||
write(*,*)'************************************************'
|
||||
write(*,*)
|
||||
|
||||
! Warning
|
||||
|
||||
write(*,*) '!! ERIs in MO basis will be overwritten in qsGF2 !!'
|
||||
write(*,*)
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated!'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGF2(nBas),eOld(nbas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),SigCm(nBas,nBas),Z(nBas), &
|
||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = -1
|
||||
n_diis = 0
|
||||
ispin = 1
|
||||
Conv = 1d0
|
||||
P(:,:) = PHF(:,:)
|
||||
eOld(:) = eHF(:)
|
||||
eGF2(:) = eHF(:)
|
||||
c(:,:) = cHF(:,:)
|
||||
F_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
rcond = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
do while(Conv > thresh .and. nSCF <= maxSCF)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
|
||||
! Buid Coulomb matrix
|
||||
|
||||
call Coulomb_matrix_AO_basis(nBas,P,ERI_AO,J)
|
||||
|
||||
! Compute exchange part of the self-energy
|
||||
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI_AO,K)
|
||||
|
||||
! AO to MO transformation of two-electron integrals
|
||||
|
||||
call AOtoMO_integral_transform(1,1,1,1,nBas,c,ERI_AO,ERI_MO)
|
||||
|
||||
! Compute self-energy and renormalization factor
|
||||
|
||||
call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z)
|
||||
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
SigCp = 0.5d0*(SigC + transpose(SigC))
|
||||
SigCm = 0.5d0*(SigC - transpose(SigC))
|
||||
|
||||
call MOtoAO_transform(nBas,S,c,SigCp)
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
|
||||
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGF2)
|
||||
c = matmul(X,cp)
|
||||
SigCp = matmul(transpose(c),matmul(SigCp,c))
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
Conv = maxval(abs(eGF2 - eOld))
|
||||
eOld(:) = eGF2(:)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute total 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 = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
|
||||
! Correlation energy
|
||||
|
||||
call MP2(nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF2,Ec)
|
||||
|
||||
! Total energy
|
||||
|
||||
EqsGF2 = ET + EV + EJ + Ex + Ec
|
||||
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Print results
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigCp,Z, &
|
||||
ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
|
||||
|
||||
enddo
|
||||
!------------------------------------------------------------------------
|
||||
! End main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF+1) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,error,error_diis,F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eHF,eGF2,EcBSE)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (singlet) =',EcBSE(1)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (triplet) =',EcBSE(2)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy =',sum(EcBSE(:))
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 total energy =',ENuc + EqsGF2 + sum(EcBSE(:))
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
end subroutine qsGF2
|
||||
331
src/GF/qsUGF2.f90
Normal file
331
src/GF/qsUGF2.f90
Normal file
@ -0,0 +1,331 @@
|
||||
subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, &
|
||||
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF)
|
||||
|
||||
! Perform an unrestricted quasiparticle self-consistent GF2 calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: maxSCF
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
logical,intent(in) :: BSE
|
||||
logical,intent(in) :: TDA
|
||||
logical,intent(in) :: dBSE
|
||||
logical,intent(in) :: dTDA
|
||||
logical,intent(in) :: evDyn
|
||||
logical,intent(in) :: spin_conserved
|
||||
logical,intent(in) :: spin_flip
|
||||
double precision,intent(in) :: eta
|
||||
|
||||
integer,intent(in) :: nNuc
|
||||
double precision,intent(in) :: ZNuc(nNuc)
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
|
||||
double precision,intent(in) :: EUHF
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: cHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: PHF(nBas,nBas,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_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: ispin
|
||||
integer :: is
|
||||
integer :: n_diis
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
double precision :: ET(nspin)
|
||||
double precision :: EV(nspin)
|
||||
double precision :: EJ(nsp)
|
||||
double precision :: Ex(nspin)
|
||||
double precision :: Ec(nsp)
|
||||
double precision :: EqsGF2
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
double precision :: Conv
|
||||
double precision :: rcond(nspin)
|
||||
double precision,external :: trace_matrix
|
||||
double precision,allocatable :: error_diis(:,:,:)
|
||||
double precision,allocatable :: F_diis(:,:,:)
|
||||
double precision,allocatable :: c(:,:,:)
|
||||
double precision,allocatable :: cp(:,:,:)
|
||||
double precision,allocatable :: eOld(:,:)
|
||||
double precision,allocatable :: eGF2(:,:)
|
||||
double precision,allocatable :: P(:,:,:)
|
||||
double precision,allocatable :: F(:,:,:)
|
||||
double precision,allocatable :: Fp(:,:,:)
|
||||
double precision,allocatable :: J(:,:,:)
|
||||
double precision,allocatable :: K(:,:,:)
|
||||
double precision,allocatable :: SigC(:,:,:)
|
||||
double precision,allocatable :: SigCp(:,:,:)
|
||||
double precision,allocatable :: SigCm(:,:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
double precision,allocatable :: error(:,:,:)
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'**************************************************'
|
||||
write(*,*)'| Self-consistent unrestricted qsGF2 calculation |'
|
||||
write(*,*)'**************************************************'
|
||||
write(*,*)
|
||||
|
||||
! Warning
|
||||
|
||||
write(*,*) '!! ERIs in MO basis will be overwritten in qsUGF2 !!'
|
||||
write(*,*)
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated!'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
! Memory allocation
|
||||
|
||||
nS_aa = nS(1)
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(eGF2(nBas,nspin),eOld(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin), &
|
||||
Fp(nBas,nBas,nspin),J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin), &
|
||||
SigCm(nBas,nBas,nspin),Z(nBas,nspin),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin), &
|
||||
F_diis(nBasSq,max_diis,nspin))
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = -1
|
||||
n_diis = 0
|
||||
ispin = 1
|
||||
Conv = 1d0
|
||||
P(:,:,:) = PHF(:,:,:)
|
||||
eGF2(:,:) = eHF(:,:)
|
||||
c(:,:,:) = cHF(:,:,:)
|
||||
F_diis(:,:,:) = 0d0
|
||||
error_diis(:,:,:) = 0d0
|
||||
rcond = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
|
||||
! Buid Coulomb matrix
|
||||
|
||||
do is=1,nspin
|
||||
call Coulomb_matrix_AO_basis(nBas,P(:,:,is),ERI_AO(:,:,:,:),J(:,:,is))
|
||||
end do
|
||||
|
||||
! Compute exchange part of the self-energy
|
||||
|
||||
do is=1,nspin
|
||||
call exchange_matrix_AO_basis(nBas,P(:,:,is),ERI_AO(:,:,:,:),K(:,:,is))
|
||||
end do
|
||||
|
||||
!--------------------------------------------------
|
||||
! AO to MO transformation of two-electron integrals
|
||||
!--------------------------------------------------
|
||||
|
||||
! 4-index transform for (aa|aa) block
|
||||
|
||||
call AOtoMO_integral_transform(1,1,1,1,nBas,c,ERI_AO,ERI_aaaa)
|
||||
|
||||
! 4-index transform for (aa|bb) block
|
||||
|
||||
call AOtoMO_integral_transform(1,1,2,2,nBas,c,ERI_AO,ERI_aabb)
|
||||
|
||||
! 4-index transform for (bb|bb) block
|
||||
|
||||
call AOtoMO_integral_transform(2,2,2,2,nBas,c,ERI_AO,ERI_bbbb)
|
||||
|
||||
!------------------------------------------------!
|
||||
! Compute self-energy and renormalization factor !
|
||||
!------------------------------------------------!
|
||||
|
||||
call unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z)
|
||||
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
do is=1,nspin
|
||||
SigCp(:,:,is) = 0.5d0*(SigC(:,:,is) + transpose(SigC(:,:,is)))
|
||||
SigCm(:,:,is) = 0.5d0*(SigC(:,:,is) - transpose(SigC(:,:,is)))
|
||||
end do
|
||||
|
||||
do is=1,nspin
|
||||
call MOtoAO_transform(nBas,S,c(:,:,is),SigCp(:,:,is))
|
||||
end do
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
do is=1,nspin
|
||||
F(:,:,is) = Hc(:,:) + J(:,:,is) + J(:,:,mod(is,2)+1) + K(:,:,is) + SigCp(:,:,is)
|
||||
end do
|
||||
|
||||
! Check convergence
|
||||
|
||||
do is=1,nspin
|
||||
error(:,:,is) = matmul(F(:,:,is),matmul(P(:,:,is),S(:,:))) - matmul(matmul(S(:,:),P(:,:,is)),F(:,:,is))
|
||||
end do
|
||||
|
||||
if(nSCF > 1) conv = maxval(abs(error(:,:,:)))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(minval(rcond(:)) > 1d-7) then
|
||||
do is=1,nspin
|
||||
if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), &
|
||||
F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is))
|
||||
end do
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
do is=1,nspin
|
||||
Fp(:,:,is) = matmul(transpose(X(:,:)),matmul(F(:,:,is),X(:,:)))
|
||||
end do
|
||||
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
cp(:,:,:) = Fp(:,:,:)
|
||||
do is=1,nspin
|
||||
call diagonalize_matrix(nBas,cp(:,:,is),eGF2(:,is))
|
||||
end do
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
do is=1,nspin
|
||||
c(:,:,is) = matmul(X(:,:),cp(:,:,is))
|
||||
end do
|
||||
|
||||
! Back-transform self-energy
|
||||
|
||||
do is=1,nspin
|
||||
SigCp(:,:,is) = matmul(transpose(c(:,:,is)),matmul(SigCp(:,:,is),c(:,:,is)))
|
||||
end do
|
||||
|
||||
! Compute density matrix
|
||||
|
||||
do is=1,nspin
|
||||
P(:,:,is) = matmul(c(:,1:nO(is),is),transpose(c(:,1:nO(is),is)))
|
||||
end do
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
Conv = maxval(abs(eGF2(:,:) - eOld(:,:)))
|
||||
eOld(:,:) = eGF2(:,:)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute total energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do is=1,nspin
|
||||
ET(is) = trace_matrix(nBas,matmul(P(:,:,is),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do is=1,nspin
|
||||
EV(is) = trace_matrix(nBas,matmul(P(:,:,is),V(:,:)))
|
||||
end do
|
||||
|
||||
! Coulomb energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) &
|
||||
+ 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,1)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do is=1,nspin
|
||||
Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is)))
|
||||
end do
|
||||
|
||||
! Correlation energy
|
||||
|
||||
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EqsGF2,eGF2,Ec)
|
||||
|
||||
! Total energy
|
||||
|
||||
EqsGF2 = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:))
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Print results
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,SigCp,Z,dipole)
|
||||
|
||||
enddo
|
||||
!------------------------------------------------------------------------
|
||||
! End main loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,error,error_diis,F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
print*,'!!! BSE2 NYI for qsUGF2 !!!'
|
||||
|
||||
end if
|
||||
|
||||
end subroutine qsUGF2
|
||||
73
src/GF/self_energy_GF2.f90
Normal file
73
src/GF/self_energy_GF2.f90
Normal file
@ -0,0 +1,73 @@
|
||||
subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z)
|
||||
|
||||
! Compute GF2 self-energy and its renormalization factor
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
double precision,intent(in) :: eta
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGF2(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: i,j,a,b
|
||||
integer :: p,q
|
||||
double precision :: eps
|
||||
double precision :: num
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigC(nBas,nBas)
|
||||
double precision,intent(out) :: Z(nBas)
|
||||
|
||||
! Initialize
|
||||
|
||||
SigC(:,:) = 0d0
|
||||
Z(:) = 0d0
|
||||
|
||||
! Compute GF2 self-energy and renormalization factor
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do j=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
|
||||
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j)
|
||||
|
||||
SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do b=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
|
||||
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b)
|
||||
|
||||
SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
Z(:) = 1d0/(1d0 - Z(:))
|
||||
|
||||
end subroutine self_energy_GF2
|
||||
69
src/GF/self_energy_GF2_diag.f90
Normal file
69
src/GF/self_energy_GF2_diag.f90
Normal file
@ -0,0 +1,69 @@
|
||||
subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z)
|
||||
|
||||
! Compute diagonal part of the GF2 self-energy and its renormalization factor
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
double precision,intent(in) :: eta
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGF2(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: i,j,a,b
|
||||
integer :: p
|
||||
double precision :: eps
|
||||
double precision :: num
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigC(nBas)
|
||||
double precision,intent(out) :: Z(nBas)
|
||||
|
||||
! Initialize
|
||||
|
||||
SigC(:) = 0d0
|
||||
Z(:) = 0d0
|
||||
|
||||
! Compute GF2 self-energy
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do j=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
|
||||
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
|
||||
|
||||
SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do b=nO+1,nBas-nR
|
||||
|
||||
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
|
||||
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
|
||||
|
||||
SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2)
|
||||
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
Z(:) = 1d0/(1d0 - Z(:))
|
||||
|
||||
end subroutine self_energy_GF2_diag
|
||||
195
src/GF/unrestricted_self_energy_GF2.f90
Normal file
195
src/GF/unrestricted_self_energy_GF2.f90
Normal file
@ -0,0 +1,195 @@
|
||||
subroutine unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z)
|
||||
|
||||
! Perform unrestricted GF2 self-energy and its renormalization factor
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: eGF2(nBas,nspin)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: p,q
|
||||
integer :: i,j,a,b
|
||||
double precision :: eps,num
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigC(nBas,nBas,nspin)
|
||||
double precision,intent(out) :: Z(nBas,nspin)
|
||||
|
||||
!---------------------!
|
||||
! Compute self-energy |
|
||||
!---------------------!
|
||||
|
||||
SigC(:,:,:) = 0d0
|
||||
Z(:,:) = 0d0
|
||||
|
||||
!----------------!
|
||||
! Spin-up sector
|
||||
!----------------!
|
||||
|
||||
do p=nC(1)+1,nBas-nR(1)
|
||||
do q=nC(1)+1,nBas-nR(1)
|
||||
|
||||
! Addition part: aa
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do b=nO(1)+1,nBas-nR(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1)
|
||||
num = ERI_aa(i,q,a,b)*ERI_aa(a,b,i,p) &
|
||||
- ERI_aa(i,q,a,b)*ERI_aa(a,b,p,i)
|
||||
|
||||
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Addition part: ab
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do b=nO(1)+1,nBas-nR(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1)
|
||||
num = ERI_ab(q,i,b,a)*ERI_ab(b,a,p,i)
|
||||
|
||||
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: aa
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do j=nC(1)+1,nO(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1)
|
||||
num = ERI_aa(a,q,i,j)*ERI_aa(i,j,a,p) &
|
||||
- ERI_aa(a,q,i,j)*ERI_aa(i,j,p,a)
|
||||
|
||||
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: ab
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do j=nC(1)+1,nO(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1)
|
||||
num = ERI_ab(q,a,j,i)*ERI_ab(j,i,p,a)
|
||||
|
||||
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!------------------!
|
||||
! Spin-down sector !
|
||||
!------------------!
|
||||
|
||||
do p=nC(2)+1,nBas-nR(2)
|
||||
do q=nC(2)+1,nBas-nR(2)
|
||||
|
||||
! Addition part: bb
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do b=nO(2)+1,nBas-nR(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2)
|
||||
num = ERI_bb(i,q,a,b)*ERI_bb(a,b,i,p) &
|
||||
- ERI_bb(i,q,a,b)*ERI_bb(a,b,p,i)
|
||||
|
||||
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Addition part: ab
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do b=nO(2)+1,nBas-nR(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2)
|
||||
num = ERI_ab(i,q,a,b)*ERI_ab(a,b,i,p)
|
||||
|
||||
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: bb
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do j=nC(2)+1,nO(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2)
|
||||
num = ERI_bb(a,q,i,j)*ERI_bb(i,j,a,p) &
|
||||
- ERI_bb(a,q,i,j)*ERI_bb(i,j,p,a)
|
||||
|
||||
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: ab
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do j=nC(2)+1,nO(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2)
|
||||
num = ERI_ab(a,q,i,j)*ERI_ab(i,j,a,p)
|
||||
|
||||
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
|
||||
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
Z(:,:) = 1d0/(1d0 - Z(:,:))
|
||||
|
||||
end subroutine unrestricted_self_energy_GF2
|
||||
190
src/GF/unrestricted_self_energy_GF2_diag.f90
Normal file
190
src/GF/unrestricted_self_energy_GF2_diag.f90
Normal file
@ -0,0 +1,190 @@
|
||||
subroutine unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z)
|
||||
|
||||
! Perform unrestricted GF2 self-energy and its renormalization factor
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: eGF2(nBas,nspin)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: p
|
||||
integer :: i,j,a,b
|
||||
double precision :: eps,num
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigC(nBas,nspin)
|
||||
double precision,intent(out) :: Z(nBas,nspin)
|
||||
|
||||
!---------------------!
|
||||
! Compute self-energy |
|
||||
!---------------------!
|
||||
|
||||
SigC(:,:) = 0d0
|
||||
|
||||
!----------------!
|
||||
! Spin-up sector
|
||||
!----------------!
|
||||
|
||||
do p=nC(1)+1,nBas-nR(1)
|
||||
|
||||
! Addition part: aa
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do b=nO(1)+1,nBas-nR(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1)
|
||||
num = ERI_aa(i,p,a,b)*ERI_aa(a,b,i,p) &
|
||||
- ERI_aa(i,p,a,b)*ERI_aa(a,b,p,i)
|
||||
|
||||
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Addition part: ab
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do b=nO(1)+1,nBas-nR(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1)
|
||||
num = ERI_ab(p,i,b,a)*ERI_ab(b,a,p,i)
|
||||
|
||||
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: aa
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do j=nC(1)+1,nO(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1)
|
||||
num = ERI_aa(a,p,i,j)*ERI_aa(i,j,a,p) &
|
||||
- ERI_aa(a,p,i,j)*ERI_aa(i,j,p,a)
|
||||
|
||||
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: ab
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do j=nC(1)+1,nO(1)
|
||||
|
||||
eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1)
|
||||
num = ERI_ab(p,a,j,i)*ERI_ab(j,i,p,a)
|
||||
|
||||
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
!------------------!
|
||||
! Spin-down sector !
|
||||
!------------------!
|
||||
|
||||
do p=nC(2)+1,nBas-nR(2)
|
||||
|
||||
! Addition part: bb
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do b=nO(2)+1,nBas-nR(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2)
|
||||
num = ERI_bb(i,p,a,b)*ERI_bb(a,b,i,p) &
|
||||
- ERI_bb(i,p,a,b)*ERI_bb(a,b,p,i)
|
||||
|
||||
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Addition part: ab
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do b=nO(2)+1,nBas-nR(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2)
|
||||
num = ERI_ab(i,p,a,b)*ERI_ab(a,b,i,p)
|
||||
|
||||
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: bb
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do j=nC(2)+1,nO(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2)
|
||||
num = ERI_bb(a,p,i,j)*ERI_bb(i,j,a,p) &
|
||||
- ERI_bb(a,p,i,j)*ERI_bb(i,j,p,a)
|
||||
|
||||
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! Removal part: ab
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do j=nC(2)+1,nO(2)
|
||||
|
||||
eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2)
|
||||
num = ERI_ab(a,p,i,j)*ERI_ab(i,j,a,p)
|
||||
|
||||
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
|
||||
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
Z(:,:) = 1d0/(1d0 - Z(:,:))
|
||||
|
||||
end subroutine unrestricted_self_energy_GF2_diag
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P)
|
||||
subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P,Vx)
|
||||
|
||||
! Perform restricted Hartree-Fock calculation
|
||||
|
||||
@ -55,6 +55,7 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T
|
||||
double precision,intent(out) :: e(nBas)
|
||||
double precision,intent(out) :: c(nBas,nBas)
|
||||
double precision,intent(out) :: P(nBas,nBas)
|
||||
double precision,intent(out) :: Vx(nBas)
|
||||
|
||||
! Hello world
|
||||
|
||||
@ -126,11 +127,11 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(abs(rcond) < 1d-15) n_diis = 0
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Fock matrix
|
||||
|
||||
@ -196,7 +197,13 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
ERHF = ET + EV + EJ + EK
|
||||
|
||||
! Compute dipole moments
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_RHF(nBas,nO,e,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
|
||||
! Compute Vx for post-HF calculations
|
||||
|
||||
call exchange_potential(nBas,c,K,Vx)
|
||||
|
||||
end subroutine RHF
|
||||
|
||||
147
src/HF/RHF_stability.f90
Normal file
147
src/HF/RHF_stability.f90
Normal file
@ -0,0 +1,147 @@
|
||||
subroutine RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI)
|
||||
|
||||
! Perform a stability analysis of the RHF solution
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer,parameter :: maxS = 20
|
||||
integer :: ia
|
||||
integer :: ispin
|
||||
|
||||
double precision,allocatable :: A(:,:)
|
||||
double precision,allocatable :: B(:,:)
|
||||
double precision,allocatable :: AB(:,:)
|
||||
double precision,allocatable :: Om(:)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(A(nS,nS),B(nS,nS),AB(nS,nS),Om(nS))
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real RHF -> Real RHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
ispin = 1
|
||||
|
||||
call linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A)
|
||||
call linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B)
|
||||
|
||||
AB(:,:) = A(:,:) + B(:,:)
|
||||
|
||||
call diagonalize_matrix(nS,AB,Om)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real RHF -> Real RHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real RHF -> Complex RHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
AB(:,:) = A(:,:) - B(:,:)
|
||||
|
||||
call diagonalize_matrix(nS,AB,Om)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real RHF -> Complex RHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real RHF -> Real UHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
ispin = 2
|
||||
|
||||
call linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A)
|
||||
call linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B)
|
||||
|
||||
AB(:,:) = A(:,:) + B(:,:)
|
||||
|
||||
call diagonalize_matrix(nS,AB,Om)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real RHF -> Real UHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine RHF_stability
|
||||
209
src/HF/RMOM.f90
Normal file
209
src/HF/RMOM.f90
Normal file
@ -0,0 +1,209 @@
|
||||
subroutine RMOM(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P,Vx)
|
||||
|
||||
! Perform restricted Hartree-Fock calculation with MOM algorithm
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: maxSCF,max_diis,guess_type
|
||||
double precision,intent(in) :: thresh
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nNuc
|
||||
double precision,intent(in) :: ZNuc(nNuc)
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
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) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: n_diis
|
||||
double precision :: ET
|
||||
double precision :: EV
|
||||
double precision :: EJ
|
||||
double precision :: EK
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
double precision :: Conv
|
||||
double precision :: Gap
|
||||
double precision :: rcond
|
||||
double precision,external :: trace_matrix
|
||||
double precision,allocatable :: error(:,:)
|
||||
double precision,allocatable :: error_diis(:,:)
|
||||
double precision,allocatable :: F_diis(:,:)
|
||||
double precision,allocatable :: J(:,:)
|
||||
double precision,allocatable :: K(:,:)
|
||||
double precision,allocatable :: cp(:,:)
|
||||
double precision,allocatable :: F(:,:)
|
||||
double precision,allocatable :: Fp(:,:)
|
||||
double precision,allocatable :: ON(:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ERHF
|
||||
double precision,intent(out) :: e(nBas)
|
||||
double precision,intent(out) :: c(nBas,nBas)
|
||||
double precision,intent(out) :: P(nBas,nBas)
|
||||
double precision,intent(out) :: Vx(nBas)
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'*********************************************'
|
||||
write(*,*)'| Restricted Maximum Overlap Method |'
|
||||
write(*,*)'*********************************************'
|
||||
write(*,*)
|
||||
|
||||
! Useful quantities
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(J(nBas,nBas),K(nBas,nBas),error(nBas,nBas), &
|
||||
cp(nBas,nBas),Fp(nBas,nBas),F(nBas,nBas),ON(nBas), &
|
||||
error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
|
||||
! Guess coefficients and eigenvalues
|
||||
|
||||
call mo_guess(nBas,nO,guess_type,S,Hc,ERI,J,K,X,cp,F,Fp,e,c,P)
|
||||
|
||||
! ON(:) = 0d0
|
||||
! do i=1,nO
|
||||
! ON(i) = 1d0
|
||||
! ON(i) = dble(2*i-1)
|
||||
! end do
|
||||
|
||||
! call density_matrix(nBas,ON,c,P)
|
||||
|
||||
! Initialization
|
||||
|
||||
n_diis = 0
|
||||
F_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| RHF calculation |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','HF energy','|','Conv','|','HL Gap','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
|
||||
! Build Fock matrix
|
||||
|
||||
call Coulomb_matrix_AO_basis(nBas,P,ERI,J)
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI,K)
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:)
|
||||
|
||||
! Check convergence
|
||||
|
||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
Conv = maxval(abs(error))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Fock matrix
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,e)
|
||||
c = matmul(X,cp)
|
||||
|
||||
! Density matrix
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
|
||||
! call density_matrix(nBas,ON,c,P)
|
||||
|
||||
! Compute HF energy
|
||||
|
||||
ERHF = trace_matrix(nBas,matmul(P,Hc)) &
|
||||
+ 0.5d0*trace_matrix(nBas,matmul(P,J)) &
|
||||
+ 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
|
||||
! Compute HOMO-LUMO gap
|
||||
|
||||
if(nBas > nO) then
|
||||
|
||||
Gap = e(nO+1) - e(nO)
|
||||
|
||||
else
|
||||
|
||||
Gap = 0d0
|
||||
|
||||
endif
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ERHF+ENuc,'|',Conv,'|',Gap,'|'
|
||||
|
||||
enddo
|
||||
write(*,*)'----------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
! Compute HF energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
ERHF = ET + EV + EJ + EK
|
||||
|
||||
! Compute dipole moments
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_RHF(nBas,nO,e,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
|
||||
! Compute Vx for post-HF calculations
|
||||
|
||||
call exchange_potential(nBas,c,K,Vx)
|
||||
|
||||
end subroutine RMOM
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EUHF,e,c,P)
|
||||
subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EUHF,e,c,P,Vx)
|
||||
|
||||
! Perform unrestricted Hartree-Fock calculation
|
||||
|
||||
@ -59,6 +59,7 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO
|
||||
double precision,intent(out) :: e(nBas,nspin)
|
||||
double precision,intent(out) :: c(nBas,nBas,nspin)
|
||||
double precision,intent(out) :: P(nBas,nBas,nspin)
|
||||
double precision,intent(out) :: Vx(nBas,nspin)
|
||||
|
||||
! Hello world
|
||||
|
||||
@ -178,14 +179,14 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(minval(rcond(:)) > 1d-7) then
|
||||
do ispin=1,nspin
|
||||
if(nO(ispin) > 1) call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis,err_diis(:,1:n_diis,ispin), &
|
||||
F_diis(:,1:n_diis,ispin),err(:,:,ispin),F(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(minval(rcond(:)) < 1d-15) n_diis = 0
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute UHF energy
|
||||
@ -249,4 +250,10 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO
|
||||
call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_UHF(nBas,nO,S,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
|
||||
|
||||
! Compute Vx for post-HF calculations
|
||||
|
||||
do ispin=1,nspin
|
||||
call exchange_potential(nBas,c(:,:,ispin),K(:,:,ispin),Vx(:,ispin))
|
||||
end do
|
||||
|
||||
end subroutine UHF
|
||||
|
||||
174
src/HF/UHF_stability.f90
Normal file
174
src/HF/UHF_stability.f90
Normal file
@ -0,0 +1,174 @@
|
||||
subroutine UHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb)
|
||||
|
||||
! Perform a stability analysis of the UHF solution
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC(nspin)
|
||||
integer,intent(in) :: nO(nspin)
|
||||
integer,intent(in) :: nV(nspin)
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer,parameter :: maxS = 20
|
||||
integer :: ia
|
||||
integer :: ispin
|
||||
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision,allocatable :: Om_sc(:)
|
||||
double precision,allocatable :: A_sc(:,:)
|
||||
double precision,allocatable :: B_sc(:,:)
|
||||
double precision,allocatable :: AB_sc(:,:)
|
||||
|
||||
integer :: nS_ab,nS_ba,nS_sf
|
||||
double precision,allocatable :: Om_sf(:)
|
||||
double precision,allocatable :: A_sf(:,:)
|
||||
double precision,allocatable :: B_sf(:,:)
|
||||
double precision,allocatable :: AB_sf(:,:)
|
||||
|
||||
! Menory allocation
|
||||
|
||||
nS_aa = nS(1)
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(Om_sc(nS_sc),A_sc(nS_sc,nS_sc),B_sc(nS_sc,nS_sc),AB_sc(nS_sc,nS_sc))
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real UHF -> Real UHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
ispin = 1
|
||||
|
||||
call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,eHF, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,A_sc)
|
||||
call unrestricted_linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,B_sc)
|
||||
|
||||
AB_sc(:,:) = A_sc(:,:) + B_sc(:,:)
|
||||
|
||||
call diagonalize_matrix(nS_sc,AB_sc,Om_sc)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real UHF -> Real UHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS_sc,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om_sc(ia),'|',Om_sc(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om_sc(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sc(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sc(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real UHF -> Complex UHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
AB_sc(:,:) = A_sc(:,:) - B_sc(:,:)
|
||||
|
||||
call diagonalize_matrix(nS_sc,AB_sc,Om_sc)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real UHF -> Complex UHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS_sc,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om_sc(ia),'|',Om_sc(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om_sc(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sc(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sc(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
! Menory (de)allocation
|
||||
|
||||
|
||||
nS_ab = (nO(1) - nC(1))*(nV(2) - nR(2))
|
||||
nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1))
|
||||
nS_sf = nS_ab + nS_ba
|
||||
|
||||
deallocate(Om_sc,A_sc,B_sc,AB_sc)
|
||||
allocate(Om_sf(nS_sf),A_sf(nS_sf,nS_sf),B_sf(nS_sf,nS_sf),AB_sf(nS_sf,nS_sf))
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real UHF -> Real GHF
|
||||
!-------------------------------------------------------------!
|
||||
|
||||
ispin = 2
|
||||
|
||||
call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,1d0,eHF, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,A_sf)
|
||||
call unrestricted_linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,1d0, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,B_sf)
|
||||
|
||||
AB_sf(:,:) = A_sf(:,:) + B_sf(:,:)
|
||||
|
||||
call diagonalize_matrix(nS_sf,AB_sf,Om_sf)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'| Stability analysis: Real UHF -> Real GHF |'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') &
|
||||
'|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|'
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
do ia=1,min(nS_sf,maxS)
|
||||
write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') &
|
||||
'|',ia,'|',Om_sf(ia),'|',Om_sf(ia)*HaToeV,'|'
|
||||
enddo
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
|
||||
if(minval(Om_sf(:)) < 0d0) then
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sf(1),' au'
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!'
|
||||
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sf(1),' au'
|
||||
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end subroutine UHF_stability
|
||||
34
src/HF/exchange_potential.f90
Normal file
34
src/HF/exchange_potential.f90
Normal file
@ -0,0 +1,34 @@
|
||||
subroutine exchange_potential(nBas,c,Fx,Vx)
|
||||
|
||||
! Compute the exchange potential in the MO basis
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: Fx(nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: mu,nu
|
||||
integer :: p
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Vx(nBas)
|
||||
|
||||
! Compute Vx
|
||||
|
||||
Vx(:) = 0d0
|
||||
do p=1,nBas
|
||||
do mu=1,nBas
|
||||
do nu=1,nBas
|
||||
Vx(p) = Vx(p) + c(mu,p)*Fx(mu,nu)*c(nu,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine exchange_potential
|
||||
@ -86,4 +86,7 @@ subroutine linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,B_pp)
|
||||
|
||||
end if
|
||||
|
||||
! print*,'B pp-matrix'
|
||||
! call matout(nVV,nOO,B_pp)
|
||||
|
||||
end subroutine linear_response_B_pp
|
||||
|
||||
@ -96,4 +96,7 @@ subroutine linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,C_pp)
|
||||
|
||||
end if
|
||||
|
||||
! print*,'C pp-matrix'
|
||||
! call matout(nVV,nVV,C_pp)
|
||||
|
||||
end subroutine linear_response_C_pp
|
||||
|
||||
@ -96,4 +96,7 @@ subroutine linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,D_pp)
|
||||
|
||||
end if
|
||||
|
||||
! print*,'D pp-matrix'
|
||||
! call matout(nOO,nOO,D_pp)
|
||||
|
||||
end subroutine linear_response_D_pp
|
||||
|
||||
@ -88,7 +88,7 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,
|
||||
OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin))
|
||||
else
|
||||
|
||||
call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, &
|
||||
call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA, &
|
||||
OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin))
|
||||
end if
|
||||
|
||||
@ -127,7 +127,7 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,
|
||||
OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin))
|
||||
else
|
||||
|
||||
call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, &
|
||||
call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA, &
|
||||
OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin))
|
||||
end if
|
||||
|
||||
|
||||
@ -36,6 +36,7 @@ subroutine Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,
|
||||
chi = 0d0
|
||||
do kc=1,nS
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
! chi = chi + lambda*rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps
|
||||
chi = chi + rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps
|
||||
enddo
|
||||
|
||||
|
||||
@ -36,6 +36,7 @@ subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,OmRPA,rho_
|
||||
chi = 0d0
|
||||
do kc=1,nS
|
||||
eps = OmRPA(kc)**2 + eta**2
|
||||
! chi = chi + lambda*rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/eps
|
||||
chi = chi + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/eps
|
||||
enddo
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA,OmBSE,XpY,XmY)
|
||||
subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA,OmBSE,XpY,XmY)
|
||||
|
||||
! Compute dynamical effects via perturbation theory for BSE
|
||||
|
||||
@ -16,6 +16,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
|
||||
double precision,intent(in) :: eW(nBas)
|
||||
double precision,intent(in) :: eGW(nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: OmRPA(nS)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eG0T0)
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0)
|
||||
|
||||
! Perform one-shot calculation with a T-matrix self-energy (G0T0)
|
||||
|
||||
@ -30,8 +30,12 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
@ -54,6 +58,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
double precision,allocatable :: X2s(:,:),X2t(:,:)
|
||||
double precision,allocatable :: Y2s(:,:),Y2t(:,:)
|
||||
double precision,allocatable :: rho2s(:,:,:),rho2t(:,:,:)
|
||||
double precision,allocatable :: SigX(:)
|
||||
double precision,allocatable :: SigT(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
|
||||
@ -90,7 +95,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), &
|
||||
Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), &
|
||||
rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), &
|
||||
SigT(nBas),Z(nBas))
|
||||
SigX(nBas),SigT(nBas),Z(nBas))
|
||||
|
||||
!----------------------------------------------
|
||||
! alpha-beta block
|
||||
@ -101,7 +106,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI_MO(:,:,:,:), &
|
||||
Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin))
|
||||
|
||||
! EcRPA(ispin) = 1d0*EcRPA(ispin)
|
||||
@ -118,7 +123,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI_MO(:,:,:,:), &
|
||||
Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin))
|
||||
|
||||
! EcRPA(ispin) = 2d0*EcRPA(ispin)
|
||||
@ -139,7 +144,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
xERI = +0d0
|
||||
alpha = +1d0
|
||||
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI(:,:,:,:), &
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO(:,:,:,:), &
|
||||
X1s(:,:),Y1s(:,:),rho1s(:,:,:),X2s(:,:),Y2s(:,:),rho2s(:,:,:))
|
||||
|
||||
call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:), &
|
||||
@ -153,7 +158,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
xERI = -1d0
|
||||
alpha = +1d0
|
||||
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI(:,:,:,:), &
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO(:,:,:,:), &
|
||||
X1t(:,:),Y1t(:,:),rho1t(:,:,:),X2t(:,:),Y2t(:,:),rho2t(:,:,:))
|
||||
|
||||
call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:), &
|
||||
@ -164,17 +169,24 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
|
||||
Z(:) = 1d0/(1d0 - Z(:))
|
||||
|
||||
|
||||
!----------------------------------------------
|
||||
! Compute the exchange part of the self-energy
|
||||
!----------------------------------------------
|
||||
|
||||
call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX)
|
||||
|
||||
!----------------------------------------------
|
||||
! Solve the quasi-particle equation
|
||||
!----------------------------------------------
|
||||
|
||||
if(linearize) then
|
||||
|
||||
eG0T0(:) = eHF(:) + Z(:)*SigT(:)
|
||||
eG0T0(:) = eHF(:) + Z(:)*(SigX(:) + SigT(:) - Vxc(:))
|
||||
|
||||
else
|
||||
|
||||
eG0T0(:) = eHF(:) + SigT(:)
|
||||
eG0T0(:) = eHF(:) + SigX(:) + SigT(:) - Vxc(:)
|
||||
|
||||
end if
|
||||
|
||||
@ -188,11 +200,11 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
|
||||
ispin = 1
|
||||
iblock = 3
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eG0T0(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eG0T0(:),ERI_MO(:,:,:,:), &
|
||||
Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin))
|
||||
ispin = 2
|
||||
iblock = 4
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eG0T0(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eG0T0(:),ERI_MO(:,:,:,:), &
|
||||
Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin))
|
||||
EcRPA(1) = EcRPA(1) - EcRPA(2)
|
||||
EcRPA(2) = 3d0*EcRPA(2)
|
||||
@ -211,7 +223,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
if(BSE) then
|
||||
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eG0T0,EcBSE)
|
||||
nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0T0,EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -246,7 +258,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing
|
||||
end if
|
||||
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI,eHF,eG0T0,EcAC)
|
||||
nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eG0T0,EcAC)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
dBSE,dTDA,evDyn,singlet,triplet,linearize,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eGW)
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
|
||||
! Perform G0W0 calculation
|
||||
|
||||
@ -29,9 +29,13 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -41,6 +45,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
double precision :: EcGM
|
||||
double precision,allocatable :: SigX(:)
|
||||
double precision,allocatable :: SigC(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
@ -48,11 +53,11 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
double precision,allocatable :: XmY_RPA(:,:)
|
||||
double precision,allocatable :: rho_RPA(:,:,:)
|
||||
|
||||
double precision,allocatable :: eGWlin(:)
|
||||
double precision,allocatable :: eG0W0lin(:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision :: eGW(nBas)
|
||||
double precision :: eG0W0(nBas)
|
||||
|
||||
! Hello world
|
||||
|
||||
@ -100,14 +105,14 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(SigC(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eGWlin(nBas))
|
||||
allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eG0W0lin(nBas))
|
||||
|
||||
!-------------------!
|
||||
! Compute screening !
|
||||
!-------------------!
|
||||
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0, &
|
||||
eHF,ERI,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
eHF,ERI_MO,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
if(print_W) call print_excitation('RPA@HF ',ispin,nS,OmRPA)
|
||||
|
||||
@ -115,12 +120,13 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
! Compute spectral weights !
|
||||
!--------------------------!
|
||||
|
||||
call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA)
|
||||
call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA)
|
||||
|
||||
!------------------------!
|
||||
! Compute GW self-energy !
|
||||
!------------------------!
|
||||
|
||||
call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX)
|
||||
call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC)
|
||||
|
||||
!--------------------------------!
|
||||
@ -133,7 +139,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
! Solve the quasi-particle equation !
|
||||
!-----------------------------------!
|
||||
|
||||
eGWlin(:) = eHF(:) + Z(:)*SigC(:)
|
||||
eG0W0lin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:))
|
||||
|
||||
! Linearized or graphical solution?
|
||||
|
||||
@ -142,14 +148,14 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
|
||||
write(*,*)
|
||||
|
||||
eGW(:) = eGWlin(:)
|
||||
eG0W0(:) = eG0W0lin(:)
|
||||
|
||||
else
|
||||
|
||||
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
|
||||
write(*,*)
|
||||
|
||||
call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,OmRPA,rho_RPA,eGWlin,eGW)
|
||||
call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,OmRPA,rho_RPA,eG0W0lin,eG0W0)
|
||||
|
||||
! Find all the roots of the QP equation if necessary
|
||||
|
||||
@ -159,18 +165,18 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
|
||||
! Compute the RPA correlation energy
|
||||
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, &
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eG0W0,ERI_MO,OmRPA, &
|
||||
rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
!--------------!
|
||||
! Dump results !
|
||||
!--------------!
|
||||
|
||||
call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
|
||||
call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eG0W0,EcRPA,EcGM)
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eGWlin)
|
||||
deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eG0W0lin)
|
||||
|
||||
! Plot stuff
|
||||
|
||||
@ -180,7 +186,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE)
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0W0,EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -202,9 +208,9 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
|
||||
if(doACFDT) then
|
||||
|
||||
write(*,*) '--------------------------------------------------------------'
|
||||
write(*,*) ' Adiabatic connection version of BSE@UG0W0 correlation energy '
|
||||
write(*,*) '--------------------------------------------------------------'
|
||||
write(*,*) '-------------------------------------------------------------'
|
||||
write(*,*) ' Adiabatic connection version of BSE@G0W0 correlation energy '
|
||||
write(*,*) '-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
if(doXBS) then
|
||||
@ -214,14 +220,14 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
|
||||
end if
|
||||
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcAC)
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eG0W0,EcAC)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (singlet) =',EcAC(1)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (triplet) =',EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy =',EcAC(1) + EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy (singlet) =',EcAC(1)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy (triplet) =',EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy =',EcAC(1) + EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW)
|
||||
subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,Omega,rho,eGWlin,eGW)
|
||||
|
||||
! Compute the graphical solution of the QP equation
|
||||
|
||||
@ -15,6 +15,8 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW)
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: SigX(nBas)
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: Omega(nS)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS)
|
||||
|
||||
@ -27,7 +29,7 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW)
|
||||
integer,parameter :: maxIt = 64
|
||||
double precision,parameter :: thresh = 1d-6
|
||||
double precision,external :: SigmaC,dSigmaC
|
||||
double precision :: sig,dsig
|
||||
double precision :: sigC,dsigC
|
||||
double precision :: f,df
|
||||
double precision :: w
|
||||
|
||||
@ -52,14 +54,14 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW)
|
||||
|
||||
nIt = nIt + 1
|
||||
|
||||
sig = SigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
dsig = dSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
f = w - eHF(p) - sig
|
||||
df = 1d0 - dsig
|
||||
sigC = SigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
dsigC = dSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
f = w - eHF(p) - SigX(p) - sigC + Vxc(p)
|
||||
df = 1d0 - dsigC
|
||||
|
||||
w = w - f/df
|
||||
|
||||
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sig
|
||||
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sigC
|
||||
|
||||
|
||||
end do
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, &
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eGW)
|
||||
linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eGW)
|
||||
|
||||
! Perform unrestricted G0W0 calculation
|
||||
|
||||
@ -34,6 +34,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EUHF
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
@ -42,6 +43,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: cHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: PHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: Vxc(nBas,nspin)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -52,6 +54,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
double precision :: EcGM(nspin)
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
double precision,allocatable :: SigX(:,:)
|
||||
double precision,allocatable :: SigC(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
@ -106,8 +109,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(SigC(nBas,nspin),Z(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc), &
|
||||
rho_RPA(nBas,nBas,nS_sc,nspin),eGWlin(nBas,nspin))
|
||||
allocate(SigX(nBas,nspin),SigC(nBas,nspin),Z(nBas,nspin),eGWlin(nBas,nspin), &
|
||||
OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin))
|
||||
|
||||
!-------------------!
|
||||
! Compute screening !
|
||||
@ -132,6 +135,10 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
! Compute self-energy !
|
||||
!---------------------!
|
||||
|
||||
do is=1,nspin
|
||||
call self_energy_exchange_diag(nBas,cHF(:,:,is),PHF(:,:,is),ERI,SigX(:,is))
|
||||
end do
|
||||
|
||||
call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC,EcGM)
|
||||
|
||||
!--------------------------------!
|
||||
@ -144,7 +151,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
! Solve the quasi-particle equation !
|
||||
!-----------------------------------!
|
||||
|
||||
eGWlin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:)
|
||||
eGWlin(:,:) = eHF(:,:) + Z(:,:)*(SigX(:,:) + SigC(:,:) - Vxc(:,:))
|
||||
|
||||
if(linearize) then
|
||||
|
||||
@ -158,8 +165,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
! Find graphical solution of the QP equation
|
||||
|
||||
do is=1,nspin
|
||||
call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),OmRPA, &
|
||||
rho_RPA(:,:,:,is),eGWlin(:,is),eGW(:,is))
|
||||
call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),SigX(:,is),Vxc(:,is), &
|
||||
OmRPA,rho_RPA(:,:,:,is),eGWlin(:,is),eGW(:,is))
|
||||
end do
|
||||
|
||||
end if
|
||||
@ -187,7 +194,11 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcBSE(1) = 0.5d0*EcBSE(1)
|
||||
EcBSE(2) = 1.5d0*EcBSE(1)
|
||||
EcBSE(2) = 0.5d0*EcBSE(2)
|
||||
|
||||
else
|
||||
|
||||
EcBSE(2) = 0.0d0
|
||||
|
||||
end if
|
||||
|
||||
@ -204,9 +215,9 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
|
||||
|
||||
if(doACFDT) then
|
||||
|
||||
write(*,*) '------------------------------------------------------'
|
||||
write(*,*) 'Adiabatic connection version of BSE correlation energy'
|
||||
write(*,*) '------------------------------------------------------'
|
||||
write(*,*) '------------------------------------------------------------'
|
||||
write(*,*) 'Adiabatic connection version of BSE@UG0W0 correlation energy'
|
||||
write(*,*) '------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
if(doXBS) then
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
|
||||
eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eG0T0)
|
||||
BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas, &
|
||||
nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0)
|
||||
|
||||
! Perform eigenvalue self-consistent calculation with a T-matrix self-energy (evGT)
|
||||
|
||||
@ -33,8 +33,12 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: eG0T0(nBas)
|
||||
|
||||
@ -68,6 +72,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
double precision,allocatable :: X2s(:,:),X2t(:,:)
|
||||
double precision,allocatable :: Y2s(:,:),Y2t(:,:)
|
||||
double precision,allocatable :: rho2s(:,:,:),rho2t(:,:,:)
|
||||
double precision,allocatable :: SigX(:)
|
||||
double precision,allocatable :: SigT(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
|
||||
@ -102,9 +107,13 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), &
|
||||
Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), &
|
||||
rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), &
|
||||
eGT(nBas),eOld(nBas),Z(nBas),SigT(nBas), &
|
||||
eGT(nBas),eOld(nBas),Z(nBas),SigX(nBas),SigT(nBas), &
|
||||
error_diis(nBas,max_diis),e_diis(nBas,max_diis))
|
||||
|
||||
! Compute the exchange part of the self-energy
|
||||
|
||||
call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX)
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
@ -131,7 +140,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI_MO(:,:,:,:), &
|
||||
Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin))
|
||||
|
||||
! EcRPA(ispin) = 1d0*EcRPA(ispin)
|
||||
@ -148,7 +157,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI_MO(:,:,:,:), &
|
||||
Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin))
|
||||
|
||||
! EcRPA(ispin) = 2d0*EcRPA(ispin)
|
||||
@ -169,7 +178,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
xERI = +0d0
|
||||
alpha = +1d0
|
||||
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI(:,:,:,:), &
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO(:,:,:,:), &
|
||||
X1s(:,:),Y1s(:,:),rho1s(:,:,:),X2s(:,:),Y2s(:,:),rho2s(:,:,:))
|
||||
|
||||
call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:), &
|
||||
@ -183,7 +192,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
xERI = -1d0
|
||||
alpha = +1d0
|
||||
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI(:,:,:,:), &
|
||||
call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO(:,:,:,:), &
|
||||
X1t(:,:),Y1t(:,:),rho1t(:,:,:),X2t(:,:),Y2t(:,:),rho2t(:,:,:))
|
||||
|
||||
call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:), &
|
||||
@ -200,7 +209,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
! Solve the quasi-particle equation
|
||||
!----------------------------------------------
|
||||
|
||||
eGT(:) = eHF(:) + SigT(:)
|
||||
eGT(:) = eHF(:) + SigX(:) + SigT(:) - Vxc(:)
|
||||
|
||||
! Convergence criteria
|
||||
|
||||
@ -238,11 +247,11 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
|
||||
ispin = 1
|
||||
iblock = 3
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI_MO(:,:,:,:), &
|
||||
Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin))
|
||||
ispin = 2
|
||||
iblock = 4
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI(:,:,:,:), &
|
||||
call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI_MO(:,:,:,:), &
|
||||
Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin))
|
||||
EcRPA(1) = EcRPA(1) - EcRPA(2)
|
||||
EcRPA(2) = 3d0*EcRPA(2)
|
||||
@ -262,7 +271,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
if(BSE) then
|
||||
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eGT,eGT,EcRPA,EcBSE)
|
||||
nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eGT,eGT,EcRPA,EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -297,7 +306,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, &
|
||||
end if
|
||||
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI,eGT,eGT,EcAC)
|
||||
nBas,nC,nO,nV,nR,nS,ERI_MO,eGT,eGT,EcAC)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI, &
|
||||
dipole_int,eHF,eG0W0)
|
||||
G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, &
|
||||
ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
|
||||
! Perform self-consistent eigenvalue-only GW calculation
|
||||
|
||||
@ -31,9 +31,13 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
logical,intent(in) :: triplet
|
||||
double precision,intent(in) :: eta
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: eG0W0(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
@ -54,6 +58,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
double precision,allocatable :: eGW(:)
|
||||
double precision,allocatable :: eOld(:)
|
||||
double precision,allocatable :: Z(:)
|
||||
double precision,allocatable :: SigX(:)
|
||||
double precision,allocatable :: SigC(:)
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
double precision,allocatable :: XpY_RPA(:,:)
|
||||
@ -117,9 +122,13 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGW(nBas),eOld(nBas),Z(nBas),SigC(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS), &
|
||||
allocate(eGW(nBas),eOld(nBas),Z(nBas),SigX(nBas),SigC(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS), &
|
||||
rho_RPA(nBas,nBas,nS),error_diis(nBas,max_diis),e_diis(nBas,max_diis))
|
||||
|
||||
! Compute the exchange part of the self-energy
|
||||
|
||||
call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX)
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
@ -142,14 +151,14 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
if(.not. GW0 .or. nSCF == 0) then
|
||||
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, &
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,OmRPA, &
|
||||
rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
endif
|
||||
|
||||
! Compute spectral weights
|
||||
|
||||
call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA)
|
||||
call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA)
|
||||
|
||||
! Compute correlation part of the self-energy
|
||||
|
||||
@ -167,7 +176,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
eGW(:) = eHF(:) + SigC(:)
|
||||
eGW(:) = eHF(:) + SigX(:) + SigC(:) - Vxc(:)
|
||||
|
||||
! Convergence criteria
|
||||
|
||||
@ -186,11 +195,11 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
else
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBas,nBas,n_diis,error_diis,e_diis,eGW-eOld,eGW)
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(abs(rcond) < 1d-15) n_diis = 0
|
||||
else
|
||||
n_diis = 0
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
@ -233,7 +242,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eGW,eGW,EcBSE)
|
||||
call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eGW,eGW,EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -267,7 +276,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
end if
|
||||
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcAC)
|
||||
call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcAC)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, &
|
||||
G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc, &
|
||||
EUHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eHF,eG0W0)
|
||||
EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
|
||||
! Perform self-consistent eigenvalue-only GW calculation
|
||||
|
||||
@ -37,10 +37,13 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
|
||||
double precision,intent(in) :: PHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: eHF(nBas,nspin)
|
||||
double precision,intent(in) :: cHF(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: Vxc(nBas,nspin)
|
||||
double precision,intent(in) :: eG0W0(nBas,nspin)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
@ -67,6 +70,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
|
||||
double precision,allocatable :: eOld(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision,allocatable :: SigX(:,:)
|
||||
double precision,allocatable :: SigC(:,:)
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
double precision,allocatable :: XpY_RPA(:,:)
|
||||
@ -127,8 +131,15 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc), &
|
||||
XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin),error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin))
|
||||
allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigX(nBas,nspin),SigC(nBas,nspin), &
|
||||
OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin), &
|
||||
error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin))
|
||||
|
||||
! Compute the exchange part of the self-energy
|
||||
|
||||
do is=1,nspin
|
||||
call self_energy_exchange_diag(nBas,cHF(:,:,is),PHF(:,:,is),ERI_AO,SigX(:,is))
|
||||
end do
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -182,7 +193,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
|
||||
! Solve the quasi-particle equation !
|
||||
!-----------------------------------!
|
||||
|
||||
eGW(:,:) = eHF(:,:) + SigC(:,:)
|
||||
eGW(:,:) = eHF(:,:) + SigX(:,:) + SigC(:,:) - Vxc(:,:)
|
||||
|
||||
! Convergence criteria
|
||||
|
||||
@ -257,7 +268,11 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcBSE(1) = 0.5d0*EcBSE(1)
|
||||
EcBSE(2) = 1.5d0*EcBSE(2)
|
||||
EcBSE(2) = 0.5d0*EcBSE(2)
|
||||
|
||||
else
|
||||
|
||||
EcBSE(2) = 0.0d0
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z,EcRPA,EqsGW,dipole)
|
||||
subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsGW
|
||||
|
||||
@ -7,18 +7,29 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas,nO,nSCF
|
||||
double precision,intent(in) :: ENuc,EcRPA,Conv,thresh
|
||||
double precision,intent(in) :: eHF(nBas),eGW(nBas),c(nBas),P(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas)
|
||||
double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas),SigC(nBas,nBas)
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
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) :: EcGM
|
||||
double precision,intent(in) :: EcRPA
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGW(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: SigC(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: x,ixyz,HOMO,LUMO
|
||||
double precision :: Gap,ET,EV,EJ,Ex,Ec
|
||||
double precision :: Gap
|
||||
double precision,external :: trace_matrix
|
||||
|
||||
! Output variables
|
||||
@ -33,14 +44,6 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z
|
||||
|
||||
! Compute energies
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
Ex = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
Ec = 0d0
|
||||
! Ec = -0.50d0*trace_matrix(nBas,matmul(P,SigC))
|
||||
EqsGW = ET + EV + EJ + Ex + Ec
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
@ -61,15 +64,15 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z
|
||||
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
|
||||
write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGW HOMO energy:',eGW(HOMO)*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGW LUMO energy:',eGW(LUMO)*HaToeV,' eV'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsGW HOMO-LUMO gap :',Gap*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',EqsGW + ENuc,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',ENuc + EqsGW,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsGW exchange energy:',Ex,' au'
|
||||
! write(*,'(2X,A30,F15.6,A3)') ' qsGW correlation energy:',Ec,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' GM@qsGW correlation energy:',EcGM,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'RPA@qsGW correlation energy:',EcRPA,' au'
|
||||
write(*,*)'-------------------------------------------'
|
||||
write(*,*)
|
||||
@ -89,7 +92,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Hartree energy: ',EJ,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au'
|
||||
! write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',EcGM,' au'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au'
|
||||
write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, &
|
||||
ENuc,ET,EV,EJ,Ex,Ec,EcRPA,EqsGW,SigC,Z,dipole)
|
||||
ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,SigC,Z,dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsUGW
|
||||
|
||||
@ -16,7 +16,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, &
|
||||
double precision,intent(in) :: EV(nspin)
|
||||
double precision,intent(in) :: EJ(nsp)
|
||||
double precision,intent(in) :: Ex(nspin)
|
||||
double precision,intent(in) :: Ec(nsp)
|
||||
double precision,intent(in) :: EcGM(nspin)
|
||||
double precision,intent(in) :: EcRPA
|
||||
double precision,intent(in) :: EqsGW
|
||||
double precision,intent(in) :: Conv
|
||||
@ -92,7 +92,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, &
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
|
||||
write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv
|
||||
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO energy:',maxval(HOMO(:))*HaToeV,' eV'
|
||||
@ -100,9 +100,9 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, &
|
||||
write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',EqsGW + ENuc,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',ENuc + EqsGW,' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' qsUGW exchange energy:',sum(Ex(:)),' au'
|
||||
! write(*,'(2X,A30,F15.6,A3)') ' qsUGW correlation energy:',sum(Ec(:)),' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') ' GM@qsUGW correlation energy:',sum(EcGM(:)),' au'
|
||||
write(*,'(2X,A30,F15.6,A3)') 'RPA@qsUGW correlation energy:',EcRPA,' au'
|
||||
write(*,*)'-------------------------------------------------------------------------------&
|
||||
-------------------------------------------------'
|
||||
@ -141,15 +141,14 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, &
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au'
|
||||
! write(*,*)
|
||||
! write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au'
|
||||
! write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au'
|
||||
! write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au'
|
||||
! write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au'
|
||||
write(*,*)
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(EcGM(:)),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',EcGM(1),' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',EcGM(2),' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',EqsGW + ENuc,' au'
|
||||
write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',ENuc + EqsGW,' au'
|
||||
write(*,'(A60)') '-------------------------------------------------'
|
||||
write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0
|
||||
write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0
|
||||
|
||||
@ -55,6 +55,10 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
integer :: nBasSq
|
||||
integer :: ispin
|
||||
integer :: n_diis
|
||||
double precision :: ET
|
||||
double precision :: EV
|
||||
double precision :: EJ
|
||||
double precision :: Ex
|
||||
double precision :: EqsGW
|
||||
double precision :: EcRPA
|
||||
double precision :: EcBSE(nspin)
|
||||
@ -65,6 +69,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
double precision,external :: trace_matrix
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
logical :: print_W = .true.
|
||||
double precision,allocatable :: error_diis(:,:)
|
||||
double precision,allocatable :: F_diis(:,:)
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
@ -74,6 +79,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
double precision,allocatable :: c(:,:)
|
||||
double precision,allocatable :: cp(:,:)
|
||||
double precision,allocatable :: eGW(:)
|
||||
double precision,allocatable :: eOld(:)
|
||||
double precision,allocatable :: P(:,:)
|
||||
double precision,allocatable :: F(:,:)
|
||||
double precision,allocatable :: Fp(:,:)
|
||||
@ -132,7 +138,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGW(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
allocate(eGW(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),SigCm(nBas,nBas),Z(nBas), &
|
||||
OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS), &
|
||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
@ -145,9 +151,11 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
Conv = 1d0
|
||||
P(:,:) = PHF(:,:)
|
||||
eGW(:) = eHF(:)
|
||||
eOld(:) = eHF(:)
|
||||
c(:,:) = cHF(:,:)
|
||||
F_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
rcond = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main loop
|
||||
@ -177,6 +185,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
|
||||
call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO, &
|
||||
OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
if(print_W) call print_excitation('RPA@qsGW ',ispin,nS,OmRPA)
|
||||
|
||||
endif
|
||||
|
||||
@ -210,16 +219,15 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
Conv = maxval(abs(error))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(abs(rcond) < 1d-15) n_diis = 0
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
@ -227,15 +235,45 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGW)
|
||||
c = matmul(X,cp)
|
||||
SigCp = matmul(transpose(c),matmul(SigCp,c))
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
Conv = maxval(abs(eGW - eOld))
|
||||
eOld(:) = eGW(:)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute total 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 = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
|
||||
! Total energy
|
||||
|
||||
EqsGW = ET + EV + EJ + Ex
|
||||
|
||||
! Print results
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigCp,Z,EcRPA,EqsGW,dipole)
|
||||
call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole)
|
||||
|
||||
enddo
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
@ -75,8 +75,8 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
double precision :: EV(nspin)
|
||||
double precision :: EJ(nsp)
|
||||
double precision :: Ex(nspin)
|
||||
double precision :: Ec(nsp)
|
||||
double precision :: EcRPA
|
||||
double precision :: EcGM(nspin)
|
||||
double precision :: EqsGW
|
||||
double precision :: EcBSE(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
@ -92,6 +92,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
double precision,allocatable :: c(:,:,:)
|
||||
double precision,allocatable :: cp(:,:,:)
|
||||
double precision,allocatable :: eGW(:,:)
|
||||
double precision,allocatable :: eOld(:,:)
|
||||
double precision,allocatable :: P(:,:,:)
|
||||
double precision,allocatable :: F(:,:,:)
|
||||
double precision,allocatable :: Fp(:,:,:)
|
||||
@ -154,10 +155,11 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
nS_bb = nS(2)
|
||||
nS_sc = nS_aa + nS_bb
|
||||
|
||||
allocate(eGW(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), &
|
||||
J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin),SigCm(nBas,nBas,nspin), &
|
||||
Z(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin), &
|
||||
error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin))
|
||||
allocate(eGW(nBas,nspin),eOld(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin), &
|
||||
Fp(nBas,nBas,nspin),J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin), &
|
||||
SigCm(nBas,nBas,nspin),Z(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc), &
|
||||
rho_RPA(nBas,nBas,nS_sc,nspin),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin), &
|
||||
F_diis(nBasSq,max_diis,nspin))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -167,9 +169,11 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
Conv = 1d0
|
||||
P(:,:,:) = PHF(:,:,:)
|
||||
eGW(:,:) = eHF(:,:)
|
||||
eOld(:,:) = eHF(:,:)
|
||||
c(:,:,:) = cHF(:,:,:)
|
||||
F_diis(:,:,:) = 0d0
|
||||
error_diis(:,:,:) = 0d0
|
||||
rcond = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main loop
|
||||
@ -230,12 +234,12 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
|
||||
if(G0W) then
|
||||
|
||||
call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC)
|
||||
call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC,EcGM)
|
||||
call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,Z)
|
||||
|
||||
else
|
||||
|
||||
call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,SigC)
|
||||
call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,SigC,EcGM)
|
||||
call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,Z)
|
||||
|
||||
endif
|
||||
@ -268,14 +272,14 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(minval(rcond(:)) > 1d-7) then
|
||||
do is=1,nspin
|
||||
if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), &
|
||||
F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is))
|
||||
end do
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
if(minval(rcond(:)) < 1d-15) n_diis = 0
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
@ -296,12 +300,23 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
c(:,:,is) = matmul(X(:,:),cp(:,:,is))
|
||||
end do
|
||||
|
||||
! Back-transform self-energy
|
||||
|
||||
do is=1,nspin
|
||||
SigCp(:,:,is) = matmul(transpose(c(:,:,is)),matmul(SigCp(:,:,is),c(:,:,is)))
|
||||
end do
|
||||
|
||||
! Compute density matrix
|
||||
|
||||
do is=1,nspin
|
||||
P(:,:,is) = matmul(c(:,1:nO(is),is),transpose(c(:,1:nO(is),is)))
|
||||
end do
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
Conv = maxval(abs(eGW(:,:) - eOld(:,:)))
|
||||
eOld(:,:) = eGW(:,:)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute total energy
|
||||
!------------------------------------------------------------------------
|
||||
@ -321,7 +336,8 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
! Coulomb energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = 1.0d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(2) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) &
|
||||
+ 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,1)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
@ -330,25 +346,16 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is)))
|
||||
end do
|
||||
|
||||
! Correlation energy
|
||||
|
||||
Ec(:) = 0d0
|
||||
|
||||
! Ec(1) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,1),SigCp(:,:,1)))
|
||||
! Ec(2) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,1),SigCp(:,:,2))) &
|
||||
! - 0.25d0*trace_matrix(nBas,matmul(P(:,:,2),SigCp(:,:,1)))
|
||||
! Ec(3) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,2),SigCp(:,:,2)))
|
||||
|
||||
! Total energy
|
||||
|
||||
EqsGW = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:))
|
||||
EqsGW = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:))
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Print results
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EcRPA,EqsGW,SigCp,Z,dipole)
|
||||
call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,SigCp,Z,dipole)
|
||||
|
||||
enddo
|
||||
!------------------------------------------------------------------------
|
||||
@ -375,19 +382,23 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error,error_diis,F_diis)
|
||||
deallocate(cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error,error_diis,F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, &
|
||||
S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eGW,eGW,EcBSE)
|
||||
S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,c,eGW,eGW,EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcBSE(1) = 0.5d0*EcBSE(1)
|
||||
EcBSE(2) = 1.5d0*EcBSE(2)
|
||||
EcBSE(2) = 0.5d0*EcBSE(2)
|
||||
|
||||
else
|
||||
|
||||
EcBSE(2) = 0.0d0
|
||||
|
||||
end if
|
||||
|
||||
@ -396,7 +407,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy (spin-conserved) =',EcBSE(1)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy (spin-flip) =',EcBSE(2)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy =',EcBSE(1) + EcBSE(2)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW total energy =',ENuc + EUHF + EcBSE(1) + EcBSE(2)
|
||||
write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW total energy =',ENuc + EqsGW + EcBSE(1) + EcBSE(2)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
@ -424,7 +435,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy (spin-conserved) =',EcAC(1)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy (spin-flip) =',EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy =',EcAC(1) + EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW total energy =',ENuc + EUHF + EcAC(1) + EcAC(2)
|
||||
write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW total energy =',ENuc + EqsGW + EcAC(1) + EcAC(2)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
|
||||
@ -16,7 +16,9 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: i,j,a,b,p,x,y,jb
|
||||
integer :: i,j,a,b
|
||||
integer :: p,q,r
|
||||
integer :: jb
|
||||
double precision :: eps
|
||||
|
||||
! Output variables
|
||||
@ -26,7 +28,7 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! Initialize
|
||||
|
||||
SigC = 0d0
|
||||
SigC(:,:) = 0d0
|
||||
|
||||
!-----------------------------!
|
||||
! COHSEX static approximation !
|
||||
@ -36,11 +38,11 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! COHSEX: SEX of the COHSEX correlation self-energy
|
||||
|
||||
do x=nC+1,nBas-nR
|
||||
do y=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do jb=1,nS
|
||||
SigC(x,y) = SigC(x,y) + 4d0*rho(x,i,jb)*rho(y,i,jb)/Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) + 4d0*rho(p,i,jb)*rho(q,i,jb)/Omega(jb)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
@ -48,11 +50,11 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! COHSEX: COH part of the COHSEX correlation self-energy
|
||||
|
||||
do x=nC+1,nBas-nR
|
||||
do y=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do r=nC+1,nBas-nR
|
||||
do jb=1,nS
|
||||
SigC(x,y) = SigC(x,y) - 2d0*rho(x,p,jb)*rho(y,p,jb)/Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) - 2d0*rho(p,r,jb)*rho(q,r,jb)/Omega(jb)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
@ -71,12 +73,12 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! Occupied part of the correlation self-energy
|
||||
|
||||
do x=nC+1,nBas-nR
|
||||
do y=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do i=nC+1,nO
|
||||
do jb=1,nS
|
||||
eps = e(x) - e(i) + Omega(jb)
|
||||
SigC(x,y) = SigC(x,y) + 2d0*rho(x,i,jb)*rho(y,i,jb)*eps/(eps**2 + eta**2)
|
||||
eps = e(p) - e(i) + Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) + 2d0*rho(p,i,jb)*rho(q,i,jb)*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
@ -84,17 +86,29 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! Virtual part of the correlation self-energy
|
||||
|
||||
do x=nC+1,nBas-nR
|
||||
do y=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do a=nO+1,nBas-nR
|
||||
do jb=1,nS
|
||||
eps = e(x) - e(a) - Omega(jb)
|
||||
SigC(x,y) = SigC(x,y) + 2d0*rho(x,a,jb)*rho(y,a,jb)*eps/(eps**2 + eta**2)
|
||||
eps = e(p) - e(a) - Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) + 2d0*rho(p,a,jb)*rho(q,a,jb)*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! GM correlation energy
|
||||
|
||||
EcGM = 0d0
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do jb=1,nS
|
||||
eps = e(a) - e(i) + Omega(jb)
|
||||
EcGM = EcGM - 4d0*rho(a,i,jb)*rho(a,i,jb)*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine self_energy_correlation
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine self_energy_exchange(nBas,c,P,G,SigmaX)
|
||||
subroutine self_energy_exchange(nBas,c,P,ERI,SigX)
|
||||
|
||||
! Compute exchange part of the self-energy
|
||||
|
||||
@ -8,18 +8,18 @@ subroutine self_energy_exchange(nBas,c,P,G,SigmaX)
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas),G(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas),ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigmaX(nBas,nBas)
|
||||
double precision,intent(out) :: SigX(nBas,nBas)
|
||||
|
||||
! Compute exchange part of the self-energy in the AO basis
|
||||
|
||||
call exchange_matrix_AO_basis(nBas,P,G,SigmaX)
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI,SigX)
|
||||
|
||||
! Compute exchange part of the self-energy in the MO basis
|
||||
|
||||
SigmaX = matmul(transpose(c),matmul(SigmaX,c))
|
||||
SigX = matmul(transpose(c),matmul(SigX,c))
|
||||
|
||||
end subroutine self_energy_exchange
|
||||
|
||||
42
src/MBPT/self_energy_exchange_diag.f90
Normal file
42
src/MBPT/self_energy_exchange_diag.f90
Normal file
@ -0,0 +1,42 @@
|
||||
subroutine self_energy_exchange_diag(nBas,c,P,ERI,SigX)
|
||||
|
||||
! Compute the diagonal elements of the exchange part of the self-energy
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: P(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: q,mu,nu
|
||||
double precision,allocatable :: Fx(:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigX(nBas)
|
||||
|
||||
! Compute exchange part of the self-energy in the AO basis
|
||||
|
||||
allocate(Fx(nBas,nBas))
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI,Fx)
|
||||
|
||||
! Compute exchange part of the self-energy in the MO basis
|
||||
|
||||
SigX(:) = 0d0
|
||||
do q=1,nBas
|
||||
do mu=1,nBas
|
||||
do nu=1,nBas
|
||||
SigX(q) = SigX(q) + c(mu,q)*Fx(mu,nu)*c(nu,q)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
deallocate(Fx)
|
||||
|
||||
end subroutine self_energy_exchange_diag
|
||||
53
src/MBPT/static_screening_WA.f90
Normal file
53
src/MBPT/static_screening_WA.f90
Normal file
@ -0,0 +1,53 @@
|
||||
subroutine static_screening_WA(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,WA)
|
||||
|
||||
! Compute the OOVV block of the static screening W for the resonant block
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: lambda
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: Omega(nS)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision :: chi
|
||||
double precision :: eps
|
||||
integer :: i,j,a,b,ia,jb,kc
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: WA(nS,nS)
|
||||
|
||||
! Initialize
|
||||
|
||||
WA(:,:) = 0d0
|
||||
|
||||
ia = 0
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
ia = ia + 1
|
||||
jb = 0
|
||||
do j=nC+1,nO
|
||||
do b=nO+1,nBas-nR
|
||||
jb = jb + 1
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps
|
||||
enddo
|
||||
|
||||
WA(ia,jb) = WA(ia,jb) + lambda*ERI(i,b,j,a) - 4d0*lambda*chi
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine static_screening_WA
|
||||
53
src/MBPT/static_screening_WB.f90
Normal file
53
src/MBPT/static_screening_WB.f90
Normal file
@ -0,0 +1,53 @@
|
||||
subroutine static_screening_WB(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,WB)
|
||||
|
||||
! Compute the static screening W for the coupling block
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: lambda
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: Omega(nS)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision :: chi
|
||||
double precision :: eps
|
||||
integer :: i,j,a,b,ia,jb,kc
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: WB(nS,nS)
|
||||
|
||||
! Initialize
|
||||
|
||||
WB(:,:) = 0d0
|
||||
|
||||
ia = 0
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
ia = ia + 1
|
||||
jb = 0
|
||||
do j=nC+1,nO
|
||||
do b=nO+1,nBas-nR
|
||||
jb = jb + 1
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc)*rho(a,j,kc)*Omega(kc)/eps
|
||||
enddo
|
||||
|
||||
WB(ia,jb) = WB(ia,jb) + lambda*ERI(i,j,b,a) - 4d0*lambda*chi
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine static_screening_WB
|
||||
@ -112,7 +112,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,
|
||||
|
||||
if(dBSE) &
|
||||
call unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,nS_sc, &
|
||||
eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
eW,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
OmRPA,rho_RPA,OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc)
|
||||
|
||||
deallocate(OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc)
|
||||
@ -148,7 +148,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,
|
||||
|
||||
if(dBSE) &
|
||||
call unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,nS_sc, &
|
||||
eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
eW,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
OmRPA,rho_RPA,OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf)
|
||||
|
||||
deallocate(OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf)
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,nS_sc,eGW, &
|
||||
subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,nS_sc,eW,eGW, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
OmRPA,rho_RPA,OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
@ -23,6 +23,7 @@ subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,
|
||||
integer,intent(in) :: nSt
|
||||
integer,intent(in) :: nS_sc
|
||||
|
||||
double precision,intent(in) :: eW(nBas,nspin)
|
||||
double precision,intent(in) :: eGW(nBas,nspin)
|
||||
double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas)
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW)
|
||||
subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,Omega,rho,eGWlin,eGW)
|
||||
|
||||
! Compute the graphical solution of the QP equation
|
||||
|
||||
@ -15,6 +15,8 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: SigX(nBas)
|
||||
double precision,intent(in) :: Vxc(nBas)
|
||||
double precision,intent(in) :: Omega(nS)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS,nspin)
|
||||
|
||||
@ -27,7 +29,7 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG
|
||||
integer,parameter :: maxIt = 10
|
||||
double precision,parameter :: thresh = 1d-6
|
||||
double precision,external :: USigmaC,dUSigmaC
|
||||
double precision :: sig,dsig
|
||||
double precision :: sigC,dsigC
|
||||
double precision :: f,df
|
||||
double precision :: w
|
||||
|
||||
@ -52,14 +54,14 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG
|
||||
|
||||
nIt = nIt + 1
|
||||
|
||||
sig = USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
dsig = dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
f = w - eHF(p) - sig
|
||||
df = 1d0 - dsig
|
||||
sigC = USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
dsigC = dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho)
|
||||
f = w - eHF(p) - SigX(p) + Vxc(p) - sigC
|
||||
df = 1d0 - dsigC
|
||||
|
||||
w = w - f/df
|
||||
|
||||
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sig
|
||||
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sigC
|
||||
|
||||
|
||||
end do
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC)
|
||||
subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC,EcGM)
|
||||
|
||||
! Compute diagonal of the correlation part of the self-energy
|
||||
|
||||
@ -26,10 +26,12 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: SigC(nBas,nBas,nspin)
|
||||
double precision :: EcGM(nspin)
|
||||
|
||||
! Initialize
|
||||
|
||||
SigC(:,:,:) = 0d0
|
||||
EcGM(:) = 0d0
|
||||
|
||||
!--------------!
|
||||
! Spin-up part !
|
||||
@ -61,6 +63,17 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega
|
||||
end do
|
||||
end do
|
||||
|
||||
! GM correlation energy
|
||||
|
||||
do i=nC(1)+1,nO(1)
|
||||
do a=nO(1)+1,nBas-nR(1)
|
||||
do jb=1,nSt
|
||||
eps = e(a,1) - e(i,1) + Omega(jb)
|
||||
EcGM(1) = EcGM(1) - rho(a,i,jb,1)**2*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!----------------!
|
||||
! Spin-down part !
|
||||
!----------------!
|
||||
@ -91,4 +104,15 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega
|
||||
end do
|
||||
end do
|
||||
|
||||
! GM correlation energy
|
||||
|
||||
do i=nC(2)+1,nO(2)
|
||||
do a=nO(2)+1,nBas-nR(2)
|
||||
do jb=1,nSt
|
||||
eps = e(a,2) - e(i,2) + Omega(jb)
|
||||
EcGM(2) = EcGM(2) - rho(a,i,jb,2)**2*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine unrestricted_self_energy_correlation
|
||||
|
||||
@ -6,9 +6,15 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR
|
||||
double precision,intent(in) :: ENuc,EHF
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas),e(nBas)
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: EHF
|
||||
double precision,intent(in) :: e(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -17,7 +23,7 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: EcMP2(3)
|
||||
double precision,intent(out) :: EcMP2
|
||||
|
||||
! Hello world
|
||||
|
||||
@ -51,20 +57,18 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
EcMP2(2) = 2d0*E2a
|
||||
EcMP2(3) = -E2b
|
||||
EcMP2(1) = EcMP2(2) + EcMP2(3)
|
||||
EcMP2 = 2d0*E2a - E2b
|
||||
|
||||
write(*,*)
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32)') ' MP2 calculation '
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',EcMP2(1)
|
||||
write(*,'(A32,1X,F16.10)') ' Direct part = ',EcMP2(2)
|
||||
write(*,'(A32,1X,F16.10)') ' Exchange part = ',EcMP2(3)
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',EcMP2
|
||||
write(*,'(A32,1X,F16.10)') ' Direct part = ',2d0*E2a
|
||||
write(*,'(A32,1X,F16.10)') ' Exchange part = ',-E2b
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ',EHF + EcMP2(1)
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + EcMP2(1)
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ',EHF + EcMP2
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + EcMP2
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,*)
|
||||
|
||||
|
||||
@ -32,7 +32,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Ec
|
||||
double precision,intent(out) :: Ec(nsp)
|
||||
|
||||
! Hello world
|
||||
|
||||
@ -72,6 +72,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec)
|
||||
enddo
|
||||
|
||||
Ecaa = Edaa + Exaa
|
||||
Ec(1) = Ecaa
|
||||
|
||||
! aabb block
|
||||
|
||||
@ -97,6 +98,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec)
|
||||
enddo
|
||||
|
||||
Ecab = Edab + Exab
|
||||
Ec(2) = Ecab
|
||||
|
||||
! bbbb block
|
||||
|
||||
@ -124,18 +126,18 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec)
|
||||
enddo
|
||||
|
||||
Ecbb = Edbb + Exbb
|
||||
Ec(3) = Ecbb
|
||||
|
||||
! Final flush
|
||||
|
||||
Ed = Edaa + Edab + Edbb
|
||||
Ex = Exaa + Exab + Exbb
|
||||
Ec = Ed + Ex
|
||||
|
||||
write(*,*)
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32)') ' MP2 calculation '
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',Ec
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',sum(Ec(:))
|
||||
write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Ecaa
|
||||
write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Ecab
|
||||
write(*,'(A32,1X,F16.10)') ' beta-beta = ',Ecbb
|
||||
@ -150,8 +152,8 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec)
|
||||
write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Exab
|
||||
write(*,'(A32,1X,F16.10)') ' beta-beta = ',Exbb
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + Ec
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + Ec
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + sum(Ec(:))
|
||||
write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + sum(Ec(:))
|
||||
write(*,'(A32)') '--------------------------'
|
||||
write(*,*)
|
||||
|
||||
|
||||
@ -6,14 +6,15 @@ program QuAcK
|
||||
logical :: doSph
|
||||
logical :: unrestricted = .false.
|
||||
logical :: doRHF,doUHF,doMOM
|
||||
logical :: dostab
|
||||
logical :: doKS
|
||||
logical :: doMP2,doMP3,doMP2F12
|
||||
logical :: doCCD,doDCD,doCCSD,doCCSDT
|
||||
logical :: do_drCCD,do_rCCD,do_lCCD,do_pCCD
|
||||
logical :: doCIS,doCIS_D,doCID,doCISD
|
||||
logical :: doCIS,doCIS_D,doCID,doCISD,doFCI
|
||||
logical :: doRPA,doRPAx,doppRPA
|
||||
logical :: doADC
|
||||
logical :: doG0F2,doevGF2,doG0F3,doevGF3
|
||||
logical :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3
|
||||
logical :: doG0W0,doevGW,doqsGW
|
||||
logical :: doG0T0,doevGT,doqsGT
|
||||
logical :: doMCMP2,doMinMCMP2
|
||||
@ -32,6 +33,7 @@ program QuAcK
|
||||
|
||||
double precision,allocatable :: ZNuc(:),rNuc(:,:)
|
||||
double precision,allocatable :: cHF(:,:,:),eHF(:,:),PHF(:,:,:)
|
||||
double precision,allocatable :: Vxc(:,:)
|
||||
|
||||
double precision,allocatable :: eG0W0(:,:)
|
||||
double precision,allocatable :: eG0T0(:,:)
|
||||
@ -77,6 +79,7 @@ program QuAcK
|
||||
double precision :: start_QuAcK ,end_QuAcK ,t_QuAcK
|
||||
double precision :: start_int ,end_int ,t_int
|
||||
double precision :: start_HF ,end_HF ,t_HF
|
||||
double precision :: start_stab ,end_stab ,t_stab
|
||||
double precision :: start_KS ,end_KS ,t_KS
|
||||
double precision :: start_MOM ,end_MOM ,t_MOM
|
||||
double precision :: start_AOtoMO ,end_AOtoMO ,t_AOtoMO
|
||||
@ -86,6 +89,7 @@ program QuAcK
|
||||
double precision :: start_CIS ,end_CIS ,t_CIS
|
||||
double precision :: start_CID ,end_CID ,t_CID
|
||||
double precision :: start_CISD ,end_CISD ,t_CISD
|
||||
double precision :: start_FCI ,end_FCI ,t_FCI
|
||||
double precision :: start_RPA ,end_RPA ,t_RPA
|
||||
double precision :: start_RPAx ,end_RPAx ,t_RPAx
|
||||
double precision :: start_ppRPA ,end_ppRPA ,t_ppRPA
|
||||
@ -159,16 +163,17 @@ program QuAcK
|
||||
doMP2,doMP3,doMP2F12, &
|
||||
doCCD,doDCD,doCCSD,doCCSDT, &
|
||||
do_drCCD,do_rCCD,do_lCCD,do_pCCD, &
|
||||
doCIS,doCIS_D,doCID,doCISD, &
|
||||
doCIS,doCIS_D,doCID,doCISD,doFCI, &
|
||||
doRPA,doRPAx,doppRPA, &
|
||||
doG0F2,doevGF2,doG0F3,doevGF3, &
|
||||
doG0F2,doevGF2,doqsGF2, &
|
||||
doG0F3,doevGF3, &
|
||||
doG0W0,doevGW,doqsGW, &
|
||||
doG0T0,doevGT,doqsGT, &
|
||||
doMCMP2)
|
||||
|
||||
! Read options for methods
|
||||
|
||||
call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix, &
|
||||
call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, &
|
||||
maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, &
|
||||
TDA,singlet,triplet,spin_conserved,spin_flip, &
|
||||
maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, &
|
||||
@ -236,7 +241,7 @@ program QuAcK
|
||||
|
||||
allocate(cHF(nBas,nBas,nspin),eHF(nBas,nspin),eG0W0(nBas,nspin),eG0T0(nBas,nspin),PHF(nBas,nBas,nspin), &
|
||||
S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas), &
|
||||
dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart))
|
||||
dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nspin))
|
||||
|
||||
! Read integrals
|
||||
|
||||
@ -280,7 +285,7 @@ program QuAcK
|
||||
|
||||
call cpu_time(start_HF)
|
||||
call RHF(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc)
|
||||
call cpu_time(end_HF)
|
||||
|
||||
t_HF = end_HF - start_HF
|
||||
@ -300,7 +305,7 @@ program QuAcK
|
||||
|
||||
call cpu_time(start_HF)
|
||||
call UHF(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF)
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF,Vxc)
|
||||
call cpu_time(end_HF)
|
||||
|
||||
t_HF = end_HF - start_HF
|
||||
@ -315,10 +320,13 @@ program QuAcK
|
||||
|
||||
if(doKS) then
|
||||
|
||||
! Switch on the unrestricted flag
|
||||
unrestricted = .true.
|
||||
|
||||
call cpu_time(start_KS)
|
||||
call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, &
|
||||
call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, &
|
||||
nO,nV,nR,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, &
|
||||
max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO)
|
||||
max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO,EUHF,eHF,cHF,PHF,Vxc)
|
||||
|
||||
call cpu_time(end_KS)
|
||||
|
||||
@ -335,8 +343,18 @@ program QuAcK
|
||||
if(doMOM) then
|
||||
|
||||
call cpu_time(start_MOM)
|
||||
call MOM(maxSCF_HF,thresh_HF,n_diis_HF, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,X,ENuc,ERHF,cHF,eHF,PHF)
|
||||
|
||||
if(unrestricted) then
|
||||
|
||||
! call UMOM()
|
||||
|
||||
else
|
||||
|
||||
call RMOM(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc)
|
||||
|
||||
end if
|
||||
|
||||
call cpu_time(end_MOM)
|
||||
|
||||
t_MOM = end_MOM - start_MOM
|
||||
@ -435,6 +453,32 @@ program QuAcK
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,*)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Stability analysis of HF solution
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
if(dostab) then
|
||||
|
||||
call cpu_time(start_stab)
|
||||
|
||||
if(unrestricted) then
|
||||
|
||||
call UHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb)
|
||||
|
||||
else
|
||||
|
||||
call RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO)
|
||||
|
||||
end if
|
||||
|
||||
call cpu_time(end_stab)
|
||||
|
||||
t_stab = end_stab - start_stab
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for stability analysis = ',t_stab,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute MP2 energy
|
||||
!------------------------------------------------------------------------
|
||||
@ -779,8 +823,19 @@ program QuAcK
|
||||
if(doG0F2) then
|
||||
|
||||
call cpu_time(start_GF2)
|
||||
|
||||
if(unrestricted) then
|
||||
|
||||
call UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, &
|
||||
S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb,eHF)
|
||||
|
||||
else
|
||||
|
||||
call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF, &
|
||||
eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
|
||||
end if
|
||||
|
||||
call cpu_time(end_GF2)
|
||||
|
||||
t_GF2 = end_GF2 - start_GF2
|
||||
@ -796,9 +851,21 @@ program QuAcK
|
||||
if(doevGF2) then
|
||||
|
||||
call cpu_time(start_GF2)
|
||||
|
||||
if(unrestricted) then
|
||||
|
||||
call evUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, &
|
||||
eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,cHF,eHF)
|
||||
|
||||
else
|
||||
|
||||
call evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF_GF,thresh_GF,n_diis_GF, &
|
||||
singlet,triplet,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, &
|
||||
ERI_MO,dipole_int_MO,eHF)
|
||||
|
||||
end if
|
||||
|
||||
call cpu_time(end_GF2)
|
||||
|
||||
t_GF2 = end_GF2 - start_GF2
|
||||
@ -807,6 +874,35 @@ program QuAcK
|
||||
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Perform qsGF2 calculation
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
if(doqsGF2) then
|
||||
|
||||
call cpu_time(start_GF2)
|
||||
|
||||
if(unrestricted) then
|
||||
|
||||
call qsUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GF, &
|
||||
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, &
|
||||
ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF)
|
||||
|
||||
else
|
||||
|
||||
call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
end if
|
||||
|
||||
call cpu_time(end_GF2)
|
||||
|
||||
t_GF2 = end_GF2 - start_GF2
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGF2 = ',t_GF2,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute G0F3 electronic binding energies
|
||||
!------------------------------------------------------------------------
|
||||
@ -851,12 +947,12 @@ program QuAcK
|
||||
if(unrestricted) then
|
||||
|
||||
call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, &
|
||||
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eG0W0)
|
||||
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, &
|
||||
dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
else
|
||||
|
||||
call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
|
||||
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eG0W0)
|
||||
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
|
||||
end if
|
||||
|
||||
@ -879,14 +975,14 @@ program QuAcK
|
||||
|
||||
call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, &
|
||||
G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, &
|
||||
EUHF,S,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
cHF,eHF,eG0W0)
|
||||
EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb, &
|
||||
PHF,cHF,eHF,Vxc,eG0W0)
|
||||
|
||||
else
|
||||
|
||||
call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, &
|
||||
BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eG0W0)
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0)
|
||||
end if
|
||||
call cpu_time(end_evGW)
|
||||
|
||||
@ -936,9 +1032,9 @@ program QuAcK
|
||||
if(doG0T0) then
|
||||
|
||||
call cpu_time(start_G0T0)
|
||||
call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA, &
|
||||
dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eG0T0)
|
||||
call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
|
||||
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, &
|
||||
PHF,cHF,eHF,Vxc,eG0T0)
|
||||
call cpu_time(end_G0T0)
|
||||
|
||||
t_G0T0 = end_G0T0 - start_G0T0
|
||||
@ -956,7 +1052,8 @@ program QuAcK
|
||||
call cpu_time(start_evGT)
|
||||
call evGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, &
|
||||
BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eG0T0)
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, &
|
||||
PHF,cHF,eHF,Vxc,eG0T0)
|
||||
call cpu_time(end_evGT)
|
||||
|
||||
t_evGT = end_evGT - start_evGT
|
||||
@ -1005,10 +1102,10 @@ program QuAcK
|
||||
if(doMCMP2) then
|
||||
|
||||
call cpu_time(start_MCMP2)
|
||||
call MCMP2(doDrift,nBas,nC,nO,nV,cHF,eHF,EcMP2, &
|
||||
nMC,nEq,nWalk,dt,nPrint, &
|
||||
nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
|
||||
Norm,EcMCMP2,Err_EcMCMP2,Var_EcMCMP2)
|
||||
! call MCMP2(doDrift,nBas,nC,nO,nV,cHF,eHF,EcMP2, &
|
||||
! nMC,nEq,nWalk,dt,nPrint, &
|
||||
! nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
|
||||
! Norm,EcMCMP2,Err_EcMCMP2,Var_EcMCMP2)
|
||||
call cpu_time(end_MCMP2)
|
||||
|
||||
t_MCMP2 = end_MCMP2 - start_MCMP2
|
||||
@ -1040,59 +1137,59 @@ program QuAcK
|
||||
! Range-separeted GT/GW
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
if(doGTGW) then
|
||||
! if(doGTGW) then
|
||||
|
||||
! Read and transform long-range two-electron integrals
|
||||
! ! Read and transform long-range two-electron integrals
|
||||
|
||||
allocate(ERI_ERF_AO(nBas,nBas,nBas,nBas),ERI_ERF_MO(nBas,nBas,nBas,nBas))
|
||||
call read_LR(nBas,ERI_ERF_AO)
|
||||
! allocate(ERI_ERF_AO(nBas,nBas,nBas,nBas),ERI_ERF_MO(nBas,nBas,nBas,nBas))
|
||||
! call read_LR(nBas,ERI_ERF_AO)
|
||||
|
||||
call cpu_time(start_AOtoMO)
|
||||
! call cpu_time(start_AOtoMO)
|
||||
|
||||
write(*,*)
|
||||
write(*,*) 'AO to MO transformation for long-range ERIs... Please be patient'
|
||||
write(*,*)
|
||||
! write(*,*)
|
||||
! write(*,*) 'AO to MO transformation for long-range ERIs... Please be patient'
|
||||
! write(*,*)
|
||||
|
||||
call AOtoMO_integral_transform(nBas,cHF,ERI_ERF_AO,ERI_ERF_MO)
|
||||
! call AOtoMO_integral_transform(nBas,cHF,ERI_ERF_AO,ERI_ERF_MO)
|
||||
|
||||
call cpu_time(end_AOtoMO)
|
||||
! call cpu_time(end_AOtoMO)
|
||||
|
||||
deallocate(ERI_ERF_AO)
|
||||
! deallocate(ERI_ERF_AO)
|
||||
|
||||
t_AOtoMO = end_AOtoMO - start_AOtoMO
|
||||
! t_AOtoMO = end_AOtoMO - start_AOtoMO
|
||||
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,*)
|
||||
! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
! write(*,*)
|
||||
|
||||
! Long-range G0W0 calculation
|
||||
! ! Long-range G0W0 calculation
|
||||
|
||||
call cpu_time(start_G0W0)
|
||||
call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,dipole_int_MO,eHF,eG0W0)
|
||||
call cpu_time(end_G0W0)
|
||||
! call cpu_time(start_G0W0)
|
||||
! call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
|
||||
! dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, &
|
||||
! nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,dipole_int_MO,eHF,eG0W0)
|
||||
! call cpu_time(end_G0W0)
|
||||
!
|
||||
! t_G0W0 = end_G0W0 - start_G0W0
|
||||
! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0W0 = ',t_G0W0,' seconds'
|
||||
! write(*,*)
|
||||
|
||||
t_G0W0 = end_G0W0 - start_G0W0
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0W0 = ',t_G0W0,' seconds'
|
||||
write(*,*)
|
||||
! ! Short-range G0T0 calculation
|
||||
|
||||
! Short-range G0T0 calculation
|
||||
! ERI_ERF_MO(:,:,:,:) = ERI_MO(:,:,:,:) - ERI_ERF_MO(:,:,:,:)
|
||||
|
||||
ERI_ERF_MO(:,:,:,:) = ERI_MO(:,:,:,:) - ERI_ERF_MO(:,:,:,:)
|
||||
|
||||
call cpu_time(start_G0T0)
|
||||
call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, &
|
||||
singlet,triplet,linGW,eta_GW, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,dipole_int_MO,eHF,eG0T0)
|
||||
call cpu_time(end_G0T0)
|
||||
|
||||
t_G0T0 = end_G0T0 - start_G0T0
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0 = ',t_G0T0,' seconds'
|
||||
write(*,*)
|
||||
! call cpu_time(start_G0T0)
|
||||
! call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, &
|
||||
! singlet,triplet,linGW,eta_GW, &
|
||||
! nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,dipole_int_MO,eHF,eG0T0)
|
||||
! call cpu_time(end_G0T0)
|
||||
!
|
||||
! t_G0T0 = end_G0T0 - start_G0T0
|
||||
! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0 = ',t_G0T0,' seconds'
|
||||
! write(*,*)
|
||||
|
||||
! call matout(nBas,1,(eG0W0+eG0T0-eHF(:,1))*HaToeV)
|
||||
|
||||
end if
|
||||
! end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Basis set correction
|
||||
@ -1113,6 +1210,22 @@ program QuAcK
|
||||
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute FCI
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
if(doFCI) then
|
||||
|
||||
call cpu_time(start_FCI)
|
||||
call FCI(nBas,nC,nO,nV,nR,ERI_MO,eHF)
|
||||
call cpu_time(end_FCI)
|
||||
|
||||
t_FCI = end_FCI - start_FCI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for FCI = ',t_FCI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! End of QuAcK
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
@ -2,9 +2,10 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
doMP2,doMP3,doMP2F12, &
|
||||
doCCD,doDCD,doCCSD,doCCSDT, &
|
||||
do_drCCD,do_rCCD,do_lCCD,do_pCCD, &
|
||||
doCIS,doCIS_D,doCID,doCISD, &
|
||||
doCIS,doCIS_D,doCID,doCISD,doFCI, &
|
||||
doRPA,doRPAx,doppRPA, &
|
||||
doG0F2,doevGF2,doG0F3,doevGF3, &
|
||||
doG0F2,doevGF2,doqsGF2, &
|
||||
doG0F3,doevGF3, &
|
||||
doG0W0,doevGW,doqsGW, &
|
||||
doG0T0,doevGT,doqsGT, &
|
||||
doMCMP2)
|
||||
@ -19,9 +20,9 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
logical,intent(out) :: doMP2,doMP3,doMP2F12
|
||||
logical,intent(out) :: doCCD,doDCD,doCCSD,doCCSDT
|
||||
logical,intent(out) :: do_drCCD,do_rCCD,do_lCCD,do_pCCD
|
||||
logical,intent(out) :: doCIS,doCIS_D,doCID,doCISD
|
||||
logical,intent(out) :: doCIS,doCIS_D,doCID,doCISD,doFCI
|
||||
logical,intent(out) :: doRPA,doRPAx,doppRPA
|
||||
logical,intent(out) :: doG0F2,doevGF2,doG0F3,doevGF3
|
||||
logical,intent(out) :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3
|
||||
logical,intent(out) :: doG0W0,doevGW,doqsGW
|
||||
logical,intent(out) :: doG0T0,doevGT,doqsGT
|
||||
logical,intent(out) :: doMCMP2
|
||||
@ -59,6 +60,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
doCIS_D = .false.
|
||||
doCID = .false.
|
||||
doCISD = .false.
|
||||
doFCI = .false.
|
||||
|
||||
doRPA = .false.
|
||||
doRPAx = .false.
|
||||
@ -66,6 +68,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
|
||||
doG0F2 = .false.
|
||||
doevGF2 = .false.
|
||||
doqsGF2 = .false.
|
||||
doG0F3 = .false.
|
||||
doevGF3 = .false.
|
||||
|
||||
@ -116,11 +119,12 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
! Read excited state methods
|
||||
|
||||
read(1,*)
|
||||
read(1,*) answer1,answer2,answer3,answer4
|
||||
read(1,*) answer1,answer2,answer3,answer4,answer5
|
||||
if(answer1 == 'T') doCIS = .true.
|
||||
if(answer2 == 'T') doCIS_D = .true.
|
||||
if(answer3 == 'T') doCID = .true.
|
||||
if(answer4 == 'T') doCISD = .true.
|
||||
if(answer5 == 'T') doFCI = .true.
|
||||
if(doCIS_D) doCIS = .true.
|
||||
|
||||
read(1,*)
|
||||
@ -132,11 +136,12 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, &
|
||||
! Read Green function methods
|
||||
|
||||
read(1,*)
|
||||
read(1,*) answer1,answer2,answer3,answer4
|
||||
read(1,*) answer1,answer2,answer3,answer4,answer5
|
||||
if(answer1 == 'T') doG0F2 = .true.
|
||||
if(answer2 == 'T') doevGF2 = .true.
|
||||
if(answer3 == 'T') doG0F3 = .true.
|
||||
if(answer4 == 'T') doevGF3 = .true.
|
||||
if(answer3 == 'T') doqsGF2 = .true.
|
||||
if(answer4 == 'T') doG0F3 = .true.
|
||||
if(answer5 == 'T') doevGF3 = .true.
|
||||
|
||||
! Read GW methods
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix, &
|
||||
subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, &
|
||||
maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, &
|
||||
TDA,singlet,triplet,spin_conserved,spin_flip, &
|
||||
maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, &
|
||||
@ -21,6 +21,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t
|
||||
integer,intent(out) :: guess_type
|
||||
integer,intent(out) :: ortho_type
|
||||
logical,intent(out) :: mix
|
||||
logical,intent(out) :: dostab
|
||||
|
||||
integer,intent(out) :: maxSCF_CC
|
||||
double precision,intent(out) :: thresh_CC
|
||||
@ -87,12 +88,14 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t
|
||||
guess_type = 1
|
||||
ortho_type = 1
|
||||
mix = .false.
|
||||
dostab = .false.
|
||||
|
||||
read(1,*)
|
||||
read(1,*) maxSCF_HF,thresh_HF,answer1,n_diis_HF,guess_type,ortho_type,answer2
|
||||
read(1,*) maxSCF_HF,thresh_HF,answer1,n_diis_HF,guess_type,ortho_type,answer2,answer3
|
||||
|
||||
if(answer1 == 'T') DIIS_HF = .true.
|
||||
if(answer2 == 'T') mix = .true.
|
||||
if(answer3 == 'T') dostab = .true.
|
||||
|
||||
if(.not.DIIS_HF) n_diis_HF = 1
|
||||
|
||||
|
||||
@ -97,6 +97,7 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet,eta,nB
|
||||
call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,lambda,eW,ERI,OmRPA, &
|
||||
rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA)
|
||||
! call print_excitation('W^lambda: ',isp_W,nS,OmRPA)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@ subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR
|
||||
|
||||
ispin = 2
|
||||
|
||||
call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), &
|
||||
call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Omega(:,ispin),rho, &
|
||||
EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin))
|
||||
call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin))
|
||||
|
||||
@ -146,6 +146,13 @@ subroutine URPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC
|
||||
call unrestricted_ACFDT(exchange_kernel,.false.,.true.,.false.,TDA,.false.,spin_conserved,spin_flip,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,e,e,EcAC)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcAC(1) = 0.5d0*EcAC(1)
|
||||
EcAC(2) = 1.5d0*EcAC(2)
|
||||
|
||||
end if
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A50,F20.10)') 'AC@URPA correlation energy (spin-conserved) =',EcAC(1)
|
||||
|
||||
@ -122,7 +122,11 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcRPAx(1) = 0.5d0*EcRPAx(1)
|
||||
EcRPAx(2) = 1.5d0*EcRPAx(2)
|
||||
EcRPAx(2) = 0.5d0*EcRPAx(2)
|
||||
|
||||
else
|
||||
|
||||
EcRPAx(2) = 0d0
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -192,7 +192,7 @@ subroutine unrestricted_ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_cons
|
||||
|
||||
EcAC(ispin) = 0.5d0*dot_product(wAC,Ec(:,ispin))
|
||||
|
||||
if(exchange_kernel) EcAC(ispin) = 1.5d0*EcAC(ispin)
|
||||
if(exchange_kernel) EcAC(ispin) = 0.5d0*EcAC(ispin)
|
||||
|
||||
write(*,*) '-----------------------------------------------------------------------------------'
|
||||
write(*,'(2X,A50,1X,F15.6)') ' Ec(AC) via Gauss-Legendre quadrature:',EcAC(ispin)
|
||||
|
||||
@ -210,7 +210,7 @@ subroutine GOK_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nGrid,weight,aCC_w1,aCC_w
|
||||
rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns)
|
||||
end do
|
||||
|
||||
if(xc_rung > 1 .and. xc_rung /= 666) then
|
||||
if(xc_rung > 1) then
|
||||
|
||||
! Ground state density
|
||||
|
||||
|
||||
@ -16,7 +16,6 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: alpha
|
||||
double precision :: beta
|
||||
double precision :: r,g,x
|
||||
|
||||
@ -26,7 +25,6 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
|
||||
! Coefficients for B88 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 0.0042d0
|
||||
|
||||
! Compute GGA exchange energy
|
||||
@ -41,7 +39,7 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
g = 0.25d0*(drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2)
|
||||
x = sqrt(g)/r**(4d0/3d0)
|
||||
|
||||
Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) &
|
||||
Ex = Ex + weight(iG)*CxLDA*r**(4d0/3d0) &
|
||||
- weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x))
|
||||
|
||||
end if
|
||||
|
||||
@ -17,7 +17,6 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho,
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: alpha
|
||||
double precision :: beta
|
||||
double precision :: r,rI,g,x
|
||||
double precision :: ex_p,dexdr_p
|
||||
@ -28,7 +27,6 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho,
|
||||
|
||||
! Coefficients for B88 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 0.0042d0
|
||||
|
||||
! Compute GGA exchange matrix in the AO basis
|
||||
@ -45,11 +43,11 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho,
|
||||
g = 0.25d0*(drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2)
|
||||
x = sqrt(g)/r**(4d0/3d0)
|
||||
|
||||
dexdr_p = 4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) &
|
||||
dexdr_p = 4d0/3d0*r**(1d0/3d0)*(CxLDA - beta*g**(3d0/4d0)/r**2) &
|
||||
+ 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0) &
|
||||
- 2d0*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0)
|
||||
|
||||
ex_p = alpha*r**(4d0/3d0) &
|
||||
ex_p = CxLDA*r**(4d0/3d0) &
|
||||
- weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x))
|
||||
|
||||
Ex = Ex + weight(iG)*(ex_p*rI + dexdr_p*r*rI - dexdr_p*r*r)
|
||||
|
||||
@ -18,7 +18,6 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
! Local variables
|
||||
|
||||
integer :: mu,nu,iG
|
||||
double precision :: alpha
|
||||
double precision :: beta
|
||||
double precision :: r,g,vAO,gAO
|
||||
|
||||
@ -28,7 +27,6 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
|
||||
! Coefficients for B88 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 0.0042d0
|
||||
|
||||
! Compute GGA exchange matrix in the AO basis
|
||||
@ -46,7 +44,7 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
g = 0.25d0*(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) &
|
||||
+ vAO*(4d0/3d0*r**(1d0/3d0)*(CxLDA - 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)) &
|
||||
|
||||
@ -84,12 +84,16 @@ subroutine RCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr
|
||||
|
||||
dCxdw2 = (1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)) &
|
||||
* (0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0)))
|
||||
|
||||
case default
|
||||
dCxdw1 = 0.d0
|
||||
dCxdw2 = 0.d0
|
||||
|
||||
end select
|
||||
|
||||
dCxdw1 = CxLDA*dCxdw1
|
||||
dCxdw2 = CxLDA*dCxdw2
|
||||
|
||||
|
||||
dExdw(:) = 0d0
|
||||
|
||||
do iG=1,nGrid
|
||||
|
||||
@ -69,12 +69,19 @@ subroutine RCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C
|
||||
Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)
|
||||
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = CxLDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = CxLDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = CxLDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLDA
|
||||
|
||||
end select
|
||||
|
||||
! Compute GIC-LDA exchange energy
|
||||
|
||||
@ -75,12 +75,19 @@ subroutine RCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig
|
||||
Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)
|
||||
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = CxLDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = CxLDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = CxLDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLDA
|
||||
|
||||
end select
|
||||
|
||||
! Compute LDA exchange matrix in the AO basis
|
||||
|
||||
@ -74,12 +74,19 @@ subroutine RCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,
|
||||
Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)
|
||||
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = CxLDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = CxLDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = CxLDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLDA
|
||||
|
||||
end select
|
||||
|
||||
|
||||
|
||||
@ -21,6 +21,9 @@ subroutine RMFL20_lda_exchange_derivative_discontinuity(nEns,wEns,nGrid,weight,r
|
||||
double precision :: dExdw(nEns)
|
||||
double precision,external :: Kronecker_delta
|
||||
|
||||
double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ExDD(nEns)
|
||||
|
||||
@ -15,6 +15,9 @@ subroutine RMFL20_lda_exchange_energy(LDA_centered,nEns,wEns,nGrid,weight,rho,Ex
|
||||
double precision,intent(in) :: weight(nGrid)
|
||||
double precision,intent(in) :: rho(nGrid)
|
||||
|
||||
double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
|
||||
@ -22,6 +22,9 @@ subroutine RMFL20_lda_exchange_individual_energy(LDA_centered,nEns,wEns,nGrid,we
|
||||
double precision :: r,rI
|
||||
double precision :: e_p,dedr
|
||||
|
||||
double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Ex
|
||||
|
||||
@ -22,6 +22,9 @@ subroutine RMFL20_lda_exchange_potential(LDA_centered,nEns,wEns,nGrid,weight,nBa
|
||||
double precision :: Cxw
|
||||
double precision :: r,vAO
|
||||
|
||||
double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0)
|
||||
double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Fx(nBas,nBas)
|
||||
|
||||
@ -16,7 +16,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: alpha,beta
|
||||
double precision :: b
|
||||
double precision :: r,g,x
|
||||
|
||||
! Output variables
|
||||
@ -25,8 +25,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
|
||||
! Coefficients for B88 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 0.0042d0
|
||||
b = 0.0042d0
|
||||
|
||||
! Compute GGA exchange energy
|
||||
|
||||
@ -40,8 +39,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2
|
||||
x = sqrt(g)/r**(4d0/3d0)
|
||||
|
||||
Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) &
|
||||
- weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x))
|
||||
Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - b*x**2/(1d0 + 6d0*b*x*asinh(x)))
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -18,8 +18,9 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
! Local variables
|
||||
|
||||
integer :: mu,nu,iG
|
||||
double precision :: alpha,beta
|
||||
double precision :: r,g,vAO,gAO
|
||||
double precision :: b
|
||||
double precision :: vAO,gAO
|
||||
double precision :: r,g,x,dxdr,dxdg,f
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -27,8 +28,7 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
|
||||
! Coefficients for B88 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 0.0042d0
|
||||
b = 0.0042d0
|
||||
|
||||
! Compute GGA exchange matrix in the AO basis
|
||||
|
||||
@ -42,19 +42,27 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
|
||||
if(r > threshold) then
|
||||
|
||||
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))
|
||||
|
||||
g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2
|
||||
x = sqrt(g)/r**(4d0/3d0)
|
||||
dxdr = - 4d0*sqrt(g)/(3d0*r**(7d0/3d0))/x
|
||||
dxdg = + 1d0/(2d0*sqrt(g)*r**(4d0/3d0))/x
|
||||
|
||||
f = b*x**2/(1d0 + 6d0*b*x*asinh(x))
|
||||
|
||||
Fx(mu,nu) = Fx(mu,nu) + vAO*( &
|
||||
4d0/3d0*r**(1d0/3d0)*(CxLSDA - f) &
|
||||
- 2d0*r**(4d0/3d0)*dxdr*f &
|
||||
+ r**(4d0/3d0)*dxdr*(6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) )
|
||||
|
||||
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)
|
||||
Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*r**(4d0/3d0)*dxdg*( &
|
||||
- 2d0*f + (6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) )
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -22,7 +22,7 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr
|
||||
|
||||
integer :: iEns,jEns
|
||||
integer :: iG
|
||||
double precision :: r,alpha
|
||||
double precision :: r
|
||||
double precision,allocatable :: dExdw(:)
|
||||
double precision,external :: Kronecker_delta
|
||||
|
||||
@ -30,9 +30,6 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr
|
||||
double precision :: a2,b2,c2,w2
|
||||
double precision :: dCxdw1,dCxdw2
|
||||
|
||||
double precision :: nEli,nElw
|
||||
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ExDD(nEns)
|
||||
@ -60,13 +57,6 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr
|
||||
b2 = aCC_w2(2)
|
||||
c2 = aCC_w2(3)
|
||||
|
||||
nElw = electron_number(nGrid,weight,rhow)
|
||||
|
||||
|
||||
! Cx coefficient for unrestricted Slater LDA exchange
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
|
||||
w1 = wEns(2)
|
||||
w2 = wEns(3)
|
||||
|
||||
@ -86,11 +76,15 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr
|
||||
|
||||
dCxdw2 = (1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)) &
|
||||
* (0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0)))
|
||||
|
||||
case default
|
||||
dCxdw1 = 0d0
|
||||
dCxdw2 = 0d0
|
||||
|
||||
end select
|
||||
|
||||
|
||||
dCxdw1 = alpha*dCxdw1
|
||||
dCxdw2 = alpha*dCxdw2
|
||||
dCxdw1 = CxLSDA*dCxdw1
|
||||
dCxdw2 = CxLSDA*dCxdw2
|
||||
|
||||
dExdw(:) = 0d0
|
||||
|
||||
|
||||
@ -19,7 +19,7 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: r,alpha
|
||||
double precision :: r
|
||||
|
||||
double precision :: a1,b1,c1,w1
|
||||
double precision :: a2,b2,c2,w2
|
||||
@ -65,10 +65,6 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C
|
||||
b2 = aCC_w2(2)
|
||||
c2 = aCC_w2(3)
|
||||
|
||||
! Cx coefficient for unrestricted Slater LDA exchange
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
|
||||
! Fx1 for states N and N-1
|
||||
! Fx2 for states N and N+1
|
||||
|
||||
@ -79,21 +75,20 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C
|
||||
Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)
|
||||
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = alpha*Fx1
|
||||
Cx = CxLSDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = alpha*Fx2
|
||||
Cx = CxLSDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = alpha*Fx2*Fx1
|
||||
Cx = CxLSDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLSDA
|
||||
|
||||
end select
|
||||
! for two-weights ensemble
|
||||
! Cx = alpha*Fx2*Fx1
|
||||
|
||||
! for left ensemble
|
||||
! Cx = alpha*Fx1
|
||||
|
||||
! for right ensemble
|
||||
! Cx = alpha*Fx2
|
||||
|
||||
! Compute GIC-LDA exchange energy
|
||||
|
||||
|
||||
@ -22,9 +22,8 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: r,rI,alpha
|
||||
double precision :: r,rI
|
||||
double precision :: e_p,dedr
|
||||
double precision :: nEli,nElw
|
||||
|
||||
double precision :: a1,b1,c1,w1
|
||||
double precision :: a2,b2,c2,w2
|
||||
@ -51,10 +50,6 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig
|
||||
b2 = aCC_w2(2)
|
||||
c2 = aCC_w2(3)
|
||||
|
||||
! Cx coefficient for unrestricted Slater LDA exchange
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
|
||||
w1 = wEns(2)
|
||||
Fx1 = 1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)
|
||||
|
||||
@ -64,21 +59,19 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = alpha*Fx1
|
||||
Cx = CxLSDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = alpha*Fx2
|
||||
Cx = CxLSDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = alpha*Fx2*Fx1
|
||||
Cx = CxLSDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLSDA
|
||||
|
||||
end select
|
||||
|
||||
nEli = electron_number(nGrid,weight,rho)
|
||||
|
||||
nElw = electron_number(nGrid,weight,rhow)
|
||||
|
||||
|
||||
! Compute LDA exchange matrix in the AO basis
|
||||
|
||||
Ex = 0d0
|
||||
@ -92,19 +85,12 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig
|
||||
e_p = Cx*r**(1d0/3d0)
|
||||
dedr = 1d0/3d0*Cx*r**(-2d0/3d0)
|
||||
|
||||
if (doNcentered) then
|
||||
Ex = Ex - weight(iG)*dedr*r*r*(nEli/nElw)
|
||||
else
|
||||
Ex = Ex - weight(iG)*dedr*r*r
|
||||
end if
|
||||
|
||||
if(rI > threshold) then
|
||||
|
||||
if (doNcentered) then
|
||||
Ex = Ex + weight(iG)*(e_p*rI + dedr*r*rI)
|
||||
else
|
||||
Ex = Ex + weight(iG)*((nEli/nElw)*e_p*rI + dedr*r*rI)
|
||||
end if
|
||||
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
@ -21,7 +21,7 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,
|
||||
! Local variables
|
||||
|
||||
integer :: mu,nu,iG
|
||||
double precision :: r,vAO,alpha
|
||||
double precision :: r,vAO
|
||||
|
||||
double precision :: a1,b1,c1,w1
|
||||
double precision :: a2,b2,c2,w2
|
||||
@ -67,10 +67,6 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,
|
||||
b2 = aCC_w2(2)
|
||||
c2 = aCC_w2(3)
|
||||
|
||||
! Cx coefficient for unrestricted Slater LDA exchange
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
|
||||
! Fx1 for states N and N-1
|
||||
! Fx2 for states N and N+1
|
||||
|
||||
@ -81,23 +77,21 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,
|
||||
Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2)
|
||||
|
||||
select case (Cx_choice)
|
||||
|
||||
case(1)
|
||||
Cx = alpha*Fx1
|
||||
Cx = CxLSDA*Fx1
|
||||
|
||||
case(2)
|
||||
Cx = alpha*Fx2
|
||||
Cx = CxLSDA*Fx2
|
||||
|
||||
case(3)
|
||||
Cx = alpha*Fx2*Fx1
|
||||
Cx = CxLSDA*Fx2*Fx1
|
||||
|
||||
case default
|
||||
Cx = CxLSDA
|
||||
|
||||
end select
|
||||
|
||||
! for two-weight ensembles
|
||||
! Cx = alpha*Fx2*Fx1
|
||||
|
||||
! for left ensemble
|
||||
! Cx = alpha*Fx1
|
||||
|
||||
! for right ensemble
|
||||
! Cx = alpha*Fx2
|
||||
|
||||
! Compute LDA exchange matrix in the AO basis
|
||||
|
||||
Fx(:,:) = 0d0
|
||||
|
||||
@ -11,12 +11,12 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
integer,intent(in) :: nGrid
|
||||
double precision,intent(in) :: weight(nGrid)
|
||||
double precision,intent(in) :: rho(nGrid)
|
||||
double precision,intent(in) :: drho(3,nGrid)
|
||||
double precision,intent(in) :: drho(ncart,nGrid)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: iG
|
||||
double precision :: alpha,beta
|
||||
double precision :: beta
|
||||
double precision :: r,g
|
||||
|
||||
! Output variables
|
||||
@ -25,7 +25,6 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
|
||||
! Coefficients for G96 GGA exchange functional
|
||||
|
||||
alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0)
|
||||
beta = 1d0/137d0
|
||||
|
||||
! Compute GGA exchange energy
|
||||
@ -40,7 +39,7 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex)
|
||||
|
||||
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)
|
||||
Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - beta*g**(3d0/4d0)/r**2)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
! Local variables
|
||||
|
||||
integer :: mu,nu,iG
|
||||
double precision :: alpha,beta
|
||||
double precision :: beta
|
||||
double precision :: r,g,vAO,gAO
|
||||
|
||||
! Output variables
|
||||
@ -27,9 +27,7 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
|
||||
! 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
|
||||
|
||||
@ -46,7 +44,7 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx)
|
||||
|
||||
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) &
|
||||
+ vAO*(4d0/3d0*r**(1d0/3d0)*(CxLSDA - 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)) &
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user