mirror of
https://github.com/pfloos/quack
synced 2024-12-22 04:14:26 +01:00
Merge branch 'master' of github.com:pfloos/QuAcK
This commit is contained in:
Antoine Marie
commit
7c972806a0
@ -1,4 +1,4 @@
|
||||
2
|
||||
|
||||
H 0.00000000 0.0 0.0
|
||||
H 0.00000000 0.0 0.74031892
|
||||
H 0.00000000 0.0 1.235
|
||||
|
||||
@ -162,7 +162,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,maxSCF,thresh,max_dii
|
||||
! Perform CC-based G0W0 calculation
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
doccG0W0 = .true.
|
||||
doccG0W0 = .false.
|
||||
|
||||
if(doccG0W0) then
|
||||
|
||||
|
||||
@ -65,9 +65,7 @@ subroutine RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triple
|
||||
Aph(nS,nS),Bph(nS,nS),KA_sta(nS,nS),KB_sta(nS,nS), &
|
||||
OmBSE(nS),XpY_BSE(nS,nS),XmY_BSE(nS,nS))
|
||||
|
||||
!-----!
|
||||
! TDA !
|
||||
!-----!
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated in phBSE!'
|
||||
|
||||
@ -46,9 +46,9 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
|
||||
! Local variables
|
||||
|
||||
logical :: print_W = .true.
|
||||
logical :: dRPA
|
||||
logical :: dRPA_W
|
||||
integer :: is
|
||||
integer :: ispin
|
||||
integer :: isp_W
|
||||
double precision :: flow
|
||||
double precision :: EcRPA
|
||||
double precision :: EcGM(nspin)
|
||||
@ -78,7 +78,7 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
|
||||
! Initialization
|
||||
|
||||
EcRPA = 0d0
|
||||
dRPA = .true.
|
||||
dRPA_W = .true.
|
||||
|
||||
! TDA for W
|
||||
|
||||
@ -113,10 +113,10 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
|
||||
|
||||
! Spin-conserving transitions
|
||||
|
||||
ispin = 1
|
||||
isp_W = 1
|
||||
|
||||
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA_W) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nSa,nSb,nSt,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
@ -172,8 +172,8 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
|
||||
|
||||
! Compute RPA correlation energy
|
||||
|
||||
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA_W) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nSa,nSb,nSt,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
@ -205,7 +205,7 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
|
||||
|
||||
if(doACFDT) then
|
||||
|
||||
call UGW_phACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,dophBSE,spin_conserved,spin_flip,eta, &
|
||||
call UGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,spin_conserved,spin_flip,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGW,EcBSE)
|
||||
|
||||
write(*,*)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,spin_flip,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eW,e,EcAC)
|
||||
subroutine UGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,spin_conserved,spin_flip,eta, &
|
||||
nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eW,eGW,EcAC)
|
||||
|
||||
! Compute the correlation energy via the adiabatic connection fluctuation dissipation theorem
|
||||
|
||||
@ -10,10 +10,8 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
! Input variables
|
||||
|
||||
logical,intent(in) :: doXBS
|
||||
logical,intent(in) :: dRPA
|
||||
logical,intent(in) :: TDA_W
|
||||
logical,intent(in) :: TDA
|
||||
logical,intent(in) :: BSE
|
||||
logical,intent(in) :: exchange_kernel
|
||||
logical,intent(in) :: spin_conserved
|
||||
logical,intent(in) :: spin_flip
|
||||
@ -26,19 +24,27 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
integer,intent(in) :: nR(nspin)
|
||||
integer,intent(in) :: nS(nspin)
|
||||
double precision,intent(in) :: eW(nBas,nspin)
|
||||
double precision,intent(in) :: e(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)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
logical :: dRPA = .false.
|
||||
logical :: dRPA_W = .true.
|
||||
|
||||
integer :: ispin
|
||||
integer :: isp_W
|
||||
integer :: iAC
|
||||
double precision :: lambda
|
||||
double precision,allocatable :: Ec(:,:)
|
||||
|
||||
double precision,allocatable :: Aph(:,:)
|
||||
double precision,allocatable :: Bph(:,:)
|
||||
double precision,allocatable :: KA(:,:)
|
||||
double precision,allocatable :: KB(:,:)
|
||||
|
||||
double precision :: EcRPA
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
double precision,allocatable :: XpY_RPA(:,:)
|
||||
@ -46,14 +52,10 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
double precision,allocatable :: rho_RPA(:,:,:,:)
|
||||
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision,allocatable :: Om_sc(:)
|
||||
double precision,allocatable :: XpY_sc(:,:)
|
||||
double precision,allocatable :: XmY_sc(:,:)
|
||||
|
||||
integer :: nS_ab,nS_ba,nS_sf
|
||||
double precision,allocatable :: Om_sf(:)
|
||||
double precision,allocatable :: XpY_sf(:,:)
|
||||
double precision,allocatable :: XmY_sf(:,:)
|
||||
double precision,allocatable :: Om(:)
|
||||
double precision,allocatable :: XpY(:,:)
|
||||
double precision,allocatable :: XmY(:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -63,7 +65,6 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
|
||||
allocate(Ec(nAC,nspin))
|
||||
|
||||
|
||||
! Hello World
|
||||
|
||||
write(*,*) '-----------------------------------------------------------'
|
||||
@ -109,18 +110,24 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
nS_sf = nS_ab + nS_ba
|
||||
|
||||
allocate(OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin))
|
||||
allocate(Aph(nS_sc,nS_sc),Bph(nS_sc,nS_sc),KA(nS_sc,nS_sc),KB(nS_sc,nS_sc))
|
||||
|
||||
call phULR(isp_W,.true.,TDA_W,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,eW, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sc,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call UGW_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA)
|
||||
|
||||
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KA)
|
||||
call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KB)
|
||||
|
||||
! Spin-conserved manifold
|
||||
|
||||
if(spin_conserved) then
|
||||
|
||||
ispin = 1
|
||||
|
||||
allocate(Om_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc))
|
||||
allocate(Om(nS_sc),XpY(nS_sc,nS_sc),XmY(nS_sc,nS_sc))
|
||||
|
||||
write(*,*) '------------------------'
|
||||
write(*,*) 'Spin-conserved manifold '
|
||||
@ -137,17 +144,27 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
|
||||
if(doXBS) then
|
||||
|
||||
call phULR(isp_W,.true.,TDA_W,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,eW, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sc,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call UGW_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA)
|
||||
|
||||
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,OmRPA,rho_RPA,KA)
|
||||
call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,OmRPA,rho_RPA,KB)
|
||||
|
||||
end if
|
||||
|
||||
call phULR(ispin,dRPA,TDA,BSE,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,e, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcAC(ispin),Om_sc,XpY_sc,XmY_sc)
|
||||
call phULR_A(isp_W,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(isp_W,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
Aph(:,:) = Aph(:,:) + KA(:,:)
|
||||
if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sc,Aph,Bph,EcAC(ispin),OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
call phUACFDT_correlation_energy(ispin,exchange_kernel,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_sc,XmY_sc,Ec(iAC,ispin))
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,XpY,XmY,Ec(iAC,ispin))
|
||||
|
||||
write(*,'(2X,F15.6,1X,F30.15,1X,F30.15)') lambda,EcAC(ispin),Ec(iAC,ispin)
|
||||
|
||||
@ -162,7 +179,7 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
write(*,*) '-----------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
deallocate(Om_sc,XpY_sc,XmY_sc)
|
||||
deallocate(Om,XpY,XmY)
|
||||
|
||||
end if
|
||||
|
||||
@ -174,7 +191,7 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(Om_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf))
|
||||
allocate(Om(nS_sf),XpY(nS_sf,nS_sf),XmY(nS_sf,nS_sf))
|
||||
|
||||
write(*,*) '--------------------'
|
||||
write(*,*) ' Spin-flip manifold '
|
||||
@ -191,17 +208,27 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
|
||||
if(doXBS) then
|
||||
|
||||
call phULR(isp_W,.true.,TDA_W,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,eW, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sc,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call UGW_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA)
|
||||
|
||||
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,OmRPA,rho_RPA,KA)
|
||||
call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,OmRPA,rho_RPA,KB)
|
||||
|
||||
end if
|
||||
|
||||
call phULR(ispin,dRPA,TDA,BSE,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sc,lambda,e, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcAC(ispin),Om_sf,XpY_sf,XmY_sf)
|
||||
call phULR_A(isp_W,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,lambda,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(isp_W,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
Aph(:,:) = Aph(:,:) + KA(:,:)
|
||||
if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sf,Aph,Bph,EcAC(ispin),OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
call phUACFDT_correlation_energy(ispin,exchange_kernel,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_sf,XmY_sf,Ec(iAC,ispin))
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,XpY,XmY,Ec(iAC,ispin))
|
||||
|
||||
write(*,'(2X,F15.6,1X,F30.15,1X,F30.15)') lambda,EcAC(ispin),Ec(iAC,ispin)
|
||||
|
||||
@ -216,7 +243,7 @@ subroutine UGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_conserved,s
|
||||
write(*,*) '-----------------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
deallocate(Om_sf,XpY_sf,XmY_sf)
|
||||
deallocate(Om,XpY,XmY)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -37,22 +37,25 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
|
||||
integer :: ispin
|
||||
integer :: isp_W
|
||||
logical :: dRPA = .false.
|
||||
logical :: dRPA_W = .true.
|
||||
|
||||
double precision,allocatable :: Aph(:,:)
|
||||
double precision,allocatable :: Bph(:,:)
|
||||
double precision,allocatable :: KA(:,:)
|
||||
double precision,allocatable :: KB(:,:)
|
||||
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
double precision :: EcRPA
|
||||
double precision,allocatable :: OmRPA(:)
|
||||
double precision,allocatable :: XpY_RPA(:,:)
|
||||
double precision,allocatable :: XmY_RPA(:,:)
|
||||
double precision,allocatable :: rho_RPA(:,:,:,:)
|
||||
|
||||
double precision,allocatable :: OmBSE_sc(:)
|
||||
double precision,allocatable :: XpY_BSE_sc(:,:)
|
||||
double precision,allocatable :: XmY_BSE_sc(:,:)
|
||||
|
||||
integer :: nS_aa,nS_bb,nS_sc
|
||||
integer :: nS_ab,nS_ba,nS_sf
|
||||
double precision,allocatable :: OmBSE_sf(:)
|
||||
double precision,allocatable :: XpY_BSE_sf(:,:)
|
||||
double precision,allocatable :: XmY_BSE_sf(:,:)
|
||||
double precision,allocatable :: OmBSE(:)
|
||||
double precision,allocatable :: XpY_BSE(:,:)
|
||||
double precision,allocatable :: XmY_BSE(:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -68,31 +71,35 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1))
|
||||
nS_sf = nS_ab + nS_ba
|
||||
|
||||
allocate(OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin))
|
||||
|
||||
!-----!
|
||||
! TDA !
|
||||
!-----!
|
||||
! TDA
|
||||
|
||||
if(TDA) then
|
||||
write(*,*) 'Tamm-Dancoff approximation activated in phBSE!'
|
||||
write(*,*)
|
||||
end if
|
||||
|
||||
! Initialization
|
||||
|
||||
EcBSE(:) = 0d0
|
||||
|
||||
!--------------------------!
|
||||
! Spin-conserved screening !
|
||||
!--------------------------!
|
||||
|
||||
isp_W = 1
|
||||
EcRPA = 0d0
|
||||
|
||||
! Compute spin-conserved RPA screening
|
||||
|
||||
call phULR(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, &
|
||||
eW,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
allocate(Aph(nS_sc,nS_sc),Bph(nS_sc,nS_sc))
|
||||
allocate(OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin))
|
||||
|
||||
call phULR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,eW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA_W) call phULR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(TDA_W,nS_aa,nS_bb,nS_sc,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
call UGW_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA)
|
||||
|
||||
|
||||
deallocate(Aph,Bph)
|
||||
|
||||
!----------------------------!
|
||||
! Spin-conserved excitations !
|
||||
@ -101,17 +108,26 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
if(spin_conserved) then
|
||||
|
||||
ispin = 1
|
||||
EcBSE(ispin) = 0d0
|
||||
|
||||
allocate(OmBSE_sc(nS_sc),XpY_BSE_sc(nS_sc,nS_sc),XmY_BSE_sc(nS_sc,nS_sc))
|
||||
allocate(Aph(nS_sc,nS_sc),Bph(nS_sc,nS_sc),KA(nS_sc,nS_sc),KB(nS_sc,nS_sc))
|
||||
allocate(OmBSE(nS_sc),XpY_BSE(nS_sc,nS_sc),XmY_BSE(nS_sc,nS_sc))
|
||||
|
||||
! Compute spin-conserved BSE excitation energies
|
||||
|
||||
call phULR(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, &
|
||||
eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcBSE(ispin),OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc)
|
||||
call print_excitation_energies('phBSE@GW@UHF','spin-conserved',nS_sc,OmBSE_sc)
|
||||
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KA)
|
||||
if(.not.TDA) call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KB)
|
||||
|
||||
Aph(:,:) = Aph(:,:) + KA(:,:)
|
||||
! if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
|
||||
|
||||
call phULR(TDA,nS_aa,nS_bb,nS_sc,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
call print_excitation_energies('phBSE@GW@UHF','spin-conserved',nS_sc,OmBSE)
|
||||
call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, &
|
||||
cW,S,OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc)
|
||||
cW,S,OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
!-------------------------------------------------
|
||||
! Compute the dynamical screening at the BSE level
|
||||
@ -120,9 +136,10 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
if(dBSE) &
|
||||
call UGW_phBSE_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,nS_sc, &
|
||||
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)
|
||||
OmRPA,rho_RPA,OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
deallocate(OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc)
|
||||
deallocate(Aph,Bph,KA,KB)
|
||||
deallocate(OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
end if
|
||||
|
||||
@ -133,21 +150,25 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
if(spin_flip) then
|
||||
|
||||
ispin = 2
|
||||
EcBSE(ispin) = 0d0
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(OmBSE_sf(nS_sf),XpY_BSE_sf(nS_sf,nS_sf),XmY_BSE_sf(nS_sf,nS_sf))
|
||||
allocate(Aph(nS_sf,nS_sf),Bph(nS_sf,nS_sf),KA(nS_sf,nS_sf),KB(nS_sf,nS_sf))
|
||||
allocate(OmBSE(nS_sf),XpY_BSE(nS_sf,nS_sf),XmY_BSE(nS_sf,nS_sf))
|
||||
|
||||
! Compute spin-flip BSE excitation energies
|
||||
! Compute spin-conserved BSE excitation energies
|
||||
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
|
||||
if(.not.TDA) call phULR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
|
||||
|
||||
call phULR(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sc,1d0, &
|
||||
eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcBSE(ispin), &
|
||||
OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf)
|
||||
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sf,1d0,OmRPA,rho_RPA,KA)
|
||||
if(.not.TDA) call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sf,1d0,OmRPA,rho_RPA,KB)
|
||||
|
||||
call print_excitation_energies('phBSE@GW@UHF','spin-flip',nS_sf,OmBSE_sf)
|
||||
Aph(:,:) = Aph(:,:) + KA(:,:)
|
||||
if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
|
||||
|
||||
call phULR(TDA,nS_aa,nS_bb,nS_sc,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
call print_excitation_energies('phBSE@GW@UHF','spin-flip',nS_sf,OmBSE)
|
||||
call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, &
|
||||
cW,S,OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf)
|
||||
cW,S,OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
!-------------------------------------------------
|
||||
! Compute the dynamical screening at the BSE level
|
||||
@ -156,19 +177,18 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
|
||||
if(dBSE) &
|
||||
call UGW_phBSE_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,nS_sc, &
|
||||
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)
|
||||
OmRPA,rho_RPA,OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
deallocate(OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf)
|
||||
deallocate(Aph,Bph,KA,KB)
|
||||
deallocate(OmBSE,XpY_BSE,XmY_BSE)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
! Scale properly correlation energy if exchange is included in interaction kernel
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
EcBSE(1) = 0.5d0*EcBSE(1)
|
||||
EcBSE(2) = 0.5d0*EcBSE(2)
|
||||
EcBSE(:) = 0.5d0*EcBSE(:)
|
||||
|
||||
else
|
||||
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda,eGW, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,A_lr)
|
||||
subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda,Om,rho,KA)
|
||||
|
||||
! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism
|
||||
|
||||
@ -20,11 +19,7 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
integer,intent(in) :: nS_sc
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: lambda
|
||||
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)
|
||||
double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: Omega(nS_sc)
|
||||
double precision,intent(in) :: Om(nS_sc)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS_sc,nspin)
|
||||
|
||||
! Local variables
|
||||
@ -35,7 +30,7 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: A_lr(nSt,nSt)
|
||||
double precision,intent(out) :: KA(nSt,nSt)
|
||||
|
||||
!--------------------------------------------------!
|
||||
! Build BSE matrix for spin-conserving transitions !
|
||||
@ -56,11 +51,11 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 2d0*lambda*chi
|
||||
KA(ia,jb) = KA(ia,jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -80,11 +75,11 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 2d0*lambda*chi
|
||||
KA(nSa+ia,nSa+jb) = KA(nSa+ia,nSa+jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -112,11 +107,11 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,1)*rho(a,b,kc,2)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,1)*rho(a,b,kc,2)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aabb(i,b,j,a) + 2d0*lambda*chi
|
||||
KA(ia,jb) = KA(ia,jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -136,11 +131,11 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,2)*rho(a,b,kc,1)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,j,kc,2)*rho(a,b,kc,1)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_aabb(b,i,a,j) + 2d0*lambda*chi
|
||||
KA(nSa+ia,nSa+jb) = KA(nSa+ia,nSa+jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, &
|
||||
ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,B_lr)
|
||||
subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda,Om,rho,KB)
|
||||
|
||||
! Compute the extra term for Bethe-Salpeter equation for linear response
|
||||
|
||||
@ -20,10 +19,7 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
integer,intent(in) :: nS_sc
|
||||
double precision,intent(in) :: eta
|
||||
double precision,intent(in) :: lambda
|
||||
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) :: Omega(nS_sc)
|
||||
double precision,intent(in) :: Om(nS_sc)
|
||||
double precision,intent(in) :: rho(nBas,nBas,nS_sc,nspin)
|
||||
|
||||
! Local variables
|
||||
@ -34,7 +30,7 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: B_lr(nSt,nSt)
|
||||
double precision,intent(out) :: KB(nSt,nSt)
|
||||
|
||||
!--------------------------------------------------!
|
||||
! Build BSE matrix for spin-conserving transitions !
|
||||
@ -55,11 +51,11 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 2d0*lambda*chi
|
||||
KB(ia,jb) = KB(ia,jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -80,11 +76,11 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 2d0*lambda*chi
|
||||
KB(nSa+ia,nSa+jb) = KB(nSa+ia,nSa+jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -113,11 +109,11 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,1)*rho(a,j,kc,2)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,1)*rho(a,j,kc,2)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_aabb(i,j,b,a) + 2d0*lambda*chi
|
||||
KB(ia,nSa+jb) = KB(ia,nSa+jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -137,11 +133,11 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
|
||||
|
||||
chi = 0d0
|
||||
do kc=1,nS_sc
|
||||
eps = Omega(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,2)*rho(a,j,kc,1)*Omega(kc)/eps
|
||||
eps = Om(kc)**2 + eta**2
|
||||
chi = chi + rho(i,b,kc,2)*rho(a,j,kc,1)*Om(kc)/eps
|
||||
end do
|
||||
|
||||
B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_aabb(j,i,a,b) + 2d0*lambda*chi
|
||||
KB(nSa+ia,jb) = KB(nSa+ia,jb) + 2d0*lambda*chi
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -34,12 +34,6 @@ subroutine phULR(TDA,nSa,nSb,nSt,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
allocate(ApB(nSt,nSt),AmB(nSt,nSt),AmBSq(nSt,nSt),AmBIv(nSt,nSt),Z(nSt,nSt))
|
||||
|
||||
! Build A and B matrices
|
||||
|
||||
! if(BSE) &
|
||||
! call UGW_phBSE_static_kernel_A(ispin,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda,e, &
|
||||
! ERI_aaaa,ERI_aabb,ERI_bbbb,Om,rho,Aph)
|
||||
|
||||
! Tamm-Dancoff approximation
|
||||
|
||||
if(TDA) then
|
||||
@ -51,10 +45,6 @@ subroutine phULR(TDA,nSa,nSb,nSt,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
else
|
||||
|
||||
! if(BSE) &
|
||||
! call UGW_phBSE_static_kernel_B(ispin,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, &
|
||||
! ERI_aaaa,ERI_aabb,ERI_bbbb,Om,rho,Bph)
|
||||
|
||||
ApB(:,:) = Aph(:,:) + Bph(:,:)
|
||||
AmB(:,:) = Aph(:,:) - Bph(:,:)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole_int_aa,dipole_int_bb,c,S,Omega,XpY,XmY)
|
||||
subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole_int_aa,dipole_int_bb,c,S,Om,XpY,XmY)
|
||||
|
||||
! Print transition vectors for linear response calculation
|
||||
|
||||
@ -21,14 +21,14 @@ subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole
|
||||
double precision :: dipole_int_bb(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: c(nBas,nBas,nspin)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: Omega(nSt)
|
||||
double precision,intent(in) :: Om(nSt)
|
||||
double precision,intent(in) :: XpY(nSt,nSt)
|
||||
double precision,intent(in) :: XmY(nSt,nSt)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: ia,jb,j,b
|
||||
integer :: maxS = 20
|
||||
integer :: maxS = 10
|
||||
double precision,parameter :: thres_vec = 0.1d0
|
||||
double precision,allocatable :: X(:)
|
||||
double precision,allocatable :: Y(:)
|
||||
@ -44,11 +44,11 @@ subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole
|
||||
|
||||
os(:) = 0d0
|
||||
if(ispin == 1) call phULR_oscillator_strength(nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS, &
|
||||
dipole_int_aa,dipole_int_bb,Omega,XpY,XmY,os)
|
||||
dipole_int_aa,dipole_int_bb,Om,XpY,XmY,os)
|
||||
|
||||
! Compute <S**2>
|
||||
|
||||
call S2_expval(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS,c,S,Omega,XpY,XmY,S2)
|
||||
call S2_expval(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS,c,S,Om,XpY,XmY,S2)
|
||||
|
||||
! Print details about spin-conserved excitations
|
||||
|
||||
@ -61,7 +61,7 @@ subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole
|
||||
|
||||
print*,'-------------------------------------------------------------'
|
||||
write(*,'(A15,I3,A2,F10.6,A3,A6,F6.4,A11,F6.4)') &
|
||||
' Excitation n. ',ia,': ',Omega(ia)*HaToeV,' eV',' f = ',os(ia),' <S**2> = ',S2(ia)
|
||||
' Excitation n. ',ia,': ',Om(ia)*HaToeV,' eV',' f = ',os(ia),' <S**2> = ',S2(ia)
|
||||
print*,'-------------------------------------------------------------'
|
||||
|
||||
! Spin-up transitions
|
||||
@ -117,7 +117,7 @@ subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole
|
||||
|
||||
print*,'-------------------------------------------------------------'
|
||||
write(*,'(A15,I3,A2,F10.6,A3,A6,F6.4,A11,F6.4)') &
|
||||
' Excitation n. ',ia,': ',Omega(ia)*HaToeV,' eV',' f = ',os(ia),' <S**2> = ',S2(ia)
|
||||
' Excitation n. ',ia,': ',Om(ia)*HaToeV,' eV',' f = ',os(ia),' <S**2> = ',S2(ia)
|
||||
print*,'-------------------------------------------------------------'
|
||||
|
||||
! Spin-up transitions
|
||||
|
||||
@ -14,7 +14,7 @@ subroutine print_excitation_energies(method,manifold,nS,Om)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer,parameter :: maxS = 20
|
||||
integer,parameter :: maxS = 10
|
||||
integer :: m
|
||||
|
||||
write(*,*)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user