10
1
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 2023-12-14 21:44:17 +01:00
parent 1c7a98ba0e
commit f8f857ed38
6 changed files with 20 additions and 343 deletions

View File

@ -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

View File

@ -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

View File

@ -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 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)') & 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) 'Orbital',p,' and #',s,':','e_QP = ',epsGF2(s)*HaToeV,' eV and Z = ',Z(s)
write(*,*)'-------------------------------------------------------------' write(*,*)'------------------------------------------------------------------------'
write(*,'(1X,A20,1X,A20,1X,A15,1X)') & write(*,'(1X,A20,1X,A20,1X,A15,1X,A20,1X)') &
' Configuration ',' Coefficient ',' Weight ' ' Configuration ',' Coefficient ',' Weight ',' Zeroth-order '
write(*,*)'-------------------------------------------------------------' write(*,*)'------------------------------------------------------------------------'
if(p <= nO) & if(p <= nO) &
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6,1X,F12.6)') &
' (',p,') ',Reigv(1,s),Reigv(1,s)**2 ' (',p,') ',Reigv(1,s),Reigv(1,s)**2,-epsHF(p)*HaToeV
if(p > nO) & if(p > nO) &
write(*,'(1X,A16,I3,A7,1X,F15.6,1X,F15.6)') & 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 ija = 0
do i=nC+1,nO 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 ija = ija + 1
if(abs(Reigv(1+ija,s)) > cutoff2) & if(abs(Reigv(1+ija,s)) > cutoff2) &
write(*,'(1X,A3,I3,A1,I3,A6,I3,A7,1X,F15.6,1X,F15.6)') & 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 ' (',i,',',j,') -> (',a,') ',Reigv(1+ija,s),Reigv(1+ija,s)**2, (epsHF(a) - epsHF(i) - epsHF(j))*HaToeV
end do end do
end do end do
@ -278,14 +278,14 @@ subroutine ufRG0F02(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,epsHF)
iab = iab + 1 iab = iab + 1
if(abs(Reigv(1+n2h1p+iab,s)) > cutoff2) & if(abs(Reigv(1+n2h1p+iab,s)) > cutoff2) &
write(*,'(1X,A7,I3,A6,I3,A1,I3,A3,1X,F15.6,1X,F15.6)') & 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 ' (',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 end do
end do end do
write(*,*)'-------------------------------------------------------------' write(*,*)'------------------------------------------------------------------------'
write(*,*) write(*,*)
end if ! If state s should be print end if ! If state s should be print

View File

@ -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 :: cutoff1 = 0.01d0
double precision,parameter :: cutoff2 = 0.01d0 double precision,parameter :: cutoff2 = 0.01d0
double precision :: eF double precision :: eF
double precision,parameter :: window = 2d0 double precision,parameter :: window = 1.5d0
double precision :: start_timing,end_timing,timing double precision :: start_timing,end_timing,timing

View File

@ -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 :: cutoff1 = 0.01d0
double precision,parameter :: cutoff2 = 0.01d0 double precision,parameter :: cutoff2 = 0.01d0
double precision :: eF double precision :: eF
double precision,parameter :: window = 2d0 double precision,parameter :: window = 1.5d0
double precision :: start_timing,end_timing,timing 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 ! ! Main loop over orbitals !
!-------------------------! !-------------------------!
do p=nO-1,nO do p=nO-3,nO
H(:,:) = 0d0 H(:,:) = 0d0

View File

@ -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 :: cutoff1 = 0.01d0
double precision,parameter :: cutoff2 = 0.01d0 double precision,parameter :: cutoff2 = 0.01d0
double precision :: eF double precision :: eF
double precision,parameter :: window = 2d0 double precision,parameter :: window = 1.5d0
double precision :: start_timing,end_timing,timing double precision :: start_timing,end_timing,timing