OK for BSE@GT

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 

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, &
+! call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI, &
-                                  X1s,Y1s,rho1s,X2s,Y2s,rho2s)
+!                                 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, &
+! call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI, &
-                                  X1t,Y1t,rho1t,X2t,Y2t,rho2t)
+!                                 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)

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(*,*)
+  call print_G0T0(nBas,nO,eHF(:),ENuc,ERHF,SigT(:),Z(:),eG0T0(:),EcRPA(:))
-  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(*,*)
 
 ! Perform BSE calculation
 
   if(BSE) then
 
-    call Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, &
+    call Bethe_Salpeter_Tmatrix(TDA_T,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt,   & 
-                        nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0T0,EcBSE)
+                                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,A3)') 'Tr@BSE@G0T0 correlation energy (singlet) =',EcBSE(1),' au'
-    write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 correlation energy (triplet) =',EcBSE(2)
+    write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 correlation energy (triplet) =',EcBSE(2),' au'
-    write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0T0 correlation energy           =',EcBSE(1) + EcBSE(2)
+    write(*,'(2X,A50,F20.10,A3)') 'Tr@BSE@G0T0 correlation energy           =',EcBSE(1) + EcBSE(2),' au'
-    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 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,A3)') 'AC@BSE@G0T0 correlation energy (singlet) =',EcAC(1),' au'
-      write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 correlation energy (triplet) =',EcAC(2)
+      write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 correlation energy (triplet) =',EcAC(2),' au'
-      write(*,'(2X,A50,F20.10)') 'AC@BSE@G0T0 correlation energy           =',EcAC(1) + EcAC(2)
+      write(*,'(2X,A50,F20.10,A3)') 'AC@BSE@G0T0 correlation energy           =',EcAC(1) + EcAC(2),' au'
-      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 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

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

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                       :: k,l
-  integer                       :: a,b,c,d
+  integer                       :: c,d
-  integer                       :: p
+  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)  :: rho1(nBas,nBas,nVV)
-  double precision,intent(out)  :: rho2(nBas,nV,nOO)
+  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 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,nBas-nR
               cd = cd + 1
-              rho1(p,i,ab) = rho1(p,i,ab) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,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) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij)
+                           + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij)
             end do
           end do
  
@@ -88,15 +86,15 @@ 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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,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 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) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,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) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij) 
+                           + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij) 
             end do
           end do
  
@@ -148,15 +144,15 @@ 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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,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 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) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,c,d) + xERI*ERI(p,i,d,c))*X1(cd,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) & 
+              rho1(p,q,ab) = rho1(p,q,ab) & 
-                           + (dERI*ERI(p,i,k,l) + xERI*ERI(p,i,l,k))*Y1(kl,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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,c,d) + xERI*ERI(p,nO+a,d,c))*X2(cd,ij) 
+                           + (dERI*ERI(p,q,c,d) + xERI*ERI(p,q,d,c))*X2(cd,ij) 
             end do
           end do
  
@@ -208,15 +202,15 @@ 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) & 
+              rho2(p,q,ij) = rho2(p,q,ij) & 
-                           + (dERI*ERI(p,nO+a,k,l) + xERI*ERI(p,nO+a,l,k))*Y2(kl,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 do
 
   end if
 

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,A50,F15.6,A3)') 'G0T0 HOMO      energy (eV)            =',eGT(HOMO)*HaToeV,' eV'
-  write(*,'(2X,A40,F15.6)') 'G0T0 LUMO      energy (eV)            :',eGW(LUMO)*HaToeV
+  write(*,'(2X,A50,F15.6,A3)') 'G0T0 LUMO      energy (eV)            =',eGT(LUMO)*HaToeV,' eV'
-  write(*,'(2X,A40,F15.6)') 'G0T0 HOMO-LUMO gap    (eV)            :',Gap*HaToeV
+  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

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

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

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
 
 

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