From 26aa96f1e1789ae1001ed5ea6807727a4447cfdf Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 13 Apr 2020 11:35:32 +0200 Subject: [PATCH] remove soG0T0 --- src/QuAcK/excitation_density_Tmatrix_so.f90 | 82 ------------ .../renormalization_factor_Tmatrix_so.f90 | 63 --------- src/QuAcK/self_energy_Tmatrix_diag_so.f90 | 63 --------- src/QuAcK/soG0T0.f90 | 121 ------------------ 4 files changed, 329 deletions(-) delete mode 100644 src/QuAcK/excitation_density_Tmatrix_so.f90 delete mode 100644 src/QuAcK/renormalization_factor_Tmatrix_so.f90 delete mode 100644 src/QuAcK/self_energy_Tmatrix_diag_so.f90 delete mode 100644 src/QuAcK/soG0T0.f90 diff --git a/src/QuAcK/excitation_density_Tmatrix_so.f90 b/src/QuAcK/excitation_density_Tmatrix_so.f90 deleted file mode 100644 index 0d18299..0000000 --- a/src/QuAcK/excitation_density_Tmatrix_so.f90 +++ /dev/null @@ -1,82 +0,0 @@ -subroutine excitation_density_Tmatrix_so(nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1,X2,Y2,rho2) - -! Compute excitation densities for T-matrix self-energy - - implicit none - -! Input variables - - integer,intent(in) :: nBas,nC,nO,nV,nR,nOO,nVV - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: X1(nVV,nVV) - double precision,intent(in) :: Y1(nOO,nVV) - double precision,intent(in) :: X2(nVV,nOO) - double precision,intent(in) :: Y2(nOO,nOO) - -! Local variables - - integer :: i,j,k,l - integer :: a,b,c,d - integer :: p - 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) - -! Initialization - - rho1(:,:,:) = 0d0 - rho2(:,:,:) = 0d0 - - do p=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) + (ERI(p,i,c,d) - ERI(p,i,d,c))*X1(cd,ab) - end do - end do - - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - rho1(p,i,ab) = rho1(p,i,ab) + (ERI(p,i,k,l) - ERI(p,i,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) + (ERI(p,nO+a,c,d) - ERI(p,nO+a,d,c))*X2(cd,ij) - end do - end do - - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - rho2(p,a,ij) = rho2(p,a,ij) + (ERI(p,nO+a,k,l) - ERI(p,nO+a,l,k))*Y2(kl,ij) - end do - end do - - end do - end do - - end do - -end subroutine excitation_density_Tmatrix_so diff --git a/src/QuAcK/renormalization_factor_Tmatrix_so.f90 b/src/QuAcK/renormalization_factor_Tmatrix_so.f90 deleted file mode 100644 index c545ba2..0000000 --- a/src/QuAcK/renormalization_factor_Tmatrix_so.f90 +++ /dev/null @@ -1,63 +0,0 @@ -subroutine renormalization_factor_Tmatrix_so(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2,rho2,Z) - -! Compute renormalization factor of the T-matrix self-energy - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: eta - integer,intent(in) :: nBas,nC,nO,nV,nR - integer,intent(in) :: nOO - 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) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) - -! Local variables - - integer :: i,j,k,l,a,b,c,d,p,cd,kl - double precision :: eps - -! Output variables - - double precision,intent(out) :: Z(nBas) - -! Initialize - - Z(:) = 0d0 - -!---------------------------------------------- -! T-matrix renormalization factor in the spinorbital basis -!---------------------------------------------- - -! Occupied part of the T-matrix self-energy - - do p=nC+1,nBas-nR - do i=nC+1,nO - do cd=1,nVV - eps = e(p) + e(i) - Omega1(cd) - Z(p) = Z(p) + (rho1(p,i,cd)/eps)**2 - enddo - enddo - enddo - -! Virtual part of the T-matrix self-energy - - do p=nC+1,nBas-nR - 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 - enddo - enddo - enddo - -! Compute renormalization factor from derivative of SigT - - Z(:) = 1d0/(1d0 + Z(:)) - -end subroutine renormalization_factor_Tmatrix_so diff --git a/src/QuAcK/self_energy_Tmatrix_diag_so.f90 b/src/QuAcK/self_energy_Tmatrix_diag_so.f90 deleted file mode 100644 index edef028..0000000 --- a/src/QuAcK/self_energy_Tmatrix_diag_so.f90 +++ /dev/null @@ -1,63 +0,0 @@ -subroutine self_energy_Tmatrix_diag_so(eta,nBas,nC,nO,nV,nR,nOO,nVV,e,Omega1,rho1,Omega2,rho2,SigT) - -! Compute diagonal of the correlation part of the T-matrix self-energy - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: eta - integer,intent(in) :: nBas - integer,intent(in) :: nC - integer,intent(in) :: nO - integer,intent(in) :: nV - integer,intent(in) :: nR - integer,intent(in) :: nOO - 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) :: Omega2(nOO) - double precision,intent(in) :: rho2(nBas,nV,nOO) - -! Local variables - - integer :: i,j,k,l,a,b,c,d,p,cd,kl - double precision :: eps - -! Output variables - - double precision,intent(out) :: SigT(nBas) - -! Initialize - - SigT(:) = 0d0 - -!---------------------------------------------- -! T-matrix self-energy in the spinorbital basis -!---------------------------------------------- - -! Occupied part of the T-matrix self-energy - - do p=nC+1,nBas-nR - do i=nC+1,nO - do cd=1,nVV - eps = e(p) + e(i) - Omega1(cd) - SigT(p) = SigT(p) + rho1(p,i,cd)**2/eps - enddo - enddo - enddo - -! Virtual part of the T-matrix self-energy - - do p=nC+1,nBas-nR - do a=1,nV-nR - do kl=1,nOO - eps = e(p) + e(nO+a) - Omega2(kl) - SigT(p) = SigT(p) + rho2(p,a,kl)**2/eps - enddo - enddo - enddo - -end subroutine self_energy_Tmatrix_diag_so diff --git a/src/QuAcK/soG0T0.f90 b/src/QuAcK/soG0T0.f90 deleted file mode 100644 index 90baa42..0000000 --- a/src/QuAcK/soG0T0.f90 +++ /dev/null @@ -1,121 +0,0 @@ -subroutine soG0T0(eta,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI,eHF) - -! Perform G0W0 calculation with a T-matrix self-energy (G0T0) in the spinorbital basis - - implicit none - include 'parameters.h' - -! Input variables - - double precision,intent(in) :: eta - - integer,intent(in) :: nBas,nC,nO,nV,nR - double precision,intent(in) :: ENuc - double precision,intent(in) :: ERHF - double precision,intent(in) :: eHF(nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - -! Local variables - - integer :: ispin - integer :: nOO - integer :: nVV - double precision :: EcRPA - integer :: nBas2,nC2,nO2,nV2,nR2 - double precision,allocatable :: Omega1(:) - double precision,allocatable :: X1(:,:) - double precision,allocatable :: Y1(:,:) - double precision,allocatable :: rho1(:,:,:) - double precision,allocatable :: Omega2(:) - double precision,allocatable :: X2(:,:) - double precision,allocatable :: Y2(:,:) - double precision,allocatable :: rho2(:,:,:) - double precision,allocatable :: SigT(:) - double precision,allocatable :: Z(:) - double precision,allocatable :: eG0T0(:) - double precision,allocatable :: seHF(:) - double precision,allocatable :: sERI(:,:,:,:) - -! Hello world - - write(*,*) - write(*,*)'************************************************' - write(*,*)'| One-shot soG0T0 calculation |' - write(*,*)'************************************************' - write(*,*) - -! Define occupied and virtual spaces - - nBas2 = 2*nBas - nO2 = 2*nO - nV2 = 2*nV - nC2 = 2*nC - nR2 = 2*nR - -! Spatial to spin orbitals - - allocate(seHF(nBas2),sERI(nBas2,nBas2,nBas2,nBas2)) - - call spatial_to_spin_MO_energy(nBas,eHF,nBas2,seHF) - call spatial_to_spin_ERI(nBas,ERI,nBas2,sERI) - -! Dimensions of the rr-RPA linear reponse matrices - - nOO = nO2*(nO2 - 1)/2 - nVV = nV2*(nV2 - 1)/2 - -! Memory allocation - - allocate(Omega1(nVV),X1(nVV,nVV),Y1(nOO,nVV), & - Omega2(nOO),X2(nVV,nOO),Y2(nOO,nOO), & - rho1(nBas2,nO2,nVV),rho2(nBas2,nV2,nOO), & - eG0T0(nBas2),SigT(nBas2),Z(nBas2)) - -!---------------------------------------------- -! Spinorbital basis -!---------------------------------------------- - - ispin = 4 - -! Compute linear response - - call linear_response_pp(ispin,.true.,.false.,nBas2,nC2,nO2,nV2,nR2,nOO,nVV,seHF(:),sERI(:,:,:,:), & - Omega1(:),X1(:,:),Y1(:,:),Omega2(:),X2(:,:),Y2(:,:), & - EcRPA) - - call print_excitation('pp-RPA (N+2)',ispin,nVV,Omega1(:)) - call print_excitation('pp-RPA (N-2)',ispin,nOO,Omega2(:)) - -! Compute excitation densities for the T-matrix - - call excitation_density_Tmatrix_so(nBas2,nC2,nO2,nV2,nR2,nOO,nVV,sERI(:,:,:,:), & - X1(:,:),Y1(:,:),rho1(:,:,:),X2(:,:),Y2(:,:),rho2(:,:,:)) - -!---------------------------------------------- -! Compute T-matrix version of the self-energy -!---------------------------------------------- - - call self_energy_Tmatrix_diag_so(eta,nBas2,nC2,nO2,nV2,nR2,nOO,nVV,seHF(:), & - Omega1(:),rho1(:,:,:),Omega2(:),rho2(:,:,:), & - SigT(:)) - -! Compute renormalization factor for T-matrix self-energy - - call renormalization_factor_Tmatrix_so(eta,nBas2,nC2,nO2,nV2,nR2,nOO,nVV,seHF(:), & - Omega1(:),rho1(:,:,:),Omega2(:),rho2(:,:,:), & - Z(:)) - -!---------------------------------------------- -! Solve the quasi-particle equation -!---------------------------------------------- - - eG0T0(:) = seHF(:) + SigT(:) -! eG0T0(:) = seHF(:) + Z(:)*SigT(:) - -!---------------------------------------------- -! Dump results -!---------------------------------------------- - - call print_G0T0(nBas2,nO2,seHF(:),ENuc,ERHF,SigT(:),Z(:),eG0T0(:),EcRPA) - -end subroutine soG0T0