mirror of
https://github.com/pfloos/quack
synced 2024-12-31 16:45:57 +01:00
excitation vectors for ppRPA and ppBSE
This commit is contained in:
parent
68672a74b9
commit
3acc640eee
@ -5,7 +5,7 @@
|
||||
# CC: maxSCF thresh DIIS n_diis
|
||||
64 0.00001 T 5
|
||||
# spin: TDA singlet triplet spin_conserved spin_flip
|
||||
F T T T T
|
||||
T T F T T
|
||||
# GF: maxSCF thresh DIIS n_diis lin eta renorm reg
|
||||
256 0.00001 T 5 T 0.0 3 F
|
||||
# GW: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 reg
|
||||
|
||||
@ -97,6 +97,8 @@ subroutine Bethe_Salpeter_pp(TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,E
|
||||
call print_excitation('pp-BSE (N+2)',ispin,nVV,Omega1)
|
||||
call print_excitation('pp-BSE (N-2)',ispin,nOO,Omega2)
|
||||
|
||||
call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
deallocate(Omega1,X1,Y1,Omega2,X2,Y2,WB,WC,WD)
|
||||
|
||||
end if
|
||||
@ -129,6 +131,8 @@ subroutine Bethe_Salpeter_pp(TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,E
|
||||
call print_excitation('pp-BSE (N+2)',ispin,nVV,Omega1)
|
||||
call print_excitation('pp-BSE (N-2)',ispin,nOO,Omega2)
|
||||
|
||||
call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
deallocate(Omega1,X1,Y1,Omega2,X2,Y2,WB,WC,WD)
|
||||
|
||||
end if
|
||||
|
||||
183
src/LR/print_transition_vectors_pp.f90
Normal file
183
src/LR/print_transition_vectors_pp.f90
Normal file
@ -0,0 +1,183 @@
|
||||
subroutine print_transition_vectors_pp(spin_allowed,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
! Print transition vectors for p-p linear response calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
logical,intent(in) :: spin_allowed
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nOO
|
||||
integer,intent(in) :: nVV
|
||||
double precision :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(out) :: Omega1(nVV)
|
||||
double precision,intent(out) :: X1(nVV,nVV)
|
||||
double precision,intent(out) :: Y1(nOO,nVV)
|
||||
double precision,intent(out) :: Omega2(nOO)
|
||||
double precision,intent(out) :: X2(nVV,nOO)
|
||||
double precision,intent(out) :: Y2(nOO,nOO)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: a,b,c,d,ab,cd
|
||||
integer :: i,j,k,l,ij,kl
|
||||
integer :: maxOO
|
||||
integer :: maxVV = 10
|
||||
double precision :: S2
|
||||
double precision,parameter :: thres_vec = 0.1d0
|
||||
double precision,allocatable :: osOO(:)
|
||||
double precision,allocatable :: osVV(:)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
maxOO = min(nOO,maxOO)
|
||||
maxVV = min(nVV,maxVV)
|
||||
|
||||
allocate(osOO(maxOO),osVV(maxVV))
|
||||
|
||||
! Compute oscillator strengths
|
||||
|
||||
osOO(:) = 0d0
|
||||
osVV(:) = 0d0
|
||||
|
||||
! if(spin_allowed) call oscillator_strength(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Omega,XpY,XmY,os)
|
||||
|
||||
!-----------------------------------------------!
|
||||
! Print details about excitations for pp sector !
|
||||
!-----------------------------------------------!
|
||||
|
||||
do ab=1,maxVV
|
||||
|
||||
! <S**2> values
|
||||
|
||||
if(spin_allowed) then
|
||||
S2 = 0d0
|
||||
else
|
||||
S2 = 2d0
|
||||
end if
|
||||
|
||||
print*,'-------------------------------------------------------------'
|
||||
write(*,'(A20,I3,A2,F10.6,A3,A6,F6.4,A11,F6.4)') &
|
||||
' p-p excitation n. ',ab,': ',Omega1(ab)*HaToeV,' eV',' f = ',osVV(ab),' <S**2> = ',S2
|
||||
print*,'-------------------------------------------------------------'
|
||||
|
||||
if(spin_allowed) then
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c,nBas-nR
|
||||
cd = cd + 1
|
||||
if(abs(X1(cd,ab)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') c,' -- ',d,' = ',X1(cd,ab)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k,nO
|
||||
kl = kl + 1
|
||||
if(abs(Y1(kl,ab)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') k,' -- ',l,' = ',Y1(kl,ab)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c+1,nBas-nR
|
||||
cd = cd + 1
|
||||
if(abs(X1(cd,ab)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') c,' -- ',d,' = ',X1(cd,ab)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k+1,nO
|
||||
kl = kl + 1
|
||||
if(abs(Y1(kl,ab)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') k,' -- ',l,' = ',Y1(kl,ab)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
write(*,*)
|
||||
|
||||
end do
|
||||
|
||||
! Thomas-Reiche-Kuhn sum rule
|
||||
|
||||
write(*,'(A50,F10.6)') 'Thomas-Reiche-Kuhn sum rule for p-p sector = ',sum(osVV(:))
|
||||
write(*,*)
|
||||
|
||||
!-----------------------------------------------!
|
||||
! Print details about excitations for hh sector !
|
||||
!-----------------------------------------------!
|
||||
|
||||
do ij=1,maxOO
|
||||
|
||||
! <S**2> values
|
||||
|
||||
if(spin_allowed) then
|
||||
S2 = 0d0
|
||||
else
|
||||
S2 = 2d0
|
||||
end if
|
||||
|
||||
print*,'-------------------------------------------------------------'
|
||||
write(*,'(A20,I3,A2,F10.6,A3,A6,F6.4,A11,F6.4)') &
|
||||
' h-h excitation n. ',ij,': ',Omega2(ij)*HaToeV,' eV',' f = ',osOO(ij),' <S**2> = ',S2
|
||||
print*,'-------------------------------------------------------------'
|
||||
|
||||
if(spin_allowed) then
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c,nBas-nR
|
||||
cd = cd + 1
|
||||
if(abs(X2(cd,ij)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') c,' -- ',d,' = ',X2(cd,ij)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k,nO
|
||||
kl = kl + 1
|
||||
if(abs(Y2(kl,ij)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') k,' -- ',l,' = ',Y2(kl,ij)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c+1,nBas-nR
|
||||
cd = cd + 1
|
||||
if(abs(X2(cd,ij)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') c,' -- ',d,' = ',X2(cd,ij)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k+1,nO
|
||||
kl = kl + 1
|
||||
if(abs(Y2(kl,ij)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') k,' -- ',l,' = ',Y2(kl,ij)/sqrt(2d0)
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
write(*,*)
|
||||
|
||||
end do
|
||||
|
||||
! Thomas-Reiche-Kuhn sum rule
|
||||
|
||||
write(*,'(A50,F10.6)') 'Thomas-Reiche-Kuhn sum rule for h-h sector = ',sum(osOO(:))
|
||||
write(*,*)
|
||||
|
||||
end subroutine print_transition_vectors_pp
|
||||
@ -845,7 +845,7 @@ program QuAcK
|
||||
|
||||
else
|
||||
|
||||
call ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,eHF)
|
||||
call ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,e)
|
||||
subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,dipole_int,e)
|
||||
|
||||
! Perform pp-RPA calculation
|
||||
|
||||
@ -20,19 +20,20 @@ subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,e)
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: e(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: ispin
|
||||
integer :: nS
|
||||
integer :: nOOs,nOOt
|
||||
integer :: nVVs,nVVt
|
||||
double precision,allocatable :: Omega1s(:),Omega1t(:)
|
||||
double precision,allocatable :: X1s(:,:),X1t(:,:)
|
||||
double precision,allocatable :: Y1s(:,:),Y1t(:,:)
|
||||
double precision,allocatable :: Omega2s(:),Omega2t(:)
|
||||
double precision,allocatable :: X2s(:,:),X2t(:,:)
|
||||
double precision,allocatable :: Y2s(:,:),Y2t(:,:)
|
||||
integer :: nOO
|
||||
integer :: nVV
|
||||
double precision,allocatable :: Omega1(:)
|
||||
double precision,allocatable :: X1(:,:)
|
||||
double precision,allocatable :: Y1(:,:)
|
||||
double precision,allocatable :: Omega2(:)
|
||||
double precision,allocatable :: X2(:,:)
|
||||
double precision,allocatable :: Y2(:,:)
|
||||
|
||||
double precision :: Ec_ppRPA(nspin)
|
||||
double precision :: EcAC(nspin)
|
||||
@ -54,31 +55,26 @@ subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,e)
|
||||
|
||||
nS = nO*nV
|
||||
|
||||
nOOs = nO*(nO+1)/2
|
||||
nVVs = nV*(nV+1)/2
|
||||
|
||||
nOOt = nO*(nO-1)/2
|
||||
nVVt = nV*(nV-1)/2
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(Omega1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), &
|
||||
Omega2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs))
|
||||
|
||||
allocate(Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), &
|
||||
Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt))
|
||||
|
||||
! Singlet manifold
|
||||
|
||||
if(singlet) then
|
||||
|
||||
ispin = 1
|
||||
|
||||
call linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,e,ERI, &
|
||||
Omega1s,X1s,Y1s,Omega2s,X2s,Y2s,Ec_ppRPA(ispin))
|
||||
nOO = nO*(nO+1)/2
|
||||
nVV = nV*(nV+1)/2
|
||||
|
||||
call print_excitation('pp-RPA (N+2)',ispin,nVVs,Omega1s)
|
||||
call print_excitation('pp-RPA (N-2)',ispin,nOOs,Omega2s)
|
||||
allocate(Omega1(nVV),X1(nVV,nVV),Y1(nOO,nVV),Omega2(nOO),X2(nVV,nOO),Y2(nOO,nOO))
|
||||
|
||||
call linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nOO,nVV,1d0,e,ERI, &
|
||||
Omega1,X1,Y1,Omega2,X2,Y2,Ec_ppRPA(ispin))
|
||||
|
||||
call print_excitation('pp-RPA (N+2)',ispin,nVV,Omega1)
|
||||
call print_excitation('pp-RPA (N-2)',ispin,nOO,Omega2)
|
||||
|
||||
call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
deallocate(Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
endif
|
||||
|
||||
@ -88,11 +84,20 @@ subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,e)
|
||||
|
||||
ispin = 2
|
||||
|
||||
call linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,e,ERI, &
|
||||
Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,Ec_ppRPA(ispin))
|
||||
nOO = nO*(nO-1)/2
|
||||
nVV = nV*(nV-1)/2
|
||||
|
||||
call print_excitation('pp-RPA (N+2)',ispin,nVVt,Omega1t)
|
||||
call print_excitation('pp-RPA (N-2)',ispin,nOOt,Omega2t)
|
||||
allocate(Omega1(nVV),X1(nVV,nVV),Y1(nOO,nVV),Omega2(nOO),X2(nVV,nOO),Y2(nOO,nOO))
|
||||
|
||||
call linear_response_pp(ispin,TDA,nBas,nC,nO,nV,nR,nOO,nVV,1d0,e,ERI, &
|
||||
Omega1,X1,Y1,Omega2,X2,Y2,Ec_ppRPA(ispin))
|
||||
|
||||
call print_excitation('pp-RPA (N+2)',ispin,nVV,Omega1)
|
||||
call print_excitation('pp-RPA (N-2)',ispin,nOO,Omega2)
|
||||
|
||||
call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
deallocate(Omega1,X1,Y1,Omega2,X2,Y2)
|
||||
|
||||
endif
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user