mirror of https://github.com/pfloos/quack
200 lines
7.5 KiB
Fortran
200 lines
7.5 KiB
Fortran
subroutine Bethe_Salpeter_Tmatrix_pp(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOaa,nVVaa, &
|
|
Om1ab,X1ab,Y1ab,Om2ab,X2ab,Y2ab,rho1ab,rho2ab,Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,rho1aa,rho2aa, &
|
|
ERI,dipole_int,eT,eGT,EcBSE)
|
|
|
|
! Compute the Bethe-Salpeter excitation energies with the T-matrix kernel
|
|
|
|
implicit none
|
|
include 'parameters.h'
|
|
|
|
! Input variables
|
|
|
|
logical,intent(in) :: TDA_T
|
|
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) :: nBas
|
|
integer,intent(in) :: nC
|
|
integer,intent(in) :: nO
|
|
integer,intent(in) :: nV
|
|
integer,intent(in) :: nR
|
|
|
|
integer,intent(in) :: nOOab
|
|
integer,intent(in) :: nOOaa
|
|
integer,intent(in) :: nVVab
|
|
integer,intent(in) :: nVVaa
|
|
|
|
double precision,intent(in) :: eT(nBas)
|
|
double precision,intent(in) :: eGT(nBas)
|
|
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
|
|
|
double precision,intent(in) :: Om1ab(nVVab)
|
|
double precision,intent(in) :: X1ab(nVVab,nVVab)
|
|
double precision,intent(in) :: Y1ab(nOOab,nVVab)
|
|
double precision,intent(in) :: Om2ab(nOOab)
|
|
double precision,intent(in) :: X2ab(nVVab,nOOab)
|
|
double precision,intent(in) :: Y2ab(nOOab,nOOab)
|
|
double precision,intent(in) :: rho1ab(nBas,nBas,nVVab)
|
|
double precision,intent(in) :: rho2ab(nBas,nBas,nOOab)
|
|
double precision,intent(in) :: Om1aa(nVVaa)
|
|
double precision,intent(in) :: X1aa(nVVaa,nVVaa)
|
|
double precision,intent(in) :: Y1aa(nOOaa,nVVaa)
|
|
double precision,intent(in) :: Om2aa(nOOaa)
|
|
double precision,intent(in) :: X2aa(nVVaa,nOOaa)
|
|
double precision,intent(in) :: Y2aa(nOOaa,nOOaa)
|
|
double precision,intent(in) :: rho1aa(nBas,nBas,nVVaa)
|
|
double precision,intent(in) :: rho2aa(nBas,nBas,nOOaa)
|
|
|
|
! Local variables
|
|
|
|
integer :: ispin
|
|
integer :: iblock
|
|
|
|
integer :: nOOs
|
|
integer :: nOOt
|
|
integer :: nVVs
|
|
integer :: nVVt
|
|
|
|
double precision :: EcRPA(nspin)
|
|
double precision,allocatable :: TBab(:,:),TCab(:,:),TDab(:,:)
|
|
double precision,allocatable :: TBaa(:,:),TCaa(:,:),TDaa(:,:)
|
|
|
|
double precision,allocatable :: Om1s(:),Om1t(:)
|
|
double precision,allocatable :: X1s(:,:),X1t(:,:)
|
|
double precision,allocatable :: Y1s(:,:),Y1t(:,:)
|
|
double precision,allocatable :: Om2s(:),Om2t(:)
|
|
double precision,allocatable :: X2s(:,:),X2t(:,:)
|
|
double precision,allocatable :: Y2s(:,:),Y2t(:,:)
|
|
|
|
! Output variables
|
|
|
|
double precision,intent(out) :: EcBSE(nspin)
|
|
|
|
|
|
!------------------!
|
|
! Singlet manifold !
|
|
!------------------!
|
|
|
|
if(singlet) then
|
|
|
|
ispin = 1
|
|
|
|
nOOs = nO*(nO+1)/2
|
|
nVVs = nV*(nV+1)/2
|
|
|
|
!---------------------------------------!
|
|
! Compute T-matrix for alpha-beta block !
|
|
!---------------------------------------!
|
|
|
|
iblock = 3
|
|
|
|
EcRPA(ispin) = 0d0
|
|
|
|
call linear_response_pp(iblock,TDA_T,nBas,nC,nO,nV,nR,nOOab,nVVab,1d0,eT,ERI,Om1ab,X1ab,Y1ab,Om2ab,X2ab,Y2ab,EcRPA(ispin))
|
|
|
|
allocate(TBab(nVVs,nOOs),TCab(nVVs,nVVs),TDab(nOOs,nOOs))
|
|
|
|
if(.not.TDA) call static_Tmatrix_B_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOs,nVVs,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TBab)
|
|
call static_Tmatrix_C_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOs,nVVs,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TCab)
|
|
call static_Tmatrix_D_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOs,nVVs,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TDab)
|
|
|
|
!----------------------------------------!
|
|
! Compute T-matrix for alpha-alpha block !
|
|
!----------------------------------------!
|
|
|
|
iblock = 4
|
|
EcRPA(ispin) = 0d0
|
|
|
|
call linear_response_pp(iblock,TDA_T,nBas,nC,nO,nV,nR,nOOaa,nVVaa,1d0,eT,ERI,Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,EcRPA(ispin))
|
|
|
|
allocate(TBaa(nVVs,nOOs),TCaa(nVVs,nVVs),TDaa(nOOs,nOOs))
|
|
|
|
if(.not.TDA) call static_Tmatrix_B_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOs,nVVs,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TBaa)
|
|
call static_Tmatrix_C_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOs,nVVs,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TCaa)
|
|
call static_Tmatrix_D_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOs,nVVs,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TDaa)
|
|
|
|
!----------------------------------!
|
|
! pp/hh sectors for singlet states !
|
|
!----------------------------------!
|
|
|
|
EcBSE(ispin) = 0d0
|
|
|
|
allocate(Om1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs),Om2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs))
|
|
|
|
call linear_response_pp_BSE(ispin,TDA,.true.,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,eGT,ERI, &
|
|
TBaa+TBab,TCaa+TCab,TDaa+TDab,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcBSE(ispin))
|
|
|
|
call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOOs,nVVs,dipole_int,Om1s,X1s,Y1s,Om2s,X2s,Y2s)
|
|
|
|
deallocate(Om1s,X1s,Y1s,Om2s,X2s,Y2s,TBab,TCab,TDab,TBaa,TCaa,TDaa)
|
|
|
|
end if
|
|
|
|
!------------------!
|
|
! Triplet manifold !
|
|
!------------------!
|
|
|
|
if(triplet) then
|
|
|
|
ispin = 2
|
|
|
|
nOOt = nO*(nO-1)/2
|
|
nVVt = nV*(nV-1)/2
|
|
|
|
!---------------------------------------!
|
|
! Compute T-matrix for alpha-beta block !
|
|
!---------------------------------------!
|
|
|
|
iblock = 3
|
|
EcRPA(ispin) = 0d0
|
|
|
|
call linear_response_pp(iblock,TDA_T,nBas,nC,nO,nV,nR,nOOab,nVVab,1d0,eT,ERI,Om1ab,X1ab,Y1ab,Om2ab,X2ab,Y2ab,EcRPA(ispin))
|
|
|
|
allocate(TBab(nVVt,nOOt),TCab(nVVt,nVVt),TDab(nOOt,nOOt))
|
|
|
|
if(.not.TDA) call static_Tmatrix_B_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOt,nVVt,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TBab)
|
|
call static_Tmatrix_C_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOt,nVVt,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TCab)
|
|
call static_Tmatrix_D_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOab,nVVab,nOOt,nVVt,1d0,Om1ab,rho1ab,Om2ab,rho2ab,TDab)
|
|
|
|
!----------------------------------------!
|
|
! Compute T-matrix for alpha-alpha block !
|
|
!----------------------------------------!
|
|
|
|
ispin = 2
|
|
iblock = 4
|
|
|
|
EcRPA(ispin) = 0d0
|
|
|
|
call linear_response_pp(iblock,TDA_T,nBas,nC,nO,nV,nR,nOOaa,nVVaa,1d0,eT,ERI,Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,EcRPA(ispin))
|
|
|
|
allocate(TBaa(nVVt,nOOt),TCaa(nVVt,nVVt),TDaa(nOOt,nOOt))
|
|
|
|
if(.not.TDA) call static_Tmatrix_B_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOt,nVVt,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TBaa)
|
|
call static_Tmatrix_C_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOt,nVVt,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TCaa)
|
|
call static_Tmatrix_D_pp(ispin,eta,nBas,nC,nO,nV,nR,nOOaa,nVVaa,nOOt,nVVt,1d0,Om1aa,rho1aa,Om2aa,rho2aa,TDaa)
|
|
|
|
!----------------------------------!
|
|
! pp/hh sectors for triplet states !
|
|
!----------------------------------!
|
|
|
|
EcBSE(ispin) = 0d0
|
|
|
|
allocate(Om1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt),Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt))
|
|
|
|
call linear_response_pp_BSE(ispin,TDA,.true.,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,eGT,ERI, &
|
|
TBaa-TBab,TCaa-TCab,TDaa-TDab,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcBSE(ispin))
|
|
|
|
call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,dipole_int,Om1t,X1t,Y1t,Om2t,X2t,Y2t)
|
|
|
|
deallocate(Om1t,X1t,Y1t,Om2t,X2t,Y2t,TBab,TCab,TDab,TBaa,TCaa,TDaa)
|
|
|
|
end if
|
|
|
|
end subroutine Bethe_Salpeter_Tmatrix_pp
|