From 0fa90ab2a9972ce71d1c86fd66d864619a5b9c66 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 16 Oct 2021 15:34:34 +0200 Subject: [PATCH] OK for BSE@GT --- input/options | 4 +- src/MBPT/Bethe_Salpeter_Tmatrix.f90 | 62 ++++++++-------- src/MBPT/G0T0.f90 | 38 ++++------ src/MBPT/evGT.f90 | 4 +- src/MBPT/excitation_density_Tmatrix.f90 | 78 ++++++++++----------- src/MBPT/print_G0T0.f90 | 27 ++++--- src/MBPT/renormalization_factor_Tmatrix.f90 | 10 +-- src/MBPT/self_energy_Tmatrix_diag.f90 | 6 +- src/MBPT/static_Tmatrix_TA.f90 | 6 +- src/MBPT/static_Tmatrix_TB.f90 | 4 +- 10 files changed, 106 insertions(+), 133 deletions(-) diff --git a/input/options b/input/options index 60007a7..ab6f0e6 100644 --- a/input/options +++ b/input/options @@ -1,11 +1,11 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 F 5 1 1 F F + 1024 0.0000001 F 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis 64 0.0000000001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - T T T T T + F T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm 256 0.00001 T 5 T 0.0 3 # GW/GT: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 diff --git a/src/MBPT/Bethe_Salpeter_Tmatrix.f90 b/src/MBPT/Bethe_Salpeter_Tmatrix.f90 index 5435c6f..fe5a859 100644 --- a/src/MBPT/Bethe_Salpeter_Tmatrix.f90 +++ b/src/MBPT/Bethe_Salpeter_Tmatrix.f90 @@ -1,4 +1,6 @@ -subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eT,eGT,EcBSE) +subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt, & + Omega1s,X1s,Y1s,Omega2s,X2s,Y2s,rho1s,rho2s,Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,rho1t,rho2t, & + ERI,dipole_int,eT,eGT,EcBSE) ! Compute the Bethe-Salpeter excitation energies with the T-matrix kernel @@ -23,32 +25,41 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, integer,intent(in) :: nR integer,intent(in) :: nS + integer,intent(in) :: nOOs + integer,intent(in) :: nOOt + integer,intent(in) :: nVVs + integer,intent(in) :: nVVt + 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) :: Omega1s(nVVs) + double precision,intent(in) :: X1s(nVVs,nVVs) + double precision,intent(in) :: Y1s(nOOs,nVVs) + double precision,intent(in) :: Omega2s(nOOs) + double precision,intent(in) :: X2s(nVVs,nOOs) + double precision,intent(in) :: Y2s(nOOs,nOOs) + double precision,intent(in) :: rho1s(nBas,nBas,nVVs) + double precision,intent(in) :: rho2s(nBas,nBas,nOOs) + double precision,intent(in) :: Omega1t(nVVt) + double precision,intent(in) :: X1t(nVVt,nVVt) + double precision,intent(in) :: Y1t(nOOt,nVVt) + double precision,intent(in) :: Omega2t(nOOt) + double precision,intent(in) :: X2t(nVVt,nOOt) + double precision,intent(in) :: Y2t(nOOt,nOOt) + double precision,intent(in) :: rho1t(nBas,nBas,nVVt) + double precision,intent(in) :: rho2t(nBas,nBas,nOOt) + ! Local variables - integer :: nOOs - integer :: nOOt - integer :: nVVs - integer :: nVVt integer :: ispin integer :: iblock integer :: dERI integer :: xERI double precision :: EcRPA(nspin) - double precision,allocatable :: Omega1s(:),Omega1t(:) - double precision,allocatable :: X1s(:,:),X1t(:,:) - double precision,allocatable :: Y1s(:,:),Y1t(:,:) - double precision,allocatable :: rho1s(:,:,:),rho1t(:,:,:) - double precision,allocatable :: Omega2s(:),Omega2t(:) - double precision,allocatable :: X2s(:,:),X2t(:,:) - double precision,allocatable :: Y2s(:,:),Y2t(:,:) - double precision,allocatable :: rho2s(:,:,:),rho2t(:,:,:) - double precision,allocatable :: TA(:,:),TB(:,:) double precision,allocatable :: OmBSE(:,:) double precision,allocatable :: XpY_BSE(:,:,:) @@ -58,23 +69,8 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, double precision,intent(out) :: EcBSE(nspin) -! Dimensions of the pp-RPA linear reponse matrices - - nOOs = nO*nO - nVVs = nV*nV - - 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), & - rho1s(nBas,nO,nVVs),rho2s(nBas,nV,nOOs), & - Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & - Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & - rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt)) - allocate(TA(nS,nS),TB(nS,nS),OmBSE(nS,nspin),XpY_BSE(nS,nS,nspin),XmY_BSE(nS,nS,nspin)) ! Initialize T matrix @@ -94,8 +90,8 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eT,ERI, & Omega1s,X1s,Y1s,Omega2s,X2s,Y2s,EcRPA(ispin)) - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI, & - X1s,Y1s,rho1s,X2s,Y2s,rho2s) +! call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI, & +! X1s,Y1s,rho1s,X2s,Y2s,rho2s) call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TA) if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,1d0,ERI,Omega1s,rho1s,Omega2s,rho2s,TB) @@ -112,8 +108,8 @@ subroutine Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eT,ERI, & Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,EcRPA(ispin)) - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI, & - X1t,Y1t,rho1t,X2t,Y2t,rho2t) +! call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI, & +! X1t,Y1t,rho1t,X2t,Y2t,rho2t) call static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TA) if(.not.TDA) call static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOOt,nVVt,1d0,ERI,Omega1t,rho1t,Omega2t,rho2t,TB) diff --git a/src/MBPT/G0T0.f90 b/src/MBPT/G0T0.f90 index c082884..cea99bc 100644 --- a/src/MBPT/G0T0.f90 +++ b/src/MBPT/G0T0.f90 @@ -91,10 +91,10 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing allocate(Omega1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), & Omega2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), & - rho1s(nBas,nO,nVVs),rho2s(nBas,nV,nOOs), & + rho1s(nBas,nBas,nVVs),rho2s(nBas,nBas,nOOs), & Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & - rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), & + rho1t(nBas,nBas,nVVt),rho2t(nBas,nBas,nOOt), & SigX(nBas),SigT(nBas),Z(nBas)) !---------------------------------------------- @@ -194,8 +194,6 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing ! Dump results !---------------------------------------------- - call print_G0T0(nBas,nO,eHF(:),ENuc,ERHF,SigT(:),Z(:),eG0T0(:),EcRPA(:)) - ! Compute the ppRPA correlation energy ispin = 1 @@ -209,21 +207,15 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing EcRPA(1) = EcRPA(1) - EcRPA(2) EcRPA(2) = 3d0*EcRPA(2) - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0T0 correlation energy (singlet) =',EcRPA(1) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0T0 correlation energy (triplet) =',EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0T0 correlation energy =',EcRPA(1) + EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0T0 total energy =',ENuc + ERHF + EcRPA(1) + EcRPA(2) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) + call print_G0T0(nBas,nO,eHF(:),ENuc,ERHF,SigT(:),Z(:),eG0T0(:),EcRPA(:)) ! Perform BSE calculation if(BSE) then - call Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0T0,EcBSE) + call Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt, & + Omega1s,X1s,Y1s,Omega2s,X2s,Y2s,rho1s,rho2s,Omega1t,X1t,Y1t,Omega2t,X2t,Y2t,rho1t,rho2t, & + ERI_MO,dipole_int,eHF,eG0T0,EcBSE) if(exchange_kernel) then @@ -234,10 +226,10 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing write(*,*) write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 correlation energy (singlet) =',EcBSE(1) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 correlation energy (triplet) =',EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 correlation energy =',EcBSE(1) + EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2) + write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 correlation energy (singlet) =',EcBSE(1),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 correlation energy (triplet) =',EcBSE(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 correlation energy =',EcBSE(1) + EcBSE(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2),' au' write(*,*)'-------------------------------------------------------------------------------' write(*,*) @@ -269,17 +261,15 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,evDyn,sing write(*,*) write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 correlation energy (singlet) =',EcAC(1) - write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 correlation energy (triplet) =',EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 correlation energy =',EcAC(1) + EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) + write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 correlation energy (singlet) =',EcAC(1),' au' + write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 correlation energy (triplet) =',EcAC(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 correlation energy =',EcAC(1) + EcAC(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2),' au' write(*,*)'-------------------------------------------------------------------------------' write(*,*) end if - - allocate(Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin),rho(nBas,nBas,nS,nspin)) end if end subroutine G0T0 diff --git a/src/MBPT/evGT.f90 b/src/MBPT/evGT.f90 index 814db63..1a3a94d 100644 --- a/src/MBPT/evGT.f90 +++ b/src/MBPT/evGT.f90 @@ -103,10 +103,10 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & allocate(Omega1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), & Omega2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), & - rho1s(nBas,nO,nVVs),rho2s(nBas,nV,nOOs), & + rho1s(nBas,nBas,nVVs),rho2s(nBas,nBas,nOOs), & Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & - rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), & + rho1t(nBas,nBas,nVVt),rho2t(nBas,nBas,nOOt), & eGT(nBas),eOld(nBas),Z(nBas),SigX(nBas),SigT(nBas), & error_diis(nBas,max_diis),e_diis(nBas,max_diis)) diff --git a/src/MBPT/excitation_density_Tmatrix.f90 b/src/MBPT/excitation_density_Tmatrix.f90 index ffc8c4e..9079e10 100644 --- a/src/MBPT/excitation_density_Tmatrix.f90 +++ b/src/MBPT/excitation_density_Tmatrix.f90 @@ -24,16 +24,16 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E ! Local variables - integer :: i,j,k,l - integer :: a,b,c,d - integer :: p + integer :: k,l + integer :: c,d + integer :: p,q integer :: ab,cd,ij,kl double precision,external :: Kronecker_delta ! Output variables - double precision,intent(out) :: rho1(nBas,nO,nVV) - double precision,intent(out) :: rho2(nBas,nV,nOO) + double precision,intent(out) :: rho1(nBas,nBas,nVV) + double precision,intent(out) :: rho2(nBas,nBas,nOO) ! Initialization @@ -47,16 +47,16 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E if(ispin == 1) then do p=nC+1,nBas-nR - - do i=nC+1,nO + do q=nC+1,nBas-nR + do ab=1,nVV cd = 0 do c=nO+1,nBas-nR do d=c,nBas-nR cd = cd + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X1(cd,ab) end do end do @@ -64,23 +64,21 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=k,nO kl = kl + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y1(kl,ab) end do end do end do - end do - do a=1,nV-nR do ij=1,nOO cd = 0 do c=nO+1,nBas-nR do d=c,nBas-nR cd = cd + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij) end do end do @@ -88,14 +86,14 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=k,nO kl = kl + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y2(kl,ij) end do end do end do + end do - end do end if @@ -107,16 +105,16 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E if(ispin == 2 .or. ispin == 4) then do p=nC+1,nBas-nR + do q=nC+1,nBas-nR - do i=nC+1,nO do ab=1,nVV cd = 0 do c=nO+1,nBas-nR do d=c+1,nBas-nR cd = cd + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X1(cd,ab) end do end do @@ -124,23 +122,21 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=k+1,nO kl = kl + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y1(kl,ab) end do end do end do - end do - do a=1,nV-nR do ij=1,nOO cd = 0 do c=nO+1,nBas-nR do d=c+1,nBas-nR cd = cd + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij) end do end do @@ -148,14 +144,14 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=k+1,nO kl = kl + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y2(kl,ij) end do end do end do + end do - end do end if @@ -167,16 +163,16 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E if(ispin == 3) then do p=nC+1,nBas-nR + do q=nC+1,nBas-nR - do i=nC+1,nO do ab=1,nVV cd = 0 do c=nO+1,nBas-nR do d=nO+1,nBas-nR cd = cd + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X1(cd,ab) end do end do @@ -184,23 +180,21 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=nC+1,nO kl = kl + 1 - rho1(p,i,ab) = rho1(p,i,ab) & - + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,ab) + rho1(p,q,ab) = rho1(p,q,ab) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y1(kl,ab) end do end do end do - end do - do a=1,nV-nR do ij=1,nOO cd = 0 do c=nO+1,nBas-nR do d=nO+1,nBas-nR cd = cd + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij) end do end do @@ -208,14 +202,14 @@ subroutine excitation_density_Tmatrix(ispin,dERI,xERI,nBas,nC,nO,nV,nR,nOO,nVV,E do k=nC+1,nO do l=nC+1,nO kl = kl + 1 - rho2(p,a,ij) = rho2(p,a,ij) & - + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,ij) + rho2(p,q,ij) = rho2(p,q,ij) & + + (dERI*ERI(p,q,k,l) + xERI*ERI(p,q,l,k))*Y2(kl,ij) end do end do end do + end do - end do end if diff --git a/src/MBPT/print_G0T0.f90 b/src/MBPT/print_G0T0.f90 index ff33862..2150cd4 100644 --- a/src/MBPT/print_G0T0.f90 +++ b/src/MBPT/print_G0T0.f90 @@ -1,4 +1,4 @@ -subroutine print_G0T0(nBas,nO,e,ENuc,ERHF,SigT,Z,eGW,EcRPA) +subroutine print_G0T0(nBas,nO,eHF,ENuc,ERHF,SigT,Z,eGT,EcRPA) ! Print one-electron energies and other stuff for G0T0 @@ -9,10 +9,10 @@ subroutine print_G0T0(nBas,nO,e,ENuc,ERHF,SigT,Z,eGW,EcRPA) double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF double precision,intent(in) :: EcRPA(nspin) - double precision,intent(in) :: e(nBas) + double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: SigT(nBas) double precision,intent(in) :: Z(nBas) - double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: eGT(nBas) integer :: p,HOMO,LUMO double precision :: Gap @@ -23,7 +23,7 @@ subroutine print_G0T0(nBas,nO,e,ENuc,ERHF,SigT,Z,eGW,EcRPA) LUMO = HOMO + 1 if(nBas >= LUMO) then - Gap = eGW(LUMO) - eGW(HOMO) + Gap = eGT(LUMO) - eGT(HOMO) else @@ -31,7 +31,6 @@ subroutine print_G0T0(nBas,nO,e,ENuc,ERHF,SigT,Z,eGW,EcRPA) end if - ! Dump results write(*,*)'-------------------------------------------------------------------------------' @@ -43,19 +42,19 @@ subroutine print_G0T0(nBas,nO,e,ENuc,ERHF,SigT,Z,eGW,EcRPA) do p=1,nBas write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') & - '|',p,'|',e(p)*HaToeV,'|',SigT(p)*HaToeV,'|',Z(p),'|',eGW(p)*HaToeV,'|' + '|',p,'|',eHF(p)*HaToeV,'|',SigT(p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|' enddo write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A40,F15.6)') 'G0T0 HOMO energy (eV) :',eGW(HOMO)*HaToeV - write(*,'(2X,A40,F15.6)') 'G0T0 LUMO energy (eV) :',eGW(LUMO)*HaToeV - write(*,'(2X,A40,F15.6)') 'G0T0 HOMO-LUMO gap (eV) :',Gap*HaToeV + write(*,'(2X,A50,F15.6,A3)') 'G0T0 HOMO energy (eV) =',eGT(HOMO)*HaToeV,' eV' + write(*,'(2X,A50,F15.6,A3)') 'G0T0 LUMO energy (eV) =',eGT(LUMO)*HaToeV,' eV' + write(*,'(2X,A50,F15.6,A3)') 'G0T0 HOMO-LUMO gap (eV) =',Gap*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A50,F20.10,A3)') 'Tr@RPA@G0T0 correlation energy (singlet) =',EcRPA(1),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@RPA@G0T0 correlation energy (triplet) =',EcRPA(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@RPA@G0T0 correlation energy =',EcRPA(1) + EcRPA(2),' au' + write(*,'(2X,A50,F20.10,A3)') 'Tr@RPA@G0T0 total energy =',ENuc + ERHF + EcRPA(1) + EcRPA(2),' au' write(*,*)'-------------------------------------------------------------------------------' -! write(*,'(2X,A40,F15.6)') 'RPA@G0T0 correlation energy (singlet) =',EcRPA(1) -! write(*,'(2X,A40,F15.6)') 'RPA@G0T0 correlation energy (triplet) =',EcRPA(2) -! write(*,'(2X,A40,F15.6)') 'RPA@G0T0 correlation energy =',EcRPA(1) + EcRPA(2) -! write(*,'(2X,A40,F15.6)') 'RPA@G0T0 total energy =',ENuc + ERHF + EcRPA(1) + EcRPA(2) -! write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine print_G0T0 diff --git a/src/MBPT/renormalization_factor_Tmatrix.f90 b/src/MBPT/renormalization_factor_Tmatrix.f90 index b09bce8..c4f2a5b 100644 --- a/src/MBPT/renormalization_factor_Tmatrix.f90 +++ b/src/MBPT/renormalization_factor_Tmatrix.f90 @@ -14,9 +14,9 @@ subroutine renormalization_factor_Tmatrix(alpha,eta,nBas,nC,nO,nV,nR,nOO,nVV,e,O integer,intent(in) :: nVV double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega1(nVV) - double precision,intent(in) :: rho1(nBas,nO,nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) double precision,intent(in) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) ! Local variables @@ -44,13 +44,9 @@ subroutine renormalization_factor_Tmatrix(alpha,eta,nBas,nC,nO,nV,nR,nOO,nVV,e,O do a=1,nV-nR do kl=1,nOO eps = e(p) + e(nO+a) - Omega2(kl) - Z(p) = Z(p) - (rho2(p,a,kl)/eps)**2 + Z(p) = Z(p) - (rho2(p,nO+a,kl)/eps)**2 enddo enddo enddo -! Compute renormalization factor from derivative of SigT - -! Z(:) = 1d0/(1d0 + Z(:)) - end subroutine renormalization_factor_Tmatrix diff --git a/src/MBPT/self_energy_Tmatrix_diag.f90 b/src/MBPT/self_energy_Tmatrix_diag.f90 index ae68d74..bf79950 100644 --- a/src/MBPT/self_energy_Tmatrix_diag.f90 +++ b/src/MBPT/self_energy_Tmatrix_diag.f90 @@ -18,9 +18,9 @@ subroutine self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1, integer,intent(in) :: nVV double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega1(nVV) - double precision,intent(in) :: rho1(nBas,nO,nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) double precision,intent(in) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) ! Local variables @@ -52,7 +52,7 @@ subroutine self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1, do a=1,nV-nR do kl=1,nOO eps = e(p) + e(nO+a) - Omega2(kl) - SigT(p) = SigT(p) + alpha*rho2(p,a,kl)**2/eps + SigT(p) = SigT(p) + alpha*rho2(p,nO+a,kl)**2/eps enddo enddo enddo diff --git a/src/MBPT/static_Tmatrix_TA.f90 b/src/MBPT/static_Tmatrix_TA.f90 index 04cde0e..38a3c88 100644 --- a/src/MBPT/static_Tmatrix_TA.f90 +++ b/src/MBPT/static_Tmatrix_TA.f90 @@ -19,9 +19,9 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r double precision,intent(in) :: lambda double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega1(nVV) - double precision,intent(in) :: rho1(nBas,nO,nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) double precision,intent(in) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) ! Local variables @@ -47,13 +47,11 @@ subroutine static_Tmatrix_TA(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r do cd=1,nVV eps = Omega1(cd)**2 + eta**2 chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*Omega1(cd)/eps - print*,rho1(i,j,cd),rho1(a,b,cd) enddo do kl=1,nOO eps = Omega2(kl)**2 + eta**2 chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*Omega2(kl)/eps - print*,rho2(i,j,kl),rho2(a,b,kl) enddo diff --git a/src/MBPT/static_Tmatrix_TB.f90 b/src/MBPT/static_Tmatrix_TB.f90 index b804f7e..ffa6b0a 100644 --- a/src/MBPT/static_Tmatrix_TB.f90 +++ b/src/MBPT/static_Tmatrix_TB.f90 @@ -19,9 +19,9 @@ subroutine static_Tmatrix_TB(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,ERI,Omega1,r double precision,intent(in) :: lambda double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega1(nVV) - double precision,intent(in) :: rho1(nBas,nO,nVV) + double precision,intent(in) :: rho1(nBas,nBas,nVV) double precision,intent(in) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) + double precision,intent(in) :: rho2(nBas,nBas,nOO) ! Local variables