diff --git a/src/GF/GGF2_phBSE2_static_kernel_A.f90 b/src/GF/GGF2_phBSE2_static_kernel_A.f90 deleted file mode 100644 index 9079f94..0000000 --- a/src/GF/GGF2_phBSE2_static_kernel_A.f90 +++ /dev/null @@ -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 diff --git a/src/GF/GGF2_phBSE2_static_kernel_B.f90 b/src/GF/GGF2_phBSE2_static_kernel_B.f90 deleted file mode 100644 index c789898..0000000 --- a/src/GF/GGF2_phBSE2_static_kernel_B.f90 +++ /dev/null @@ -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 diff --git a/src/GF/ufRG0F02.f90 b/src/GF/ufRG0F02.f90 index c3b503b..de8ceec 100644 --- a/src/GF/ufRG0F02.f90 +++ b/src/GF/ufRG0F02.f90 @@ -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 diff --git a/src/GT/ufG0T0pp.f90 b/src/GT/ufG0T0pp.f90 index df1c63f..1303a34 100644 --- a/src/GT/ufG0T0pp.f90 +++ b/src/GT/ufG0T0pp.f90 @@ -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)') & diff --git a/src/GW/ufG0W0.f90 b/src/GW/ufG0W0.f90 index 17119cc..2df8ca4 100644 --- a/src/GW/ufG0W0.f90 +++ b/src/GW/ufG0W0.f90 @@ -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 diff --git a/src/GW/ufGW.f90 b/src/GW/ufGW.f90 index 759f0fd..b4a9690 100644 --- a/src/GW/ufGW.f90 +++ b/src/GW/ufGW.f90 @@ -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