mirror of
https://github.com/pfloos/quack
synced 2024-12-23 04:43:42 +01:00
trying to fix merge conflict
This commit is contained in:
Antoine Marie
parent
1c7a98ba0e
commit
f8f857ed38
@ -1,162 +0,0 @@
|
||||
subroutine GGF2_phBSE2_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,eGF,KA_sta)
|
||||
|
||||
! Compute the resonant part of the static BSE2 matrix
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: ispin
|
||||
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) :: eGF(nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision :: dem,num
|
||||
integer :: i,j,k,l
|
||||
integer :: a,b,c,d
|
||||
integer :: ia,jb
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: KA_sta(nS,nS)
|
||||
|
||||
! Initialization
|
||||
|
||||
KA_sta(:,:) = 0d0
|
||||
|
||||
! Second-order correlation kernel for the block A of the singlet manifold
|
||||
|
||||
if(ispin == 1) then
|
||||
|
||||
jb = 0
|
||||
!$omp parallel do default(private) shared(KA_sta,ERI,num,dem,eGF,nO,nBas,eta,nC,nR)
|
||||
! do j=nC+1,nO
|
||||
! do b=nO+1,nBas-nR
|
||||
! jb = (b-nO) + (j-1)*(nBas-nO)
|
||||
!
|
||||
! ia = 0
|
||||
! do i=nC+1,nO
|
||||
! do a=nO+1,nBas-nR
|
||||
! ia = (a-nO) + (i-1)*(nBas-nO)
|
||||
!
|
||||
!
|
||||
! do k=nC+1,nO
|
||||
! do c=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - (eGF(c) - eGF(k))
|
||||
! num = 2d0*ERI(j,k,i,c)*ERI(a,c,b,k) - ERI(j,k,i,c)*ERI(a,c,k,b) &
|
||||
! - ERI(j,k,c,i)*ERI(a,c,b,k) + 2d0*ERI(j,k,c,i)*ERI(a,c,k,b)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! dem = + (eGF(c) - eGF(k))
|
||||
! num = 2d0*ERI(j,c,i,k)*ERI(a,k,b,c) - ERI(j,c,i,k)*ERI(a,k,c,b) &
|
||||
! - ERI(j,c,k,i)*ERI(a,k,b,c) + 2d0*ERI(j,c,k,i)*ERI(a,k,c,b)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) + num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - (eGF(c) + eGF(d))
|
||||
! num = 2d0*ERI(a,j,c,d)*ERI(c,d,i,b) - ERI(a,j,c,d)*ERI(c,d,b,i) &
|
||||
! - ERI(a,j,d,c)*ERI(c,d,i,b) + 2d0*ERI(a,j,d,c)*ERI(c,d,b,i)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) + 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do k=nC+1,nO
|
||||
! do l=nC+1,nO
|
||||
|
||||
! dem = - (eGF(k) + eGF(l))
|
||||
! num = 2d0*ERI(a,j,k,l)*ERI(k,l,i,b) - ERI(a,j,k,l)*ERI(k,l,b,i) &
|
||||
! - ERI(a,j,l,k)*ERI(k,l,i,b) + 2d0*ERI(a,j,l,k)*ERI(k,l,b,i)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) - 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! end do
|
||||
! end do
|
||||
!$omp end parallel do
|
||||
|
||||
! end if
|
||||
|
||||
! Second-order correlation kernel for the block A of the triplet manifold
|
||||
|
||||
! if(ispin == 2) then
|
||||
|
||||
! jb = 0
|
||||
!$omp parallel do default(private) shared(KA_sta,ERI,num,dem,eGF,nO,nBas,eta,nC,nR)
|
||||
! do j=nC+1,nO
|
||||
! do b=nO+1,nBas-nR
|
||||
! jb = (b-nO) + (j-1)*(nBas-nO)
|
||||
!
|
||||
! ia = 0
|
||||
! do i=nC+1,nO
|
||||
! do a=nO+1,nBas-nR
|
||||
! ia = (a-nO) + (i-1)*(nBas-nO)
|
||||
!
|
||||
! do k=nC+1,nO
|
||||
! do c=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - (eGF(c) - eGF(k))
|
||||
! num = 2d0*ERI(j,k,i,c)*ERI(a,c,b,k) - ERI(j,k,i,c)*ERI(a,c,k,b) - ERI(j,k,c,i)*ERI(a,c,b,k)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! dem = + (eGF(c) - eGF(k))
|
||||
! num = 2d0*ERI(j,c,i,k)*ERI(a,k,b,c) - ERI(j,c,i,k)*ERI(a,k,c,b) - ERI(j,c,k,i)*ERI(a,k,b,c)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) + num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - (eGF(c) + eGF(d))
|
||||
! num = ERI(a,j,c,d)*ERI(c,d,b,i) + ERI(a,j,d,c)*ERI(c,d,i,b)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) - 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do k=nC+1,nO
|
||||
! do l=nC+1,nO
|
||||
|
||||
! dem = - (eGF(k) + eGF(l))
|
||||
! num = ERI(a,j,k,l)*ERI(k,l,b,i) + ERI(a,j,l,k)*ERI(k,l,i,b)
|
||||
|
||||
! KA_sta(ia,jb) = KA_sta(ia,jb) + 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! end do
|
||||
! end do
|
||||
!$omp end parallel do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
end subroutine
|
||||
@ -1,161 +0,0 @@
|
||||
subroutine GGF2_phBSE2_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,eGF,KB_sta)
|
||||
|
||||
! Compute the anti-resonant part of the static BSE2 matrix
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: ispin
|
||||
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) :: eGF(nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision :: dem,num
|
||||
integer :: i,j,k,l
|
||||
integer :: a,b,c,d
|
||||
integer :: ia,jb
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: KB_sta(nS,nS)
|
||||
|
||||
! Initialization
|
||||
|
||||
KB_sta(:,:) = 0d0
|
||||
|
||||
! Second-order correlation kernel for the block A of the singlet manifold
|
||||
|
||||
if(ispin == 1) then
|
||||
|
||||
jb = 0
|
||||
!$omp parallel do default(private) shared(KB_sta,ERI,num,dem,eGF,nO,nBas,eta,nC,nR)
|
||||
! do j=nC+1,nO
|
||||
! do b=nO+1,nBas-nR
|
||||
! jb = (b-nO) + (j-1)*(nBas-nO)
|
||||
|
||||
! ia = 0
|
||||
! do i=nC+1,nO
|
||||
! do a=nO+1,nBas-nR
|
||||
! ia = (a-nO) + (i-1)*(nBas-nO)
|
||||
!
|
||||
! do k=nC+1,nO
|
||||
! do c=nO+1,nBas-nR
|
||||
!
|
||||
! dem = + eGF(k) - eGF(c)
|
||||
! num = 2d0*ERI(b,k,i,c)*ERI(a,c,j,k) - ERI(b,k,i,c)*ERI(a,c,k,j) &
|
||||
! - ERI(b,k,c,i)*ERI(a,c,j,k) + 2d0*ERI(b,k,c,i)*ERI(a,c,k,j)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! dem = - eGF(c) + eGF(k)
|
||||
! num = 2d0*ERI(b,c,i,k)*ERI(a,k,j,c) - ERI(b,c,i,k)*ERI(a,k,c,j) &
|
||||
! - ERI(b,c,k,i)*ERI(a,k,j,c) + 2d0*ERI(b,c,k,i)*ERI(a,k,c,j)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - eGF(c) - eGF(d)
|
||||
! num = 2d0*ERI(a,b,c,d)*ERI(c,d,i,j) - ERI(a,b,c,d)*ERI(c,d,j,i) &
|
||||
! - ERI(a,b,d,c)*ERI(c,d,i,j) + 2d0*ERI(a,b,d,c)*ERI(c,d,j,i)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) + 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do k=nC+1,nO
|
||||
! do l=nC+1,nO
|
||||
|
||||
! dem = + eGF(k) + eGF(l)
|
||||
! num = 2d0*ERI(a,b,k,l)*ERI(k,l,i,j) - ERI(a,b,k,l)*ERI(k,l,j,i) &
|
||||
! - ERI(a,b,l,k)*ERI(k,l,i,j) + 2d0*ERI(a,b,l,k)*ERI(k,l,j,i)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) + 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! end do
|
||||
! end do
|
||||
!$omp end parallel do
|
||||
|
||||
! end if
|
||||
|
||||
! Second-order correlation kernel for the block A of the triplet manifold
|
||||
|
||||
! if(ispin == 2) then
|
||||
|
||||
! jb = 0
|
||||
!$omp parallel do default(private) shared(KB_sta,ERI,num,dem,eGF,nO,nBas,eta,nC,nR)
|
||||
! do j=nC+1,nO
|
||||
! do b=nO+1,nBas-nR
|
||||
! jb = (b-nO) + (j-1)*(nBas-nO)
|
||||
!
|
||||
! ia = 0
|
||||
! do i=nC+1,nO
|
||||
! do a=nO+1,nBas-nR
|
||||
! ia = (a-nO) + (i-1)*(nBas-nO)
|
||||
!
|
||||
! do k=nC+1,nO
|
||||
! do c=nO+1,nBas-nR
|
||||
!
|
||||
! dem = + eGF(k) - eGF(c)
|
||||
! num = 2d0*ERI(b,k,i,c)*ERI(a,c,j,k) - ERI(b,k,i,c)*ERI(a,c,k,j) - ERI(b,k,c,i)*ERI(a,c,j,k)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! dem = - eGF(c) + eGF(k)
|
||||
! num = 2d0*ERI(b,c,i,k)*ERI(a,k,j,c) - ERI(b,c,i,k)*ERI(a,k,c,j) - ERI(b,c,k,i)*ERI(a,k,j,c)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=nO+1,nBas-nR
|
||||
!
|
||||
! dem = - eGF(c) - eGF(d)
|
||||
! num = ERI(a,b,c,d)*ERI(c,d,j,i) + ERI(a,b,d,c)*ERI(c,d,i,j)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! do k=nC+1,nO
|
||||
! do l=nC+1,nO
|
||||
|
||||
! dem = + eGF(k) + eGF(l)
|
||||
! num = ERI(a,b,k,l)*ERI(k,l,j,i) + ERI(a,b,l,k)*ERI(k,l,i,j)
|
||||
|
||||
! KB_sta(ia,jb) = KB_sta(ia,jb) - 0.5d0*num*dem/(dem**2 + eta**2)
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
|
||||
! end do
|
||||
! end do
|
||||
!$omp end parallel do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
end subroutine
|
||||
@ -242,20 +242,20 @@ subroutine ufRG0F02(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,epsHF)
|
||||
|
||||
if(epsGF2(s) < eFermi .and. epsGF2(s) > eFermi - window) then
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'------------------------------------------------------------------------'
|
||||
write(*,'(1X,A7,1X,I3,A6,I3,A1,1X,A7,F12.6,A13,F6.4,1X)') &
|
||||
'Orbital',p,' and #',s,':','e_QP = ',epsGF2(s)*HaToeV,' eV and Z = ',Z(s)
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A20,1X,A20,1X,A15,1X)') &
|
||||
' Configuration ',' Coefficient ',' Weight '
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'------------------------------------------------------------------------'
|
||||
write(*,'(1X,A20,1X,A20,1X,A15,1X,A20,1X)') &
|
||||
' Configuration ',' Coefficient ',' Weight ',' Zeroth-order '
|
||||
write(*,*)'------------------------------------------------------------------------'
|
||||
|
||||
if(p <= nO) &
|
||||
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') &
|
||||
' (',p,') ',Reigv(1,s),Reigv(1,s)**2
|
||||
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6,1X,F12.6)') &
|
||||
' (',p,') ',Reigv(1,s),Reigv(1,s)**2,-epsHF(p)*HaToeV
|
||||
if(p > nO) &
|
||||
write(*,'(1X,A16,I3,A7,1X,F15.6,1X,F15.6)') &
|
||||
' (',p,') ',Reigv(1,s),Reigv(1,s)**2
|
||||
' (',p,') ',Reigv(1,s),Reigv(1,s)**2,-epsHF(p)*HaToeV
|
||||
|
||||
ija = 0
|
||||
do i=nC+1,nO
|
||||
@ -264,8 +264,8 @@ subroutine ufRG0F02(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,epsHF)
|
||||
ija = ija + 1
|
||||
|
||||
if(abs(Reigv(1+ija,s)) > cutoff2) &
|
||||
write(*,'(1X,A3,I3,A1,I3,A6,I3,A7,1X,F15.6,1X,F15.6)') &
|
||||
' (',i,',',j,') -> (',a,') ',Reigv(1+ija,s),Reigv(1+ija,s)**2
|
||||
write(*,'(1X,A3,I3,A1,I3,A6,I3,A7,1X,F15.6,1X,F15.6,1X,F12.6)') &
|
||||
' (',i,',',j,') -> (',a,') ',Reigv(1+ija,s),Reigv(1+ija,s)**2, (epsHF(a) - epsHF(i) - epsHF(j))*HaToeV
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -278,14 +278,14 @@ subroutine ufRG0F02(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,epsHF)
|
||||
iab = iab + 1
|
||||
|
||||
if(abs(Reigv(1+n2h1p+iab,s)) > cutoff2) &
|
||||
write(*,'(1X,A7,I3,A6,I3,A1,I3,A3,1X,F15.6,1X,F15.6)') &
|
||||
' (',i,') -> (',a,',',b,') ',Reigv(1+n2h1p+iab,s),Reigv(1+n2h1p+iab,s)**2
|
||||
write(*,'(1X,A7,I3,A6,I3,A1,I3,A3,1X,F15.6,1X,F15.6,1X,F12.6)') &
|
||||
' (',i,') -> (',a,',',b,') ',Reigv(1+n2h1p+iab,s),Reigv(1+n2h1p+iab,s)**2, (epsHF(a) + epsHF(b) - epsHF(i))*HaToeV
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)'------------------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
end if ! If state s should be print
|
||||
|
||||
@ -58,7 +58,7 @@ subroutine ufG0T0pp(dotest,TDA_T,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
double precision,parameter :: cutoff1 = 0.01d0
|
||||
double precision,parameter :: cutoff2 = 0.01d0
|
||||
double precision :: eF
|
||||
double precision,parameter :: window = 2d0
|
||||
double precision,parameter :: window = 1.5d0
|
||||
|
||||
double precision :: start_timing,end_timing,timing
|
||||
|
||||
@ -469,8 +469,8 @@ subroutine ufG0T0pp(dotest,TDA_T,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
write(*,*)'-------------------------------------------'
|
||||
|
||||
do s=1,nH
|
||||
if(eGT(s) < eF .and. eGT(s) > eF - window) then
|
||||
! if(Z(s) > cutoff1) then
|
||||
if(eGT(s) < eF .and. eGT(s) > eF - window) then
|
||||
!if(Z(s) > cutoff1) then
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',s,'|',eGT(s)*HaToeV,'|',Z(s),'|'
|
||||
end if
|
||||
@ -546,7 +546,7 @@ subroutine ufG0T0pp(dotest,TDA_T,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
do s=1,nH
|
||||
|
||||
if(eGT(s) < eF .and. eGT(s) > eF - window) then
|
||||
! if(Z(s) > cutoff2) then
|
||||
!if(Z(s) > cutoff2) then
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,'(1X,A7,1X,I3,A6,I3,A1,1X,A7,F12.6,A13,F6.4,1X)') &
|
||||
|
||||
@ -50,7 +50,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
double precision,parameter :: cutoff1 = 0.01d0
|
||||
double precision,parameter :: cutoff2 = 0.01d0
|
||||
double precision :: eF
|
||||
double precision,parameter :: window = 2d0
|
||||
double precision,parameter :: window = 1.5d0
|
||||
|
||||
double precision :: start_timing,end_timing,timing
|
||||
|
||||
@ -116,7 +116,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
! Main loop over orbitals !
|
||||
!-------------------------!
|
||||
|
||||
do p=nO-1,nO
|
||||
do p=nO-3,nO
|
||||
|
||||
H(:,:) = 0d0
|
||||
|
||||
|
||||
@ -50,7 +50,7 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
|
||||
double precision,parameter :: cutoff1 = 0.01d0
|
||||
double precision,parameter :: cutoff2 = 0.01d0
|
||||
double precision :: eF
|
||||
double precision,parameter :: window = 2d0
|
||||
double precision,parameter :: window = 1.5d0
|
||||
|
||||
double precision :: start_timing,end_timing,timing
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user