subroutine RGWC(dotest,eta,nBas,nC,nO,nV,nR,nS,Om,rho,eHF,e,eGW,Z) ! Perform GW+C calculation implicit none include 'parameters.h' ! Input variables logical,intent(in) :: dotest 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) :: nS double precision,intent(in) :: Om(nS) double precision,intent(in) :: rho(nBas,nBas,nS) double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: e(nBas) double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: Z(nBas) ! Local variables integer :: p,q,i,a,m integer :: iSat double precision :: num,eps double precision,parameter :: cutoff = 0d-3 integer,parameter :: maxS = 50 logical,parameter :: do_hole_branch = .true. logical,parameter :: do_electron_branch = .false. double precision,allocatable :: de(:,:,:) double precision,allocatable :: Re_eQP(:),Im_eQP(:) double precision,allocatable :: Re_ZQP(:),Im_ZQP(:) double precision,allocatable :: Re_ZSat(:,:,:),Im_ZSat(:,:,:) double precision,allocatable :: Re_eSat(:,:,:),Im_eSat(:,:,:) double precision :: Re_dSig,Im_dSig double precision :: Re_zeta,Im_zeta integer :: g integer :: nGrid double precision :: wmin,wmax,dw double precision,allocatable :: w(:) double precision,allocatable :: AGWC(:,:) ! Output variables ! Hello world write(*,*) write(*,*)'*******************************' write(*,*)'* Restricted GW+C Calculation *' write(*,*)'*******************************' write(*,*) ! Memory allocation allocate(Re_eQP(nBas),Im_eQP(nBas),Re_ZQP(nBas),Im_ZQP(nBas), & Re_eSat(nBas,nBas,nS),Im_eSat(nBas,nBas,nS), & Re_ZSat(nBas,nBas,nS),Im_ZSat(nBas,nBas,nS)) ! Useful quantities allocate(de(nBas,nBas,nS)) do p=nC+1,nBas-nR do i=nC+1,nO do m=1,nS de(p,i,m) = e(i) - eHF(p) - Om(m) end do end do end do do p=nC+1,nBas-nR do a=nO+1,nBas-nR do m=1,nS de(p,a,m) = e(a) - eHF(p) + Om(m) end do end do end do ! GW+C quasiparticle energies and weights Re_eQP(:) = eHF(:) Im_eQP(:) = 0d0 Re_ZQP(:) = 0d0 Im_ZQP(:) = 0d0 do p=nC+1,nBas-nR Re_dSig = 0d0 Im_dSig = 0d0 do q=nC+1,nBas-nR do m=1,nS num = 2d0*rho(p,q,m)**2 eps = de(p,q,m) Re_eQP(p) = Re_eQP(p) - eps*num/(eps**2 + eta**2) Im_eQP(p) = Im_eQP(p) - eta*num/(eps**2 + eta**2) Re_dSig = Re_dSig - (eps**2 - eta**2)*num/(eps**2 + eta**2)**2 Im_dSig = Im_dSig - 2d0*eta*eps*num/(eps**2 + eta**2)**2 end do end do Re_ZQP(p) = exp(Re_dSig)*cos(Im_dSig) Im_ZQP(p) = exp(Re_dSig)*sin(Im_dSig) end do ! Dump results write(*,*)'-------------------------------------------------------------------------------' write(*,*)' GW+C calculation ' write(*,*)'-------------------------------------------------------------------------------' write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') & '|','#','|','e_GW (eV)','|','e_GW+C (eV)','|','Z_GW','|','Z_GW+C','|' write(*,*)'-------------------------------------------------------------------------------' 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,'|',eGW(p)*HaToeV,'|',Re_eQP(p)*HaToeV,'|',Z(p),'|',Re_ZQP(p),'|' end do write(*,*)'-------------------------------------------------------------------------------' write(*,*) ! Initializatio ! GW+C satellites on hole branch if(do_hole_branch) then ! do p=nC+1,nBas-nR do p=nC+1,nO do i=nC+1,nO do m=1,nS eps = de(p,i,m) num = 2d0*rho(p,i,m)**2 Re_eSat(p,i,m) = Re_eQP(p) + eps Im_eSat(p,i,m) = Im_eQP(p) Re_zeta = (eps**2 - eta**2)*num/(eps**2 + eta**2)**2 Im_zeta = 2d0*eta*eps*num/(eps**2 + eta**2)**2 Re_ZSat(p,i,m) = Re_ZQP(p)*Re_zeta - Im_ZQP(p)*Im_zeta Im_ZSat(p,i,m) = Re_ZQP(p)*Im_zeta + Im_ZQP(p)*Re_zeta end do end do end do write(*,*)'-------------------------------------------------------------------------------' write(*,*)' Satellite series from GW+C on hole branch' write(*,*)'-------------------------------------------------------------------------------' write(*,'(1X,A5,1X,A5,1X,A5,1X,A15,1X,A15,1X)') '#','i','m','e_Sat (eV)','Z_Sat' write(*,*)'-------------------------------------------------------------------------------' ! do p=nC+1,nBas-nR do p=nC+1,nO do i=nC+1,nO do m=1,maxS if(Re_ZSat(p,i,m) > cutoff) & write(*,'(1X,I5,1X,I5,1X,I5,F15.6,1X,F15.6,1X)') p,i,m,Re_eSat(p,i,m)*HaToeV,Re_ZSat(p,i,m) end do end do end do write(*,*)'-------------------------------------------------------------------------------' write(*,*) end if ! GW+C satellites on electron branch if(do_electron_branch) then do p=nC+1,nBas-nR do a=nO+1,nBas-nR do m=1,nS eps = de(p,a,m) num = 2d0*rho(p,a,m)**2 Re_eSat(p,a,m) = Re_eQP(p) + eps Im_eSat(p,a,m) = Im_eQP(p) Re_zeta = (eps**2 - eta**2)*num/(eps**2 + eta**2)**2 Im_zeta = 2d0*eta*eps*num/(eps**2 + eta**2)**2 Re_ZSat(p,a,m) = Re_ZQP(p)*Re_zeta - Im_ZQP(p)*Im_zeta Im_ZSat(p,a,m) = Re_ZQP(p)*Im_zeta + Re_ZQP(p)*Re_zeta end do end do end do write(*,*)'-------------------------------------------------------------------------------' write(*,*)' Satellite series from GW+C on electron branch' write(*,*)'-------------------------------------------------------------------------------' write(*,'(1X,A5,1X,A5,1X,A5,1X,A15,1X,A15,1X)') '#','a','m','e_Sat (eV)','Z_Sat' write(*,*)'-------------------------------------------------------------------------------' do p=nC+1,nBas-nR do a=nO+1,nBas-nR do m=1,maxS if(Re_ZSat(p,a,m) > cutoff) & write(*,'(1X,I5,I5,1X,1X,I5,F15.6,1X,F15.6,1X)') p,a,m,Re_eSat(p,a,m)*HaToeV,Re_ZSat(p,a,m) end do end do end do write(*,*)'-------------------------------------------------------------------------------' write(*,*) end if ! Construct grid nGrid = 5000 allocate(w(nGrid),AGWC(nBas,nGrid)) ! Minimum and maximum frequency values wmin = -10d0 wmax = 0d0 dw = (wmax - wmin)/dble(ngrid) do g=1,nGrid w(g) = wmin + dble(g)*dw end do ! Compute QP part of the spectral function do g=1,nGrid do p=nC+1,nBas-nR AGWC(p,g) = (Re_ZQP(p)*Im_eQP(p) + Im_ZQP(p)*(w(g) - Re_eQP(p)))/((w(g) - Re_eQP(p))**2 + Im_eQP(p)**2) end do end do AGWC(:,:) = - AGWC(:,:)/pi ! Dump quantities in files as a function of w open(unit=11 ,file='GWC_AQP.dat') do g=1,nGrid write(11,*) w(g)*HaToeV,(AGWC(p,g),p=nC+1,nBas-nR) end do ! Closing files close(unit=11) ! Compute cumulant part of the spectral function AGWC(:,:) = 0d0 if(do_hole_branch) then do g=1,nGrid do p=nC+1,nO ! do p=nC+1,nBas-nR do i=nC+1,nO do m=1,maxS num = Re_ZSat(p,i,m)*Im_eSat(p,i,m) + Im_ZSat(p,i,m)*(w(g) - Re_eSat(p,i,m)) eps = (w(g) - Re_eSat(p,i,m))**2 + (Im_eSat(p,i,m))**2 AGWC(p,g) = AGWC(p,g) + num/eps end do end do end do end do end if if(do_electron_branch) then do g=1,nGrid do p=nC+1,nBas-nR do a=nO+1,nBas-nR do m=1,maxS num = Re_ZSat(p,a,m)*Im_eSat(p,a,m) + Im_ZSat(p,a,m)*(w(g) - Re_eSat(p,a,m)) eps = (w(g) - Re_eSat(p,a,m))**2 + Im_eSat(p,a,m)**2 AGWC(p,g) = AGWC(p,g) + num/eps end do end do end do end do end if AGWC(:,:) = - AGWC(:,:)/pi ! Dump quantities in files as a function of w open(unit=12 ,file='GWC_AC.dat') do g=1,nGrid write(12,*) w(g)*HaToeV,(AGWC(p,g),p=nC+1,nBas-nR) end do ! Closing files close(unit=12) ! Testing zone ! if(dotest) then ! call dump_test_value('R','G0W0 correlation energy',EcRPA) ! end if end subroutine